aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-04-22 12:58:01 +0100
committerChristopher Baines <mail@cbaines.net>2023-04-22 12:58:01 +0100
commit485b85c40504dd8c53505365e0b46d7afc87b33b (patch)
tree85d4281ce59858a74bc5c097dba75647298af56d
parent5b4bd345b336f6042c761d3918435afcb5bc7736 (diff)
downloadbuild-coordinator-485b85c40504dd8c53505365e0b46d7afc87b33b.tar
build-coordinator-485b85c40504dd8c53505365e0b46d7afc87b33b.tar.gz
Don't use exceptions for blocked wal checkpoints
As this clutters the output.
-rw-r--r--guix-build-coordinator/datastore/sqlite.scm100
1 files changed, 54 insertions, 46 deletions
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index eab43b7..4ad42ed 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -242,55 +242,56 @@
(define wal-size-threshold
(* 5 MiB))
- (let ((checkpoint-duration-metric-name
- "datastore_wal_checkpoint_duration_seconds"))
-
- (when (and maybe-truncate-wal?
- (> (wal-size) wal-size-threshold))
- (call-with-duration-metric
- metrics-registry
- checkpoint-duration-metric-name
- (lambda ()
- (let ((statement
- (sqlite-prepare
- db
- "PRAGMA wal_checkpoint(TRUNCATE);")))
- (match (sqlite-step-and-finalize statement)
- (#(blocked? modified-page-count pages-moved-to-db)
- (if (= blocked? 1)
- (begin
- (simple-format
- (current-error-port)
- "warning: wal checkpoint blocked\n")
- (error "wal checkpoint blocked"))
- (simple-format
- (current-error-port)
- "wal checkpoint completed (~A, ~A)\n"
- modified-page-count
- pages-moved-to-db))))))))
-
- (call-with-duration-metric
- metrics-registry
- "datastore_optimize_duration_seconds"
- (lambda ()
- (sqlite-exec db
- "
+ (and
+ (let ((checkpoint-duration-metric-name
+ "datastore_wal_checkpoint_duration_seconds"))
+
+ (if (and maybe-truncate-wal?
+ (> (wal-size) wal-size-threshold))
+ (call-with-duration-metric
+ metrics-registry
+ checkpoint-duration-metric-name
+ (lambda ()
+ (let ((statement
+ (sqlite-prepare
+ db
+ "PRAGMA wal_checkpoint(TRUNCATE);")))
+ (match (sqlite-step-and-finalize statement)
+ (#(blocked? modified-page-count pages-moved-to-db)
+ (if (= blocked? 1)
+ (begin
+ (simple-format
+ (current-error-port)
+ "warning: wal checkpoint blocked\n")
+ #f)
+ (begin
+ (simple-format
+ (current-error-port)
+ "wal checkpoint completed (~A, ~A)\n"
+ modified-page-count
+ pages-moved-to-db)
+ #t)))))))
+ #t))
+
+ (call-with-duration-metric
+ metrics-registry
+ "datastore_optimize_duration_seconds"
+ (lambda ()
+ (sqlite-exec db
+ "
PRAGMA analysis_limit=1000;
-PRAGMA optimize;")))))
+PRAGMA optimize;")
+ #t))))
(define-method (datastore-optimize
(datastore <sqlite-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 10
- #:delay 9))
+ (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)))))
(define-method (datastore-spawn-fibers
(datastore <sqlite-datastore>))
@@ -306,7 +307,14 @@ PRAGMA optimize;")))))
(lambda ()
(with-time-logging
"performing regular database maintenance"
- (datastore-optimize datastore)))
+ (let loop ((result (datastore-optimize datastore))
+ (retry-count 0))
+ (if result
+ #t
+ (if (< retry-count 10)
+ (loop (datastore-optimize datastore)
+ (+ 1 retry-count))
+ (error "unable to perform WAL checkpoint"))))))
#:unwind? #t)))
#:parallel? #t))