branch master updated: remote-worker: Add a substitutes-urls option.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 91e8b2e  remote-worker: Add a substitutes-urls option.
91e8b2e is described below

commit 91e8b2ec2c2dbb87089b0c98a29bba427ba7b7bb
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Aug 12 14:11:18 2021 +0200

    remote-worker: Add a substitutes-urls option.
    
    This allows to select the substitutes-urls that the remote-worker should 
use.
    
    * src/cuirass/remote.scm (set-build-options*): Take a list of 
substitutes-urls
    as argument.
    * src/cuirass/scripts/remote-server.scm (add-to-store): Adapt it.
    * src/cuirass/scripts/remote-worker.scm (%options, %default-options): Add a
    new substitutes-urls option.
    (%substitute-urls): New parameter.
    (run-build): If the remote-server uses its own publish server, add it to the
    list of substitute servers, otherwise only use the provided substitute
    servers.
    (cuirass-remote-worker): Honor the substitutes-urls argument.
    * doc/cuirass.texi (Invoking the cuirass remote-worker): Document it.
---
 doc/cuirass.texi                      |  3 +++
 src/cuirass/remote.scm                | 12 +++++-------
 src/cuirass/scripts/remote-server.scm |  2 +-
 src/cuirass/scripts/remote-worker.scm | 30 +++++++++++++++++++++++++++---
 4 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 9627c52..72b0b5b 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -681,6 +681,9 @@ Do not use Avahi discovery and connect to the given
 Only request builds for the given @var{systems}.  It defaults to
 @code{(list (%current-system))}.
 
+@item @code{substitute-urls} (default: @code{%default-substitute-urls})
+The list of URLs where to look for substitutes by default.
+
 @item --public-key=@var{file}
 @itemx --private-key=@var{file}
 Use the specific @var{file}s as the public/private key pair used to sign
diff --git a/src/cuirass/remote.scm b/src/cuirass/remote.scm
index 2867af8..1c373e5 100644
--- a/src/cuirass/remote.scm
+++ b/src/cuirass/remote.scm
@@ -207,12 +207,13 @@ given NAME."
 ;;; Store publishing.
 ;;;
 
-(define* (set-build-options* store url
+(define* (set-build-options* store urls
                              #:key
                              timeout
                              max-silent)
-  "Maybe add URL to the list of STORE substitutes-urls, set TIMEOUT and
-MAX-SILENT store properties."
+  "Use URLS as substitution servers, set TIMEOUT and MAX-SILENT store
+properties."
+  (pk urls)
   (set-build-options store
                      #:use-substitutes? #t
                      #:fallback? #t
@@ -220,10 +221,7 @@ MAX-SILENT store properties."
                      #:timeout timeout
                      #:max-silent-time max-silent
                      #:verbosity 1
-                     #:substitute-urls
-                     (if url
-                         (cons url %default-substitute-urls)
-                         %default-substitute-urls)))
+                     #:substitute-urls urls))
 
 (define* (publish-server port
                          #:key
diff --git a/src/cuirass/scripts/remote-server.scm 
b/src/cuirass/scripts/remote-server.scm
index 6c4086c..f15ec7c 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -309,7 +309,7 @@ be used to reply to the worker."
 store."
   (parameterize ((current-build-output-port (%make-void-port "w")))
     (with-store store
-      (set-build-options* store url)
+      (set-build-options* store (list url))
       (for-each (lambda (output)
                   (ensure-path* store output))
                 (map derivation-output-path outputs)))))
diff --git a/src/cuirass/scripts/remote-worker.scm 
b/src/cuirass/scripts/remote-worker.scm
index 5002b4f..9a3607a 100644
--- a/src/cuirass/scripts/remote-worker.scm
+++ b/src/cuirass/scripts/remote-worker.scm
@@ -30,7 +30,8 @@
   #:use-module (guix scripts)
   #:use-module (guix serialization)
   #:use-module ((guix store)
-                #:select (current-build-output-port
+                #:select (%default-substitute-urls
+                          current-build-output-port
                           store-error?
                           store-protocol-error?
                           store-protocol-error-message
@@ -42,6 +43,7 @@
   #:use-module (guix scripts publish)
   #:use-module (simple-zmq)
   #:use-module (rnrs bytevectors)
+  #:use-module (web uri)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
@@ -64,6 +66,9 @@
               string->number)
        10)))
 
+(define %substitute-urls
+  (make-parameter #f))
+
 (define (show-help)
   (format #t "Usage: ~a remote-worker [OPTION]...
 Start a remote build worker.\n" (%program-name))
@@ -78,6 +83,9 @@ Start a remote build worker.\n" (%program-name))
   (display (G_ "
   -S, --systems=SYSTEMS     list of supported SYSTEMS"))
   (display (G_ "
+      --substitute-urls=URLS
+                            check for available substitutes at URLS"))
+  (display (G_ "
       --public-key=FILE     use FILE as the public key for signatures"))
   (display (G_ "
       --private-key=FILE    use FILE as the private key for signatures"))
@@ -113,6 +121,17 @@ Start a remote build worker.\n" (%program-name))
                 (lambda (opt name arg result)
                   (alist-cons 'systems
                               (string-split arg #\,) result)))
+        (option '("substitute-urls") #t #f
+                (lambda (opt name arg result . rest)
+                  (let ((urls (string-tokenize arg)))
+                    (for-each (lambda (url)
+                                (unless (string->uri url)
+                                  (leave (G_ "~a: invalid URL~%") url)))
+                              urls)
+                    (apply values
+                           (alist-cons 'substitute-urls urls
+                                       (alist-delete 'substitute-urls result))
+                           rest))))
         (option '("public-key") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'public-key-file arg result)))
@@ -125,6 +144,7 @@ Start a remote build worker.\n" (%program-name))
     (publish-port . 5558)
     (ttl . "1d")
     (systems . ,(list (%current-system)))
+    (substitute-urls . ,%default-substitute-urls)
     (public-key-file . ,%public-key-file)
     (private-key-file . ,%private-key-file)))
 
@@ -177,7 +197,9 @@ still be substituted."
           (publish-url (server-publish-url server))
           (local-publish-url (worker-publish-url worker))
           (name (worker-name worker)))
-      (set-build-options* store publish-url
+      (set-build-options* store (if publish-url
+                                    (cons publish-url (%substitute-urls))
+                                    (%substitute-urls))
                           #:timeout timeout
                           #:max-silent max-silent)
       (reply (zmq-build-started-message drv name))
@@ -373,6 +395,7 @@ exiting."
            (ttl (assoc-ref opts 'ttl))
            (server-address (assoc-ref opts 'server))
            (systems (assoc-ref opts 'systems))
+           (urls    (assoc-ref opts 'substitute-urls))
            (public-key
             (read-file-sexp
              (assoc-ref opts 'public-key-file)))
@@ -384,7 +407,8 @@ exiting."
 
       (parameterize
           ((%gc-root-ttl
-            (time-second (string->duration ttl))))
+            (time-second (string->duration ttl)))
+           (%substitute-urls urls))
         (atomic-box-set! %local-publish-port publish-port)
 
         (atomic-box-set!