diff options
| -rw-r--r-- | nar-herder/database.scm | 138 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 18 |
2 files changed, 108 insertions, 48 deletions
diff --git a/nar-herder/database.scm b/nar-herder/database.scm index 0a03cb1..61f5bb1 100644 --- a/nar-herder/database.scm +++ b/nar-herder/database.scm @@ -27,6 +27,7 @@ #:use-module (web uri) #:use-module (sqlite3) #:use-module (fibers) + #:use-module (prometheus) #:use-module (guix narinfo) #:use-module (guix derivations) #:use-module (nar-herder utils) @@ -54,11 +55,13 @@ database-map-all-narinfo-files)) (define-record-type <database> - (make-database database-file reader-thread-channel writer-thread-channel) + (make-database database-file reader-thread-channel writer-thread-channel + metrics-registry) database? (database-file database-file) (reader-thread-channel database-reader-thread-channel) - (writer-thread-channel database-writer-thread-channel)) + (writer-thread-channel database-writer-thread-channel) + (metrics-registry database-metrics-registry)) (define* (db-open database #:key (write? #t)) @@ -138,7 +141,7 @@ SELECT name FROM sqlite_master WHERE type = 'table' AND name = :name"))) (sqlite-finalize statement))) -(define (setup-database database-file) +(define (setup-database database-file metrics-registry) (let ((db (db-open database-file))) (sqlite-exec db "PRAGMA journal_mode=WAL;") (sqlite-exec db "PRAGMA optimize;") @@ -165,6 +168,17 @@ SELECT name FROM sqlite_master WHERE type = 'table' AND name = :name"))) (min (max (current-processor-count) 2) 64) + #:delay-logger (let ((delay-metric + (make-histogram-metric + metrics-registry + "database_read_delay_seconds"))) + (lambda (seconds-delayed) + (metric-observe delay-metric seconds-delayed) + (when (> seconds-delayed 1) + (format + (current-error-port) + "warning: database read delayed by ~1,2f seconds~%" + seconds-delayed)))))) (writer-thread-channel (make-worker-thread-channel @@ -183,11 +197,23 @@ SELECT name FROM sqlite_master WHERE type = 'table' AND name = :name"))) #:lifetime 500 ;; SQLite doesn't support parallel writes - #:parallelism 1))) + #:parallelism 1 + #:delay-logger (let ((delay-metric + (make-histogram-metric + metrics-registry + "database_write_delay_seconds"))) + (lambda (seconds-delayed) + (metric-observe delay-metric seconds-delayed) + (when (> seconds-delayed 1) + (format + (current-error-port) + "warning: database write delayed by ~1,2f seconds~%" + seconds-delayed))))))) (make-database database-file reader-thread-channel - writer-thread-channel))) + writer-thread-channel + metrics-registry))) (define (db-optimize db db-filename) (define (wal-size) @@ -235,6 +261,24 @@ PRAGMA optimize;"))) #:unwind? #t))) #:parallel? #t)) +(define (call-with-time-tracking database thing thunk) + (define registry (database-metrics-registry database)) + (define metric-name + (string-append "database_" thing "_duration_seconds")) + + (if registry + (let* ((metric + (or (metrics-registry-fetch-metric registry metric-name) + (make-histogram-metric registry + metric-name))) + (start-time (get-internal-real-time))) + (let ((result (thunk))) + (metric-observe metric + (/ (- (get-internal-real-time) start-time) + internal-time-units-per-second)) + result)) + (thunk))) + (define %current-transaction-proc (make-parameter #f)) @@ -647,24 +691,28 @@ DELETE FROM narinfo_tags WHERE narinfo_id = :narinfo_id" #t)))) (define (database-select-narinfo-contents-by-hash database hash) - (call-with-worker-thread - (database-reader-thread-channel database) - (lambda (db) - (let ((statement - (sqlite-prepare - db - " + (call-with-time-tracking + database + "select_narinfo_contents_by_hash" + (lambda () + (call-with-worker-thread + (database-reader-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " SELECT contents FROM narinfos WHERE substr(store_path, 12, 32) = :hash" - #:cache? #t))) - (sqlite-bind-arguments - statement - #:hash hash) + #:cache? #t))) + (sqlite-bind-arguments + statement + #:hash hash) - (match (let ((result (sqlite-step statement))) - (sqlite-reset statement) - result) - (#(contents) contents) - (_ #f)))))) + (match (let ((result (sqlite-step statement))) + (sqlite-reset statement) + result) + (#(contents) contents) + (_ #f)))))))) (define* (database-select-recent-changes database after-date #:key (limit 8192)) (call-with-worker-thread @@ -787,35 +835,39 @@ WHERE narinfo_files.url = :url" (contents . ,contents)))))))) (define (database-select-narinfo-files database hash) - (call-with-worker-thread - (database-reader-thread-channel database) - (lambda (db) - (let ((statement - (sqlite-prepare - db - " + (call-with-time-tracking + database + "select_narinfo_files" + (lambda () + (call-with-worker-thread + (database-reader-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " SELECT narinfo_files.size, narinfo_files.compression, narinfo_files.url FROM narinfos INNER JOIN narinfo_files ON narinfos.id = narinfo_files.narinfo_id WHERE substr(narinfos.store_path, 12, 32) = :hash" - #:cache? #t))) + #:cache? #t))) - (sqlite-bind-arguments - statement - #:hash hash) - - (let ((result - (sqlite-map - (match-lambda - (#(size compression url) - `((size . ,size) - (compression . ,compression) - (url . ,url)))) - statement))) - (sqlite-reset statement) + (sqlite-bind-arguments + statement + #:hash hash) + + (let ((result + (sqlite-map + (match-lambda + (#(size compression url) + `((size . ,size) + (compression . ,compression) + (url . ,url)))) + statement))) + (sqlite-reset statement) - result))))) + result))))))) (define (database-map-all-narinfo-files database proc) (call-with-worker-thread diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index 8ade7fb..d1f95d1 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -211,8 +211,12 @@ (append %base-option-defaults %import-options-defaults) rest)) + (metrics-registry + (make-metrics-registry #:namespace + "narherder")) (database (setup-database - (assq-ref opts 'database)))) + (assq-ref opts 'database) + metrics-registry))) (let* ((narinfos (append-map (lambda (file-or-dir) @@ -258,8 +262,12 @@ (let* ((opts (parse-options %base-options %base-option-defaults rest)) + (metrics-registry + (make-metrics-registry #:namespace + "narherder")) (database (setup-database - (assq-ref opts 'database))) + (assq-ref opts 'database) + metrics-registry)) (lgr (make <logger>)) (port-log (make <port-log> #:port (current-output-port) @@ -287,8 +295,7 @@ (remove-nar-files-by-hash database (assq-ref opts 'storage) - (make-metrics-registry #:namespace - "narherder") + metrics-registry (store-path-hash-part store-path))) (log-msg 'WARN "no --storage set, so just removing from the database")) @@ -386,7 +393,8 @@ #f) (download-database))))) - (let ((database (setup-database (assq-ref opts 'database))) + (let ((database (setup-database (assq-ref opts 'database) + metrics-registry)) (canonical-storage (and=> (assq-ref opts 'storage) canonicalize-path))) |