From 218f6eccafa8172221cf7efd5262107233e7a587 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 31 Aug 2017 23:27:26 +0200
Subject: [PATCH] substitute: Make substitute URLs a SRFI-39 parameter.

* guix/scripts/substitute.scm (%cache-urls): Rename to...
(%default-substitute-urls): ... this.
(substitute-urls): New variable.
(guix-substitute): Use it instead of %CACHE-URLS.
* tests/substitute.scm: Likewise.
---
 guix/scripts/substitute.scm | 18 ++++++++++++------
 tests/substitute.scm        |  3 +--
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0d36997bc4..592c497322 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -84,6 +84,8 @@ (define-module (guix scripts substitute)
             lookup-narinfos/diverse
             read-narinfo
             write-narinfo
+
+            substitute-urls
             guix-substitute))
 
 ;;; Comment:
@@ -971,7 +973,7 @@ (define (find-daemon-option option)
 found."
   (assoc-ref (daemon-options) option))
 
-(define %cache-urls
+(define %default-substitute-urls
   (match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client
                     (find-daemon-option "substitute-urls"))          ;admin
                 string-tokenize)
@@ -982,6 +984,10 @@ (define %cache-urls
      ;; daemon.
      '("http://hydra.gnu.org"))))
 
+(define substitute-urls
+  ;; List of substitute URLs.
+  (make-parameter %default-substitute-urls))
+
 (define (client-terminal-columns)
   "Return the number of columns in the client's terminal, if it is known, or a
 default value."
@@ -1010,15 +1016,15 @@ (define (guix-substitute . args)
   ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
   ;; when we know we cannot substitute, but we must emit a newline on stdout
   ;; when everything is alright.
-  (when (null? %cache-urls)
+  (when (null? (substitute-urls))
     (exit 0))
 
   ;; Say hello (see above.)
   (newline)
   (force-output (current-output-port))
 
-  ;; Sanity-check %CACHE-URLS so we can provide a meaningful error message.
-  (for-each validate-uri %cache-urls)
+  ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message.
+  (for-each validate-uri (substitute-urls))
 
   ;; Attempt to install the client's locale, mostly so that messages are
   ;; suitably translated.
@@ -1038,7 +1044,7 @@ (define (guix-substitute . args)
             (or (eof-object? command)
                 (begin
                   (process-query command
-                                 #:cache-urls %cache-urls
+                                 #:cache-urls (substitute-urls)
                                  #:acl acl)
                   (loop (read-line)))))))
        (("--substitute" store-path destination)
@@ -1047,7 +1053,7 @@ (define (guix-substitute . args)
         ;; report displays nicely.
         (parameterize ((current-terminal-columns (client-terminal-columns)))
           (process-substitution store-path destination
-                                #:cache-urls %cache-urls
+                                #:cache-urls (substitute-urls)
                                 #:acl (current-acl))))
        (("--version")
         (show-version-and-exit "guix substitute"))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 69b272f2bb..b1d0fe9316 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -167,8 +167,7 @@ (define-syntax-rule (with-narinfo narinfo body ...)
   (call-with-narinfo narinfo (lambda () body ...)))
 
 ;; Transmit these options to 'guix substitute'.
-(set! (@@ (guix scripts substitute) %cache-urls)
-  (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
+(substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
 
 (test-equal "query narinfo without signature"
   ""                                              ; not substitutable