summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-08-31 23:27:26 +0200
committerLudovic Courtès <ludo@gnu.org>2017-09-11 11:10:21 +0200
commit218f6eccafa8172221cf7efd5262107233e7a587 (patch)
tree86b62016dac6f6e9631809215678df8a98a69611
parent79228a52d2561c40be2cc2ac9873fcc7a38cbb48 (diff)
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.
-rwxr-xr-xguix/scripts/substitute.scm18
-rw-r--r--tests/substitute.scm3
2 files changed, 13 insertions, 8 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0d36997bc40..592c4973220 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -84,6 +84,8 @@
84 lookup-narinfos/diverse 84 lookup-narinfos/diverse
85 read-narinfo 85 read-narinfo
86 write-narinfo 86 write-narinfo
87
88 substitute-urls
87 guix-substitute)) 89 guix-substitute))
88 90
89;;; Comment: 91;;; Comment:
@@ -971,7 +973,7 @@ substitutes may be unavailable\n")))))
971found." 973found."
972 (assoc-ref (daemon-options) option)) 974 (assoc-ref (daemon-options) option))
973 975
974(define %cache-urls 976(define %default-substitute-urls
975 (match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client 977 (match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client
976 (find-daemon-option "substitute-urls")) ;admin 978 (find-daemon-option "substitute-urls")) ;admin
977 string-tokenize) 979 string-tokenize)
@@ -982,6 +984,10 @@ found."
982 ;; daemon. 984 ;; daemon.
983 '("http://hydra.gnu.org")))) 985 '("http://hydra.gnu.org"))))
984 986
987(define substitute-urls
988 ;; List of substitute URLs.
989 (make-parameter %default-substitute-urls))
990
985(define (client-terminal-columns) 991(define (client-terminal-columns)
986 "Return the number of columns in the client's terminal, if it is known, or a 992 "Return the number of columns in the client's terminal, if it is known, or a
987default value." 993default value."
@@ -1010,15 +1016,15 @@ default value."
1010 ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly 1016 ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly
1011 ;; when we know we cannot substitute, but we must emit a newline on stdout 1017 ;; when we know we cannot substitute, but we must emit a newline on stdout
1012 ;; when everything is alright. 1018 ;; when everything is alright.
1013 (when (null? %cache-urls) 1019 (when (null? (substitute-urls))
1014 (exit 0)) 1020 (exit 0))
1015 1021
1016 ;; Say hello (see above.) 1022 ;; Say hello (see above.)
1017 (newline) 1023 (newline)
1018 (force-output (current-output-port)) 1024 (force-output (current-output-port))
1019 1025
1020 ;; Sanity-check %CACHE-URLS so we can provide a meaningful error message. 1026 ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message.
1021 (for-each validate-uri %cache-urls) 1027 (for-each validate-uri (substitute-urls))
1022 1028
1023 ;; Attempt to install the client's locale, mostly so that messages are 1029 ;; Attempt to install the client's locale, mostly so that messages are
1024 ;; suitably translated. 1030 ;; suitably translated.
@@ -1038,7 +1044,7 @@ default value."
1038 (or (eof-object? command) 1044 (or (eof-object? command)
1039 (begin 1045 (begin
1040 (process-query command 1046 (process-query command
1041 #:cache-urls %cache-urls 1047 #:cache-urls (substitute-urls)
1042 #:acl acl) 1048 #:acl acl)
1043 (loop (read-line))))))) 1049 (loop (read-line)))))))
1044 (("--substitute" store-path destination) 1050 (("--substitute" store-path destination)
@@ -1047,7 +1053,7 @@ default value."
1047 ;; report displays nicely. 1053 ;; report displays nicely.
1048 (parameterize ((current-terminal-columns (client-terminal-columns))) 1054 (parameterize ((current-terminal-columns (client-terminal-columns)))
1049 (process-substitution store-path destination 1055 (process-substitution store-path destination
1050 #:cache-urls %cache-urls 1056 #:cache-urls (substitute-urls)
1051 #:acl (current-acl)))) 1057 #:acl (current-acl))))
1052 (("--version") 1058 (("--version")
1053 (show-version-and-exit "guix substitute")) 1059 (show-version-and-exit "guix substitute"))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 69b272f2bb4..b1d0fe93168 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -167,8 +167,7 @@ a file for NARINFO."
167 (call-with-narinfo narinfo (lambda () body ...))) 167 (call-with-narinfo narinfo (lambda () body ...)))
168 168
169;; Transmit these options to 'guix substitute'. 169;; Transmit these options to 'guix substitute'.
170(set! (@@ (guix scripts substitute) %cache-urls) 170(substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
171 (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
172 171
173(test-equal "query narinfo without signature" 172(test-equal "query narinfo without signature"
174 "" ; not substitutable 173 "" ; not substitutable