diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 189b121..a7da8a8 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1824,6 +1824,22 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (with-resource-from-pool postgresql-connection-pool conn (insert-packages conn packages-data)))))) + (define (check-wal-size) + (let loop ((wal-bytes + (catch #t + (lambda () + (stat:size (stat "/var/guix/db/db.sqlite-wal"))) + (lambda _ 0)))) + (when (> wal-bytes (* 512 (expt 2 20))) + (simple-format #t "debug: guix-daemon WAL is large (~A), waiting\n" + wal-bytes) + + (sleep 30) + (loop (catch #t + (lambda () + (stat:size (stat "/var/guix/db/db.sqlite-wal"))) + (lambda _ 0)))))) + (define (extract-and-store-lint-checkers-and-warnings) (define inferior-lint-checkers-data (with-resource-from-pool inf-and-store-pool res @@ -1852,12 +1868,14 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" ;; Running the derivation linter is ;; currently infeasible (not (eq? checker-name 'derivation))) - (with-resource-from-pool inf-and-store-pool res - (match res - ((inferior . inferior-store) - (inferior-lint-warnings inferior - inferior-store - checker-name))))))) + (begin + (check-wal-size) + (with-resource-from-pool inf-and-store-pool res + (match res + ((inferior . inferior-store) + (inferior-lint-warnings inferior + inferior-store + checker-name)))))))) inferior-lint-checkers-data))) (let ((package-ids (fibers-force package-ids-promise))) @@ -1891,22 +1909,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (define chunk-size 3000) - (define (check-wal-size) - (let loop ((wal-bytes - (catch #t - (lambda () - (stat:size (stat "/var/guix/db/db.sqlite-wal"))) - (lambda _ 0)))) - (when (> wal-bytes (* 512 (expt 2 20))) - (simple-format #t "debug: guix-daemon WAL is large (~A), waiting\n" - wal-bytes) - - (sleep 30) - (loop (catch #t - (lambda () - (stat:size (stat "/var/guix/db/db.sqlite-wal"))) - (lambda _ 0)))))) - (define (process-system-and-target system target) (with-time-logging (simple-format #f "processing derivations for ~A" (cons system target))