Make it possible to pass in substitute-urls to the agent

So that you don't have to just use the daemon's defaults.

3 files changed, 25 insertions, 7 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index c08f89e..d787cbc 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -31,7 +31,8 @@
   #:use-module (guix-build-coordinator agent-messaging http)
   #:export (run-agent))
 
-(define (run-agent uuid coordinator-uri password)
+(define (run-agent uuid coordinator-uri password
+                   substitute-urls)
   (while #t
     (let* ((details (submit-status coordinator-uri uuid password
                                    'idle))
@@ -50,7 +51,8 @@
                   (let ((derivation-name (assoc-ref build "derivation-name")))
                     (simple-format #t "setting up to build: ~A\n"
                                    derivation-name)
-                    (let ((pre-build-status (pre-build-process derivation-name)))
+                    (let ((pre-build-status (pre-build-process substitute-urls
+                                                               derivation-name)))
                       (if (eq? (assq-ref pre-build-status 'result) 'success)
                           (let ((result (perform-build derivation-name)))
                             (and=> (derivation-log-file derivation-name)
@@ -75,7 +77,7 @@
       (when (null? builds)
         (sleep 5)))))
 
-(define (pre-build-process derivation-name)
+(define (pre-build-process substitute-urls derivation-name)
   (define (find-missing-inputs inputs)
     (let* ((output-paths
             (append-map derivation-input-output-paths inputs))
@@ -83,6 +85,9 @@
             (remove file-exists? output-paths))
            (path-substitutes
             (with-store store
+              (set-build-options store
+                                 #:substitute-urls substitute-urls)
+
               (map (lambda (file)
                      (has-substitutes? store file))
                    missing-paths))))
@@ -98,6 +103,9 @@
           (begin
             ;; Download the substitutes
             (with-store store
+              (set-build-options store
+                                 #:substitute-urls substitute-urls)
+
               (build-things store missing-paths))
 
             '()))))
@@ -123,7 +131,9 @@
   (let ((derivation
          (if (file-exists? derivation-name)
              (read-derivation-from-file derivation-name)
-             (and (substitute-derivation derivation-name)
+             (and (substitute-derivation derivation-name
+                                         #:substitute-urls
+                                         substitute-urls)
                   (read-derivation-from-file derivation-name)))))
     (match (delete-outputs derivation)
       (#t
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 240202d..371eef0 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -203,13 +203,15 @@ If already in the worker thread, call PROC immediately."
           (values response
                   body))))))
 
-  (define (substitute-derivation derivation-name)
+(define* (substitute-derivation derivation-name
+                                #:key substitute-urls)
     (catch #t
       (lambda ()
         (with-store store
           (set-build-options store
                              #:print-extended-build-trace? #t
-                             #:multiplexed-build-output? #t)
+                             #:multiplexed-build-output? #t
+                             #:substitute-urls substitute-urls)
           (with-status-report
               (lambda (event status new)
                 (print-build-event event status new)
diff --git a/scripts/guix-build-coordinator-agent.in b/scripts/guix-build-coordinator-agent.in
index eff66e4..89bd375 100644
--- a/scripts/guix-build-coordinator-agent.in
+++ b/scripts/guix-build-coordinator-agent.in
@@ -42,6 +42,11 @@
                 (lambda (opt name arg result)
                   (alist-cons 'password
                               arg
+                              result)))
+        (option '("substitute-urls") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'substitute-urls
+                              (string-split arg #\space)
                               result)))))
 
 (define %option-defaults
@@ -65,4 +70,5 @@
                            (cdr (program-arguments)))))
   (run-agent (assq-ref opts 'uuid)
              (assq-ref opts 'coordinator)
-             (assq-ref opts 'password)))
+             (assq-ref opts 'password)
+             (assq-ref opts 'substitute-urls)))