From 79f44cb21f4e0f4f3c279cb03c2ff2e4edb9279a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 20 Apr 2021 22:08:58 +0100 Subject: Make some SQLite related improvements Don't keep database connections around forever as this relates to cached query plans, and also run the optimize pragma when closing connections. --- guix-build-coordinator/coordinator.scm | 4 +- guix-build-coordinator/datastore.scm | 1 + guix-build-coordinator/datastore/sqlite.scm | 103 ++++++++++++++++++---------- guix-build-coordinator/utils/fibers.scm | 2 +- 4 files changed, 72 insertions(+), 38 deletions(-) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 9c4fc09..7841502 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -483,7 +483,9 @@ (allocate-builds build-coordinator)) (metric-increment success-counter-metric)) (lambda (key . args) - (backtrace)))) + (backtrace))) + (datastore-optimize + (build-coordinator-datastore build-coordinator))) #:unwind? #t)) #:buckets ((@@ (prometheus) exponential-histogram-buckets) ; TODO #:start 1 diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index 0f072ac..613de36 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -8,6 +8,7 @@ #:export (database-uri->datastore datastore-find-build-output)) +(re-export datastore-optimize) (re-export datastore-spawn-fibers) (re-export datastore-initialise-metrics!) (re-export datastore-update-metrics!) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 6cdfc6b..0bcde1e 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -15,6 +15,7 @@ #:use-module (guix-build-coordinator config) #:use-module (guix-build-coordinator datastore abstract) #:export (sqlite-datastore + datastore-optimize datastore-spawn-fibers datastore-initialise-metrics! datastore-update-metrics! @@ -128,6 +129,14 @@ (db-open database-file #:write? #f))) (sqlite-exec db "PRAGMA busy_timeout = 5000;") (list db))) + #:destructor + (let ((reader-thread-destructor-counter + (make-gauge-metric metrics-registry + "datastore_reader_thread_close_total"))) + (lambda (db) + (metric-increment reader-thread-destructor-counter) + (sqlite-close db))) + #:lifetime 50000 ;; Use a minimum of 2 and a maximum of 8 threads #:parallelism @@ -160,6 +169,14 @@ (db-open database-file))) (sqlite-exec db "PRAGMA busy_timeout = 5000;") (list db))) + #:destructor + (lambda (db) + (db-optimize db + database-file + metrics-registry) + + (sqlite-close db)) + #:lifetime 500 ;; SQLite doesn't support parallel writes #:parallelism 1 @@ -182,51 +199,65 @@ datastore)) -(define-method (datastore-spawn-fibers - (datastore )) +(define (db-optimize db db-filename metrics-registry) (define (wal-size) - (let* ((db-filename - (slot-ref datastore 'database-file)) - (db-wal-filename - (string-append db-filename "-wal"))) + (let ((db-wal-filename + (string-append db-filename "-wal"))) (stat:size (stat db-wal-filename)))) (define MiB (* (expt 2 20) 1.)) (define wal-size-threshold - (* 100 MiB)) + (* 5 MiB)) - (let* ((checkpoint-duration-metric-name - "datastore_wal_checkpoint_duration_seconds") - (metrics-registry - (slot-ref datastore 'metrics-registry))) + (let ((checkpoint-duration-metric-name + "datastore_wal_checkpoint_duration_seconds")) - (spawn-fiber + (when (> (wal-size) wal-size-threshold) + (call-with-duration-metric + metrics-registry + checkpoint-duration-metric-name + (lambda () + (sqlite-exec db "PRAGMA wal_checkpoint(TRUNCATE);")))) + + (call-with-duration-metric + metrics-registry + "datastore_optimize_duration_seconds" (lambda () - (while #t - (sleep (* 60 15)) ; 15 minutes - (with-exception-handler - (lambda (exn) - (simple-format (current-error-port) - "exception when performing WAL checkpoint: ~A\n" - exn)) - (lambda () - (retry-on-error - (lambda () - (call-with-worker-thread - (slot-ref datastore 'worker-writer-thread-channel) - (lambda (db) - (call-with-duration-metric - metrics-registry - checkpoint-duration-metric-name - (lambda () - (if (> (wal-size) wal-size-threshold) - (sqlite-exec db "PRAGMA wal_checkpoint(TRUNCATE);") - (sqlite-exec db "PRAGMA wal_checkpoint(RESTART);"))))))) - #:times 5 - #:delay 5)) - #:unwind? #t))) - #:parallel? #t))) + (sqlite-exec db + " +PRAGMA analysis_limit=1000; +PRAGMA optimize;"))))) + +(define-method (datastore-optimize + (datastore )) + (retry-on-error + (lambda () + (call-with-worker-thread + (slot-ref datastore 'worker-writer-thread-channel) + (lambda (db) + (db-optimize + db + (slot-ref datastore 'database-file) + (slot-ref datastore 'metrics-registry))))) + #:times 5 + #:delay 5)) + +(define-method (datastore-spawn-fibers + (datastore )) + (spawn-fiber + (lambda () + (while #t + (sleep (* 60 5)) ; 5 minutes + (with-exception-handler + (lambda (exn) + (simple-format (current-error-port) + "exception when performing WAL checkpoint: ~A\n" + exn)) + (lambda () + (datastore-optimize datastore)) + #:unwind? #t))) + #:parallel? #t)) (define-method (datastore-initialise-metrics! (datastore )) diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm index 99941ad..f260682 100644 --- a/guix-build-coordinator/utils/fibers.scm +++ b/guix-build-coordinator/utils/fibers.scm @@ -62,7 +62,7 @@ arguments of the worker thread procedure." #f))) (loop #f)))) (when destructor - (apply destructor args) + (apply destructor args)) (init (initializer)))))) (iota parallelism)) channel))) -- cgit v1.2.3