mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
2 changed files with 13 additions and 8 deletions
|
@ -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"))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue