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.
This commit is contained in:
Ludovic Courtès 2017-08-31 23:27:26 +02:00
parent 79228a52d2
commit 218f6eccaf
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 13 additions and 8 deletions

View File

@ -84,6 +84,8 @@
lookup-narinfos/diverse lookup-narinfos/diverse
read-narinfo read-narinfo
write-narinfo write-narinfo
substitute-urls
guix-substitute)) guix-substitute))
;;; Comment: ;;; Comment:
@ -971,7 +973,7 @@ substitutes may be unavailable\n")))))
found." found."
(assoc-ref (daemon-options) option)) (assoc-ref (daemon-options) option))
(define %cache-urls (define %default-substitute-urls
(match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client (match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client
(find-daemon-option "substitute-urls")) ;admin (find-daemon-option "substitute-urls")) ;admin
string-tokenize) string-tokenize)
@ -982,6 +984,10 @@ found."
;; daemon. ;; daemon.
'("http://hydra.gnu.org")))) '("http://hydra.gnu.org"))))
(define substitute-urls
;; List of substitute URLs.
(make-parameter %default-substitute-urls))
(define (client-terminal-columns) (define (client-terminal-columns)
"Return the number of columns in the client's terminal, if it is known, or a "Return the number of columns in the client's terminal, if it is known, or a
default value." default value."
@ -1010,15 +1016,15 @@ default value."
;; Starting from commit 22144afa in Nix, we are allowed to bail out directly ;; 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 we know we cannot substitute, but we must emit a newline on stdout
;; when everything is alright. ;; when everything is alright.
(when (null? %cache-urls) (when (null? (substitute-urls))
(exit 0)) (exit 0))
;; Say hello (see above.) ;; Say hello (see above.)
(newline) (newline)
(force-output (current-output-port)) (force-output (current-output-port))
;; Sanity-check %CACHE-URLS so we can provide a meaningful error message. ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message.
(for-each validate-uri %cache-urls) (for-each validate-uri (substitute-urls))
;; Attempt to install the client's locale, mostly so that messages are ;; Attempt to install the client's locale, mostly so that messages are
;; suitably translated. ;; suitably translated.
@ -1038,7 +1044,7 @@ default value."
(or (eof-object? command) (or (eof-object? command)
(begin (begin
(process-query command (process-query command
#:cache-urls %cache-urls #:cache-urls (substitute-urls)
#:acl acl) #:acl acl)
(loop (read-line))))))) (loop (read-line)))))))
(("--substitute" store-path destination) (("--substitute" store-path destination)
@ -1047,7 +1053,7 @@ default value."
;; report displays nicely. ;; report displays nicely.
(parameterize ((current-terminal-columns (client-terminal-columns))) (parameterize ((current-terminal-columns (client-terminal-columns)))
(process-substitution store-path destination (process-substitution store-path destination
#:cache-urls %cache-urls #:cache-urls (substitute-urls)
#:acl (current-acl)))) #:acl (current-acl))))
(("--version") (("--version")
(show-version-and-exit "guix substitute")) (show-version-and-exit "guix substitute"))

View File

@ -167,8 +167,7 @@ a file for NARINFO."
(call-with-narinfo narinfo (lambda () body ...))) (call-with-narinfo narinfo (lambda () body ...)))
;; Transmit these options to 'guix substitute'. ;; Transmit these options to 'guix substitute'.
(set! (@@ (guix scripts substitute) %cache-urls) (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
(list (getenv "GUIX_BINARY_SUBSTITUTE_URL")))
(test-equal "query narinfo without signature" (test-equal "query narinfo without signature"
"" ; not substitutable "" ; not substitutable