diff options
Diffstat (limited to 'guix-data-service/jobs')
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 71 |
1 files changed, 39 insertions, 32 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 27393a9..e08e187 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1787,23 +1787,31 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (define (call-with-inferior proc) (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 (* 256 (expt 2 20))) - (let ((stats (resource-pool-stats inf-and-store-pool))) - (simple-format - #t "debug: guix-daemon WAL is large (~A), ~A inferiors, waiting\n" - wal-bytes - (assq-ref stats 'resources))) - - (sleep 30) - (loop (catch #t - (lambda () - (stat:size (stat "/var/guix/db/db.sqlite-wal"))) - (lambda _ 0)))))) + (define threshold (* 256 (expt 2 20))) + + (define (get-wal-bytes) + (catch #t + (lambda () + (stat:size (stat "/var/guix/db/db.sqlite-wal"))) + (lambda _ 0))) + + (if (< (get-wal-bytes) threshold) + #t + (let loop ((wal-bytes (get-wal-bytes))) + (if (> wal-bytes threshold) + (let ((stats (resource-pool-stats inf-and-store-pool))) + (simple-format + #t "debug: guix-daemon WAL is large (~A), ~A inferiors, waiting\n" + wal-bytes + (assq-ref stats 'resources)) + + (sleep 30) + (loop (get-wal-bytes))) + (begin + (simple-format + #t "debug: guix-daemon WAL now ~A bytes, continuing\n" + wal-bytes) + #t))))) (let loop () (check-wal-size) @@ -1821,6 +1829,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (lambda () (proc inferior inferior-store)) (lambda vals + (simple-format #t "debug: returning inferior to pool\n") (cons 'result vals))))) #:timeout 20)) #:unwind? #t) @@ -1853,26 +1862,24 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" (fibers-delay (lambda () (let ((packages-data - (with-resource-from-pool inf-and-store-pool res - (match res - ((inferior . inferior-store) - (with-time-logging "getting all inferior package data" - (let ((packages - pkg-to-replacement-hash-table - (inferior-packages-plus-replacements inferior))) - (all-inferior-packages-data - inferior - packages - pkg-to-replacement-hash-table)))))))) + (call-with-inferior + (lambda (inferior inferior-store) + (with-time-logging "getting all inferior package data" + (let ((packages + pkg-to-replacement-hash-table + (inferior-packages-plus-replacements inferior))) + (all-inferior-packages-data + inferior + packages + pkg-to-replacement-hash-table))))))) (with-resource-from-pool postgresql-connection-pool conn (insert-packages conn packages-data)))))) (define (extract-and-store-lint-checkers-and-warnings) (define inferior-lint-checkers-data - (with-resource-from-pool inf-and-store-pool res - (match res - ((inferior . inferior-store) - (inferior-lint-checkers inferior))))) + (call-with-inferior + (lambda (inferior inferior-store) + (inferior-lint-checkers inferior)))) (when inferior-lint-checkers-data (letpar& ((lint-checker-ids |