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 @@ | ||||||
|             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 | ||||||
|  |  | ||||||
		Reference in a new issue