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

Attempt to avoid issues with the guix-daemon WAL

Browse source
This commit is contained in:
Christopher Baines 2024-03-08 10:31:26 +00:00
parent 5f80856ad1
commit 7d1cc4d325
2 changed files with 30 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

19
guix-data-service/database.scm
View file

@ -38,6 +38,8 @@
check-test-database! check-test-database!
lock-advisory-session-lock
unlock-advisory-session-lock
with-advisory-session-lock with-advisory-session-lock
with-advisory-session-lock/log-time with-advisory-session-lock/log-time
obtain-advisory-transaction-lock obtain-advisory-transaction-lock
@ -282,6 +284,23 @@
(unless (string=? name "guix_data_service_test") (unless (string=? name "guix_data_service_test")
(error "tests being run against non test database"))))) (error "tests being run against non test database")))))
(define (lock-advisory-session-lock conn lock)
(let ((lock-number (symbol-hash lock)))
(exec-query conn
"SELECT pg_advisory_lock($1)"
(list (number->string lock-number)))
lock-number))
(define (unlock-advisory-session-lock conn lock)
(let ((lock-number
(if (number? lock)
lock
(symbol-hash lock))))
(exec-query conn
"SELECT pg_advisory_lock($1)"
(list (number->string lock-number))))
#t)
(define (with-advisory-session-lock conn lock f) (define (with-advisory-session-lock conn lock f)
(let ((lock-number (number->string (symbol-hash lock)))) (let ((lock-number (number->string (symbol-hash lock))))
(exec-query conn (exec-query conn

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

@ -1445,6 +1445,16 @@
(lambda (filename) (lambda (filename)
(put-message channel filename)))) (put-message channel filename))))
(define lock-num
;; I'm seeing problems with the guix-dameon WAL growing excessively, which
;; I think is happening when processing revivions involving lots of new
;; derivations. So limit the concurrency here in the hope that this'll
;; help.
(with-time-logging "getting 'inferior-package-derivations lock"
(lock-advisory-session-lock
conn
'inferior-package-derivations)))
(simple-format #t "debug: extract-information-from: ~A\n" store-path) (simple-format #t "debug: extract-information-from: ~A\n" store-path)
(letpar& ((inferior-lint-checkers-and-warnings-data (letpar& ((inferior-lint-checkers-and-warnings-data
@ -1524,6 +1534,7 @@
pkg-to-replacement-hash-table)))))))) pkg-to-replacement-hash-table))))))))
(destroy-resource-pool inf-and-store-pool) (destroy-resource-pool inf-and-store-pool)
(unlock-advisory-session-lock conn lock-num)
(simple-format (simple-format
#t "debug: finished loading information from inferior\n") #t "debug: finished loading information from inferior\n")