13/13: Try to fix issues with derivations being GC'ed

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit e0a6c845e536db88b990e3ee1f0f88b0c05740ba
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Jan 19 09:57:19 2024 +0000

    Try to fix issues with derivations being GC'ed
---
 guix-data-service/jobs/load-new-guix-revision.scm | 26 ++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm 
b/guix-data-service/jobs/load-new-guix-revision.scm
index a07baa2..f6f6964 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -120,7 +120,8 @@
       inf)))
    string<?))
 
-(define (all-inferior-system-tests inf store guix-source guix-commit)
+(define (all-inferior-system-tests inf store guix-source guix-commit
+                                   add-temp-root/long-running-store)
   (define inf-systems
     (inferior-guix-systems inf))
 
@@ -192,7 +193,8 @@
 
         (for-each (lambda (derivation-file-names-by-system)
                     (for-each (lambda (derivation-file-name)
-                                (add-temp-root store derivation-file-name))
+                                (add-temp-root/long-running-store
+                                 derivation-file-name))
                               (map cdr derivation-file-names-by-system)))
                   (map third system-test-data))
 
@@ -1363,8 +1365,21 @@
      #:idle-seconds 10
      #:destructor (match-lambda
                     ((inferior . store)
-                     (close-inferior inferior)
-                     (close-connection store)))))
+                     ;; Don't close the store connection here, because there
+                     ;; are temporary roots to keep alive
+                     (close-inferior inferior)))))
+
+  (define add-temp-root/long-running-store
+    (let ((channel (make-channel)))
+
+      (spawn-fiber
+       (lambda ()
+         (let loop ((filename (get-message channel)))
+           (add-temp-root store filename)
+           (loop (get-message channel)))))
+
+      (lambda (filename)
+        (put-message channel filename))))
 
   (simple-format #t "debug: extract-information-from: ~A\n" store-path)
 
@@ -1419,7 +1434,8 @@
                      ((inferior . inferior-store)
                       (with-time-logging "getting inferior system tests"
                         (all-inferior-system-tests inferior inferior-store
-                                                   guix-source commit)))))))
+                                                   guix-source commit
+                                                   
add-temp-root/long-running-store)))))))
             (packages-data
              (with-time-logging "getting all inferior package data"
                (with-resource-from-pool inf-and-store-pool res