Further change job store connection handling

The guix-dameon WAL is still growing excessively, so avoid doing anything with
the long running store connection except registering temporary roots.

1 files changed, 40 insertions, 20 deletions

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