Work around the daemon attempting to build derivations straight away

The intent here is to use substitutes for the derivation, as well as any
inputs that are required, then build the derivation without substitutes.

To achieve this, ask the daemon to build the derivation, which will download
the substitute, and then close the connection once this is done to prevent the
derivation outputs being immediately built or substituted.

1 files changed, 33 insertions, 9 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 6e7d083..c5094d4 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -21,7 +21,9 @@
 (define-module (guix-build-coordinator agent)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (ice-9 match)
   #:use-module (guix store)
+  #:use-module (guix status)
   #:use-module (guix derivations)
   #:use-module (guix-build-coordinator agent-messaging http)
   #:export (run-agent))
@@ -39,22 +41,44 @@
     (for-each (lambda (build)
                 (let ((derivation-name (assoc-ref build "derivation-name")))
                   (pre-build-process derivation-name)
-                  (build-derivation derivation-name)))
+                  (perform-build derivation-name)))
               builds)))
 
 (define (pre-build-process derivation-name)
+  (define (substitute-derivation derivation-name)
+    (catch #t
+      (lambda ()
+        (with-store store
+          (set-build-options store
+                             #:print-extended-build-trace? #t
+                             #:multiplexed-build-output? #t)
+          (with-status-report
+              (lambda (event status new)
+                (print-build-event event status new)
+                (match event
+                  (('substituter-succeeded substituted-drv)
+                   (when (string=? derivation-name
+                                   substituted-drv)
+                     (close-connection store)))
+                  (_ #t)))
+            (build-things store (list derivation-name)))))
+      (lambda (key . args)
+        ;; This is a hack, to ignore errors relating to closing the store
+        ;; connection.
+        #f)))
+
   (let ((derivation
          (if (file-exists? derivation-name)
              (read-derivation-from-file derivation-name)
-             (and (with-store store
-                    (build-things store (list derivation-name)))
+             (and (substitute-derivation derivation-name)
                   (read-derivation-from-file derivation-name)))))
 
-    (let ((outputs (derivation-outputs derivation)))
-      (with-store store
-        (delete-paths
-         store
-         (map derivation-output-path (map cdr outputs))))
+    (let* ((outputs (derivation-outputs derivation))
+           (output-file-names
+            (map derivation-output-path (map cdr outputs))))
+      (when (any file-exists? output-file-names)
+        (with-store store
+          (delete-paths store output-file-names)))
 
       (let* ((inputs (derivation-inputs derivation))
              (output-paths
@@ -63,7 +87,7 @@
         (with-store store
           (build-things store output-paths))))))
 
-(define (build-derivation derivation-name)
+(define (perform-build derivation-name)
   (with-store store
     (set-build-options store
                        #:use-substitutes? #f)