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

Further change job store connection handling

Browse source 
The guix-dameon WAL is still growing excessively, so avoid doing anything with
the long running store connection except registering temporary roots.
This commit is contained in:
Christopher Baines 2024-04-25 22:01:22 +01:00
parent c18589249f
commit 993887fe0c
2 changed files with 88 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1400,7 +1400,8 @@
inf)) inf))
(define* (extract-information-from conn store guix-revision-id commit (define* (extract-information-from conn long-running-store-connection
guix-revision-id commit
guix-source store-path guix-source store-path
#:key skip-system-tests? #:key skip-system-tests?
parallelism) parallelism)
@ -1411,7 +1412,9 @@
;; inferior Guix works, even if it's build using a different ;; inferior Guix works, even if it's build using a different
;; glibc version ;; glibc version
(string-append (string-append
(glibc-locales-for-guix-store-path store store-path) (with-store-connection
(lambda (store)
(glibc-locales-for-guix-store-path store store-path)))
"/lib/locale" "/lib/locale"
":" (getenv "GUIX_LOCPATH"))) ":" (getenv "GUIX_LOCPATH")))
@ -1439,7 +1442,7 @@
(spawn-fiber (spawn-fiber
(lambda () (lambda ()
(let loop ((filename (get-message channel))) (let loop ((filename (get-message channel)))
(add-temp-root store filename) (add-temp-root long-running-store-connection filename)
(loop (get-message channel))))) (loop (get-message channel)))))
(lambda (filename) (lambda (filename)
@ -1647,7 +1650,7 @@
(prevent-inlining-for-tests load-channel-instances) (prevent-inlining-for-tests load-channel-instances)
(define* (load-new-guix-revision conn store git-repository-id commit (define* (load-new-guix-revision conn git-repository-id commit
#:key skip-system-tests? parallelism) #:key skip-system-tests? parallelism)
(let* ((git-repository-fields (let* ((git-repository-fields
(select-git-repository conn git-repository-id)) (select-git-repository conn git-repository-id))
@ -1659,10 +1662,12 @@
(channel (name 'guix) (channel (name 'guix)
(url git-repository-url) (url git-repository-url)
(commit commit))) (commit commit)))
(initial-store-connection
(open-store-connection))
(source-and-channel-derivations-by-system (source-and-channel-derivations-by-system
(channel->source-and-derivations-by-system (channel->source-and-derivations-by-system
conn conn
store initial-store-connection
channel-for-commit channel-for-commit
fetch-with-authentication? fetch-with-authentication?
#:parallelism parallelism)) #:parallelism parallelism))
@ -1675,16 +1680,24 @@
channel-derivations-by-system))) channel-derivations-by-system)))
(let ((store-item (let ((store-item
(channel-derivations-by-system->guix-store-item (channel-derivations-by-system->guix-store-item
store initial-store-connection
channel-derivations-by-system))) channel-derivations-by-system)))
(if store-item (if store-item
(and (and
(extract-information-from conn store (with-store-connection
guix-revision-id (lambda (store)
commit guix-source store-item (add-temp-root store store-item)
#:skip-system-tests?
skip-system-tests? ;; Close the initial connection now that the store-item has a
#:parallelism parallelism) ;; root
(close-connection initial-store-connection)
(extract-information-from conn store
guix-revision-id
commit guix-source store-item
#:skip-system-tests?
skip-system-tests?
#:parallelism parallelism)))
(if (defined? 'channel-news-for-commit (if (defined? 'channel-news-for-commit
(resolve-module '(guix channels))) (resolve-module '(guix channels)))
@ -1709,6 +1722,7 @@
(begin (begin
(simple-format #t "Failed to generate store item for ~A\n" (simple-format #t "Failed to generate store item for ~A\n"
commit) commit)
(close-connection initial-store-connection)
#f))))) #f)))))
(define (enqueue-load-new-guix-revision-job conn git-repository-id commit source) (define (enqueue-load-new-guix-revision-job conn git-repository-id commit source)
@ -2067,6 +2081,15 @@ SKIP LOCKED")
(string=? priority "t")))) (string=? priority "t"))))
(exec-query conn query))) (exec-query conn query)))
(define (open-store-connection)
(let ((store (open-connection)))
(ensure-non-blocking-store-connection store)
(set-build-options store #:fallback? #t)
store))
(prevent-inlining-for-tests open-store-connection)
(define (with-store-connection f) (define (with-store-connection f)
(with-store store (with-store store
(ensure-non-blocking-store-connection store) (ensure-non-blocking-store-connection store)
@ -2108,14 +2131,11 @@ SKIP LOCKED")
(lambda () (lambda ()
(with-throw-handler #t (with-throw-handler #t
(lambda () (lambda ()
(with-store-connection (load-new-guix-revision conn
(lambda (store) git-repository-id
(load-new-guix-revision conn commit
store #:skip-system-tests? #t
git-repository-id #:parallelism parallelism))
commit
#:skip-system-tests? #t
#:parallelism parallelism))))
(lambda (key . args) (lambda (key . args)
(simple-format (current-error-port) (simple-format (current-error-port)
"error: load-new-guix-revision: ~A ~A\n" "error: load-new-guix-revision: ~A ~A\n"

80
tests/jobs-load-new-guix-revision.scm
View file

@ -37,50 +37,66 @@
(mock (mock
((guix-data-service jobs load-new-guix-revision) ((guix-data-service jobs load-new-guix-revision)
channel->source-and-derivations-by-system open-store-connection
(lambda* (conn store channel fetch-with-authentication? (lambda ()
#:key parallelism) 'fake-store-connection))
(cons
"/gnu/store/guix"
'(("x86_64-linux"
.
((manifest-entry-item . "/gnu/store/foo.drv")
(profile . "/gnu/store/bar.drv")))))))
(mock (mock
((guix-data-service jobs load-new-guix-revision) ((guix-data-service jobs load-new-guix-revision)
channel-derivations-by-system->guix-store-item channel->source-and-derivations-by-system
(lambda (store channel-derivations-by-system) (lambda* (conn store channel fetch-with-authentication?
"/gnu/store/test")) #:key parallelism)
(cons
"/gnu/store/guix"
'(("x86_64-linux"
.
((manifest-entry-item . "/gnu/store/foo.drv")
(profile . "/gnu/store/bar.drv")))))))
(mock (mock
((guix-data-service jobs load-new-guix-revision) ((guix-data-service jobs load-new-guix-revision)
extract-information-from channel-derivations-by-system->guix-store-item
(lambda* (conn store guix-revision-id commit (lambda (store channel-derivations-by-system)
guix-source store-path "/gnu/store/test"))
#:key skip-system-tests?
parallelism)
#t))
(mock (mock
((guix-data-service model channel-instance) ((guix-data-service jobs load-new-guix-revision)
insert-channel-instances extract-information-from
(lambda (conn guix-revision-id derivations-by-system) (lambda* (conn store guix-revision-id commit
guix-source store-path
#:key skip-system-tests?
parallelism)
#t)) #t))
(mock (mock
((guix channels) ((guix-data-service model channel-instance)
channel-news-for-commit insert-channel-instances
(lambda (channel commit) (lambda (conn guix-revision-id derivations-by-system)
'())) #t))
(match (enqueue-load-new-guix-revision-job (mock
conn ((guix channels)
(git-repository-url->git-repository-id conn "test-url") channel-news-for-commit
"test-commit" (lambda (channel commit)
"test-source") '()))
((id)
(process-load-new-guix-revision-job id)))))))))) (mock
((guix store)
add-temp-root
(lambda _ #f))
(mock
((guix store)
close-connection
(lambda _ #f))
(match (enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id conn "test-url")
"test-commit"
"test-source")
((id)
(process-load-new-guix-revision-job id)))))))))))))
(exec-query conn "TRUNCATE guix_revisions CASCADE") (exec-query conn "TRUNCATE guix_revisions CASCADE")
(exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE") (exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")