Add SQL query logging support.
* bin/cuirass.in (show-help): Document "--log-queries" option. (%options): Add it. (main): Enable query logging if the above option is set. * src/cuirass/database.scm (db-log-queries): New procedure. * src/cuirass/logging.scm (query-logging-port): New parameter. (log-query): New procedure.
This commit is contained in:
parent
e7bebbe3d4
commit
b310f17aaf
|
@ -27,6 +27,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
|
|||
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(use-modules (cuirass)
|
||||
(cuirass base)
|
||||
(cuirass ui)
|
||||
(cuirass logging)
|
||||
(cuirass metrics)
|
||||
|
@ -54,6 +55,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
|
|||
-p --port=NUM Port of the HTTP server.
|
||||
--listen=HOST Listen on the network interface for HOST
|
||||
-I, --interval=N Wait N seconds between each poll
|
||||
--log-queries=FILE Log SQL queries in FILE.
|
||||
--use-substitutes Allow usage of pre-built substitutes
|
||||
--record-events Record events for distribution
|
||||
--threads=N Use up to N kernel threads
|
||||
|
@ -74,6 +76,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
|
|||
(use-substitutes (value #f))
|
||||
(threads (value #t))
|
||||
(fallback (value #f))
|
||||
(log-queries (value #t))
|
||||
(record-events (value #f))
|
||||
(ttl (value #t))
|
||||
(version (single-char #\V) (value #f))
|
||||
|
@ -111,10 +114,11 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
|
|||
(else
|
||||
(mkdir-p (%gc-root-directory))
|
||||
(let ((one-shot? (option-ref opts 'one-shot #f))
|
||||
(port (string->number (option-ref opts 'port "8080")))
|
||||
(host (option-ref opts 'listen "localhost"))
|
||||
(interval (string->number (option-ref opts 'interval "300")))
|
||||
(specfile (option-ref opts 'specifications #f))
|
||||
(port (string->number (option-ref opts 'port "8080")))
|
||||
(host (option-ref opts 'listen "localhost"))
|
||||
(interval (string->number (option-ref opts 'interval "300")))
|
||||
(specfile (option-ref opts 'specifications #f))
|
||||
(queries-file (option-ref opts 'log-queries #f))
|
||||
|
||||
;; Since our work is mostly I/O-bound, default to a maximum of 4
|
||||
;; kernel threads. Going beyond that can increase overhead (GC
|
||||
|
@ -139,6 +143,11 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
|
|||
(set-current-module (make-user-module '()))
|
||||
(primitive-load specfile)))))
|
||||
(for-each db-add-specification new-specs)))
|
||||
|
||||
(when queries-file
|
||||
(log-message "Enable SQL query logging.")
|
||||
(db-log-queries queries-file))
|
||||
|
||||
(if one-shot?
|
||||
(process-specs (db-get-specifications))
|
||||
(let ((exit-channel (make-channel)))
|
||||
|
|
|
@ -34,12 +34,15 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (system foreign)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (sqlite3)
|
||||
#:export (;; Procedures.
|
||||
db-init
|
||||
db-open
|
||||
db-close
|
||||
db-optimize
|
||||
db-log-queries
|
||||
db-add-specification
|
||||
db-remove-specification
|
||||
db-get-specification
|
||||
|
@ -303,6 +306,21 @@ database object."
|
|||
(sqlite-exec db "PRAGMA wal_checkpoint(TRUNCATE);")
|
||||
(db-close db)))
|
||||
|
||||
(define (trace-callback trace p x)
|
||||
(log-query (pointer->string
|
||||
(sqlite-expanded-sql p))
|
||||
(make-time 'time-duration
|
||||
(bytevector-uint-ref
|
||||
(pointer->bytevector x (sizeof uint64))
|
||||
0 (native-endianness)
|
||||
(sizeof uint64))
|
||||
0)))
|
||||
|
||||
(define (db-log-queries file)
|
||||
(with-db-worker-thread db
|
||||
(query-logging-port (open-output-file file))
|
||||
(sqlite-trace db SQLITE_TRACE_PROFILE trace-callback)))
|
||||
|
||||
(define (last-insert-rowid db)
|
||||
(vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();"))
|
||||
0))
|
||||
|
|
|
@ -25,7 +25,9 @@
|
|||
current-logging-procedure
|
||||
log-message
|
||||
with-time-logging
|
||||
log-monitoring-stats))
|
||||
log-monitoring-stats
|
||||
query-logging-port
|
||||
log-query))
|
||||
|
||||
(define current-logging-port
|
||||
(make-parameter (current-error-port)))
|
||||
|
@ -77,3 +79,16 @@
|
|||
(lambda (file)
|
||||
(not (member file '("." "..")))))
|
||||
'()))))
|
||||
|
||||
(define query-logging-port
|
||||
(make-parameter #f))
|
||||
|
||||
(define (log-query query time)
|
||||
(format (query-logging-port) "~a ~,2f~%"
|
||||
(string-join
|
||||
(string-tokenize query
|
||||
(char-set-complement
|
||||
(char-set #\space #\newline #\;)))
|
||||
" ")
|
||||
(+ (time-second time)
|
||||
(/ (time-nanosecond time) 1e9))))
|
||||
|
|
Loading…
Reference in New Issue