~ruther/guix-local

218f6eccafa8172221cf7efd5262107233e7a587 — Ludovic Courtès 8 years ago 79228a5
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.
2 files changed, 13 insertions(+), 8 deletions(-)

M guix/scripts/substitute.scm
M tests/substitute.scm
M guix/scripts/substitute.scm => guix/scripts/substitute.scm +12 -6
@@ 84,6 84,8 @@
            lookup-narinfos/diverse
            read-narinfo
            write-narinfo

            substitute-urls
            guix-substitute))

;;; Comment:


@@ 971,7 973,7 @@ substitutes may be unavailable\n")))))
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 @@ found."
     ;; 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 @@ default value."
  ;; 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 @@ default value."
            (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 @@ default value."
        ;; 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"))

M tests/substitute.scm => tests/substitute.scm +1 -2
@@ 167,8 167,7 @@ a file for NARINFO."
  (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