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:
parent
79228a52d2
commit
218f6eccaf
|
@ -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"))
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue