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

69
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 (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)))
(define threshold (* 256 (expt 2 20)))
(sleep 30)
(loop (catch #t
(lambda ()
(stat:size (stat "/var/guix/db/db.sqlite-wal")))
(lambda _ 0))))))
(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