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 @@ (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"))

View file

@ -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