From 218f6eccafa8172221cf7efd5262107233e7a587 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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 @@ lookup-narinfos/diverse read-narinfo write-narinfo + + substitute-urls guix-substitute)) ;;; Comment: @@ -971,7 +973,7 @@ substitutes may be unavailable\n"))))) 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 @@ found." ;; 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 @@ default value." ;; 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 @@ default value." (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 @@ default value." ;; 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 @@ a file for NARINFO." (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