diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-08-31 23:27:26 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-09-11 11:10:21 +0200 |
| commit | 218f6eccafa8172221cf7efd5262107233e7a587 (patch) | |
| tree | 86b62016dac6f6e9631809215678df8a98a69611 | |
| parent | 79228a52d2561c40be2cc2ac9873fcc7a38cbb48 (diff) | |
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.
| -rwxr-xr-x | guix/scripts/substitute.scm | 18 | ||||
| -rw-r--r-- | tests/substitute.scm | 3 |
2 files changed, 13 insertions, 8 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 0d36997bc40..592c4973220 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm | |||
| @@ -84,6 +84,8 @@ | |||
| 84 | lookup-narinfos/diverse | 84 | lookup-narinfos/diverse |
| 85 | read-narinfo | 85 | read-narinfo |
| 86 | write-narinfo | 86 | write-narinfo |
| 87 | |||
| 88 | substitute-urls | ||
| 87 | guix-substitute)) | 89 | guix-substitute)) |
| 88 | 90 | ||
| 89 | ;;; Comment: | 91 | ;;; Comment: |
| @@ -971,7 +973,7 @@ substitutes may be unavailable\n"))))) | |||
| 971 | found." | 973 | found." |
| 972 | (assoc-ref (daemon-options) option)) | 974 | (assoc-ref (daemon-options) option)) |
| 973 | 975 | ||
| 974 | (define %cache-urls | 976 | (define %default-substitute-urls |
| 975 | (match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client | 977 | (match (and=> (or (find-daemon-option "untrusted-substitute-urls") ;client |
| 976 | (find-daemon-option "substitute-urls")) ;admin | 978 | (find-daemon-option "substitute-urls")) ;admin |
| 977 | string-tokenize) | 979 | string-tokenize) |
| @@ -982,6 +984,10 @@ found." | |||
| 982 | ;; daemon. | 984 | ;; daemon. |
| 983 | '("http://hydra.gnu.org")))) | 985 | '("http://hydra.gnu.org")))) |
| 984 | 986 | ||
| 987 | (define substitute-urls | ||
| 988 | ;; List of substitute URLs. | ||
| 989 | (make-parameter %default-substitute-urls)) | ||
| 990 | |||
| 985 | (define (client-terminal-columns) | 991 | (define (client-terminal-columns) |
| 986 | "Return the number of columns in the client's terminal, if it is known, or a | 992 | "Return the number of columns in the client's terminal, if it is known, or a |
| 987 | default value." | 993 | default value." |
| @@ -1010,15 +1016,15 @@ default value." | |||
| 1010 | ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly | 1016 | ;; Starting from commit 22144afa in Nix, we are allowed to bail out directly |
| 1011 | ;; when we know we cannot substitute, but we must emit a newline on stdout | 1017 | ;; when we know we cannot substitute, but we must emit a newline on stdout |
| 1012 | ;; when everything is alright. | 1018 | ;; when everything is alright. |
| 1013 | (when (null? %cache-urls) | 1019 | (when (null? (substitute-urls)) |
| 1014 | (exit 0)) | 1020 | (exit 0)) |
| 1015 | 1021 | ||
| 1016 | ;; Say hello (see above.) | 1022 | ;; Say hello (see above.) |
| 1017 | (newline) | 1023 | (newline) |
| 1018 | (force-output (current-output-port)) | 1024 | (force-output (current-output-port)) |
| 1019 | 1025 | ||
| 1020 | ;; Sanity-check %CACHE-URLS so we can provide a meaningful error message. | 1026 | ;; Sanity-check SUBSTITUTE-URLS so we can provide a meaningful error message. |
| 1021 | (for-each validate-uri %cache-urls) | 1027 | (for-each validate-uri (substitute-urls)) |
| 1022 | 1028 | ||
| 1023 | ;; Attempt to install the client's locale, mostly so that messages are | 1029 | ;; Attempt to install the client's locale, mostly so that messages are |
| 1024 | ;; suitably translated. | 1030 | ;; suitably translated. |
| @@ -1038,7 +1044,7 @@ default value." | |||
| 1038 | (or (eof-object? command) | 1044 | (or (eof-object? command) |
| 1039 | (begin | 1045 | (begin |
| 1040 | (process-query command | 1046 | (process-query command |
| 1041 | #:cache-urls %cache-urls | 1047 | #:cache-urls (substitute-urls) |
| 1042 | #:acl acl) | 1048 | #:acl acl) |
| 1043 | (loop (read-line))))))) | 1049 | (loop (read-line))))))) |
| 1044 | (("--substitute" store-path destination) | 1050 | (("--substitute" store-path destination) |
| @@ -1047,7 +1053,7 @@ default value." | |||
| 1047 | ;; report displays nicely. | 1053 | ;; report displays nicely. |
| 1048 | (parameterize ((current-terminal-columns (client-terminal-columns))) | 1054 | (parameterize ((current-terminal-columns (client-terminal-columns))) |
| 1049 | (process-substitution store-path destination | 1055 | (process-substitution store-path destination |
| 1050 | #:cache-urls %cache-urls | 1056 | #:cache-urls (substitute-urls) |
| 1051 | #:acl (current-acl)))) | 1057 | #:acl (current-acl)))) |
| 1052 | (("--version") | 1058 | (("--version") |
| 1053 | (show-version-and-exit "guix substitute")) | 1059 | (show-version-and-exit "guix substitute")) |
diff --git a/tests/substitute.scm b/tests/substitute.scm index 69b272f2bb4..b1d0fe93168 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm | |||
| @@ -167,8 +167,7 @@ a file for NARINFO." | |||
| 167 | (call-with-narinfo narinfo (lambda () body ...))) | 167 | (call-with-narinfo narinfo (lambda () body ...))) |
| 168 | 168 | ||
| 169 | ;; Transmit these options to 'guix substitute'. | 169 | ;; Transmit these options to 'guix substitute'. |
| 170 | (set! (@@ (guix scripts substitute) %cache-urls) | 170 | (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) |
| 171 | (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) | ||
| 172 | 171 | ||
| 173 | (test-equal "query narinfo without signature" | 172 | (test-equal "query narinfo without signature" |
| 174 | "" ; not substitutable | 173 | "" ; not substitutable |
