cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve logging around use of inferiors

Browse source
This commit is contained in:
Christopher Baines 2024-08-17 18:31:32 +01:00
parent 210e9a4775
commit 3887435a7d
1 changed files with 38 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

39
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -1787,23 +1787,31 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(define (call-with-inferior proc) (define (call-with-inferior proc)
(define (check-wal-size) (define (check-wal-size)
(let loop ((wal-bytes (define threshold (* 256 (expt 2 20)))
(define (get-wal-bytes)
(catch #t (catch #t
(lambda () (lambda ()
(stat:size (stat "/var/guix/db/db.sqlite-wal"))) (stat:size (stat "/var/guix/db/db.sqlite-wal")))
(lambda _ 0)))) (lambda _ 0)))
(when (> wal-bytes (* 256 (expt 2 20)))
(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))) (let ((stats (resource-pool-stats inf-and-store-pool)))
(simple-format (simple-format
#t "debug: guix-daemon WAL is large (~A), ~A inferiors, waiting\n" #t "debug: guix-daemon WAL is large (~A), ~A inferiors, waiting\n"
wal-bytes wal-bytes
(assq-ref stats 'resources))) (assq-ref stats 'resources))
(sleep 30) (sleep 30)
(loop (catch #t (loop (get-wal-bytes)))
(lambda () (begin
(stat:size (stat "/var/guix/db/db.sqlite-wal"))) (simple-format
(lambda _ 0)))))) #t "debug: guix-daemon WAL now ~A bytes, continuing\n"
wal-bytes)
#t)))))
(let loop () (let loop ()
(check-wal-size) (check-wal-size)
@ -1821,6 +1829,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(lambda () (lambda ()
(proc inferior inferior-store)) (proc inferior inferior-store))
(lambda vals (lambda vals
(simple-format #t "debug: returning inferior to pool\n")
(cons 'result vals))))) (cons 'result vals)))))
#:timeout 20)) #:timeout 20))
#:unwind? #t) #:unwind? #t)
@ -1853,9 +1862,8 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(fibers-delay (fibers-delay
(lambda () (lambda ()
(let ((packages-data (let ((packages-data
(with-resource-from-pool inf-and-store-pool res (call-with-inferior
(match res (lambda (inferior inferior-store)
((inferior . inferior-store)
(with-time-logging "getting all inferior package data" (with-time-logging "getting all inferior package data"
(let ((packages (let ((packages
pkg-to-replacement-hash-table pkg-to-replacement-hash-table
@ -1863,16 +1871,15 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
(all-inferior-packages-data (all-inferior-packages-data
inferior inferior
packages packages
pkg-to-replacement-hash-table)))))))) pkg-to-replacement-hash-table)))))))
(with-resource-from-pool postgresql-connection-pool conn (with-resource-from-pool postgresql-connection-pool conn
(insert-packages conn packages-data)))))) (insert-packages conn packages-data))))))
(define (extract-and-store-lint-checkers-and-warnings) (define (extract-and-store-lint-checkers-and-warnings)
(define inferior-lint-checkers-data (define inferior-lint-checkers-data
(with-resource-from-pool inf-and-store-pool res (call-with-inferior
(match res (lambda (inferior inferior-store)
((inferior . inferior-store) (inferior-lint-checkers inferior))))
(inferior-lint-checkers inferior)))))
(when inferior-lint-checkers-data (when inferior-lint-checkers-data
(letpar& ((lint-checker-ids (letpar& ((lint-checker-ids