From b22834dae7f48363cc924e3f5084a2afbd230c7f Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 18 Jul 2024 13:57:50 +0100 Subject: [PATCH] Refactor opening store connections when processing jobs And set the #:built-in-builders. --- .../jobs/load-new-guix-revision.scm | 27 ++++++++++++------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 2ac5ede..7945a19 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1163,7 +1163,7 @@ (inferior-and-store-pool (make-resource-pool (lambda () - (let* ((inferior-store (open-connection)) + (let* ((inferior-store (open-store-connection)) (inferior (start-inferior inferior-store))) (ensure-non-blocking-store-connection inferior-store) (set-build-options inferior-store #:fallback? #t) @@ -1450,7 +1450,7 @@ (define inf-and-store-pool (make-resource-pool (lambda () - (let* ((inferior-store (open-connection)) + (let* ((inferior-store (open-store-connection)) (inferior (start-inferior-for-data-extration inferior-store store-path @@ -2130,20 +2130,29 @@ SKIP LOCKED") (exec-query conn query))) (define (open-store-connection) - (let ((store (open-connection))) - (ensure-non-blocking-store-connection store) + (let ((store (open-connection #:non-blocking? #t + #:built-in-builders '("download")))) (set-build-options store #:fallback? #t) store)) (prevent-inlining-for-tests open-store-connection) -(define (with-store-connection f) - (with-store store - (ensure-non-blocking-store-connection store) - (set-build-options store #:fallback? #t) +(define* (with-store-connection proc) + (let ((store (open-store-connection))) + (define (thunk) + (parameterize ((current-store-protocol-version + (store-connection-version store))) + (call-with-values (lambda () (proc store)) + (lambda results + (close-connection store) + (apply values results))))) + + (with-exception-handler (lambda (exception) + (close-connection store) + (raise-exception exception)) + thunk))) - (f store))) (prevent-inlining-for-tests with-store-connection)