diff options
| -rwxr-xr-x | guix/scripts/substitute.scm | 13 | ||||
| -rw-r--r-- | guix/tests.scm | 11 | ||||
| -rw-r--r-- | tests/derivations.scm | 9 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 12 | ||||
| -rw-r--r-- | tests/store.scm | 45 |
5 files changed, 71 insertions, 19 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index df5234d0cf..5cdda343d1 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -746,12 +746,15 @@ substitutes may be unavailable\n"))))) found." (assoc-ref (daemon-options) option)) +(define-syntax-rule (or* a b) + (let ((first a)) + (if (or (not first) (string-null? first)) + b + first))) + (define %cache-url - (match (and=> ;; TODO: Uncomment the following lines when multiple - ;; substitute sources are supported. - ;; (find-daemon-option "untrusted-substitute-urls") ;client - ;; " " - (find-daemon-option "substitute-urls") ;admin + (match (and=> (or* (find-daemon-option "untrusted-substitute-urls") ;client + (find-daemon-option "substitute-urls")) ;admin string-tokenize) ((url) url) diff --git a/guix/tests.scm b/guix/tests.scm index 16b8cc7f8a..cd8eda2f60 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -36,6 +36,7 @@ network-reachable? shebang-too-long? mock + %test-substitute-urls %substitute-directory with-derivation-narinfo with-derivation-substitute @@ -49,6 +50,12 @@ ;;; ;;; Code: +(define %test-substitute-urls + ;; URLs where to look for substitutes during tests. + (make-parameter + (or (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") list) + '()))) + (define (open-connection-for-tests) "Open a connection to the build daemon for tests purposes and return it." (guard (c ((nix-error? c) @@ -57,7 +64,9 @@ #f)) (let ((store (open-connection))) ;; Make sure we build everything by ourselves. - (set-build-options store #:use-substitutes? #f) + (set-build-options store + #:use-substitutes? #f + #:substitute-urls (%test-substitute-urls)) ;; Use the bootstrap Guile when running tests, so we don't end up ;; building everything in the temporary test store. diff --git a/tests/derivations.scm b/tests/derivations.scm index f66ef5cdd7..d2a090c8bc 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -612,7 +612,8 @@ (output (derivation->output-path drv))) ;; Make sure substitutes are usable. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (with-derivation-narinfo drv (let-values (((build download) @@ -634,7 +635,8 @@ (output (derivation->output-path drv))) ;; Make sure substitutes are usable. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (with-derivation-narinfo drv (let-values (((build download) @@ -655,7 +657,8 @@ (output (derivation->output-path drv))) ;; Make sure substitutes are usable. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (with-derivation-narinfo drv (let-values (((build download) diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index 87f17def12..0de6f278e4 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2014 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2014, 2015 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -54,11 +54,12 @@ EOF rm -f "$XDG_CACHE_HOME/guix/substitute/$hash_part" # Make sure we see the substitute. -guile -c ' +guile -c " (use-modules (guix)) (define store (open-connection)) - (set-build-options store #:use-substitutes? #t) - (exit (has-substitutes? store "'"$out"'"))' + (set-build-options store #:use-substitutes? #t + #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\")) + (exit (has-substitutes? store \"$out\"))" # Now, run guix-daemon --no-substitutes. socket="$NIX_STATE_DIR/alternate-socket" @@ -72,6 +73,7 @@ guile -c " (define store (open-connection \"$socket\")) ;; This setting MUST NOT override the daemon's --no-substitutes. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\")) (exit (not (has-substitutes? store \"$out\")))" diff --git a/tests/store.scm b/tests/store.scm index f2d6d513f8..96b64781dd 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -377,7 +377,8 @@ ;; Make sure 'guix substitute' correctly communicates the above ;; data. - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (equal? (list o) (substitutable-paths s (list o))) (match (pk 'spi (substitutable-path-info s (list o))) @@ -387,6 +388,34 @@ (null? (substitutable-references s)) (equal? (substitutable-nar-size s) 1234))))))))) +(test-assert "substitute query, alternating URLs" + (let* ((d (with-store s + (package-derivation s %bootstrap-guile (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-narinfo d + ;; Remove entry from the local cache. + (false-if-exception + (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute"))) + + ;; Note: We reconnect to the daemon to force a new instance of 'guix + ;; substitute' to be used; otherwise the #:substitute-urls of + ;; 'set-build-options' would have no effect. + + (and (with-store s ;the right substitute URL + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) + (has-substitutes? s o)) + (with-store s ;the wrong one + (set-build-options s #:use-substitutes? #t + #:substitute-urls (list + "http://does-not-exist")) + (not (has-substitutes? s o))) + (with-store s ;the right one again + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) + (has-substitutes? s o)))))) + (test-assert "substitute" (with-store s (let* ((c (random-text)) ; contents of the output @@ -400,7 +429,8 @@ (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d))) (with-derivation-substitute d c - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (build-derivations s (list d)) (equal? c (call-with-input-file o get-string-all))))))) @@ -418,7 +448,8 @@ (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d))) (with-derivation-substitute d c - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (build-things s (list o)) ;give the output path (valid-path? s o) @@ -442,7 +473,8 @@ ;; Make sure we use 'guix substitute'. (set-build-options s #:use-substitutes? #t - #:fallback? #f) + #:fallback? #f + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (guard (c ((nix-protocol-error? c) ;; XXX: the daemon writes "hash mismatch in downloaded @@ -467,13 +499,16 @@ ;; Create fake substituter data, to be read by 'guix substitute'. (with-derivation-narinfo d ;; Make sure we use 'guix substitute'. - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (guard (c ((nix-protocol-error? c) ;; The substituter failed as expected. Now make ;; sure that #:fallback? #t works correctly. (set-build-options s #:use-substitutes? #t + #:substitute-urls + (%test-substitute-urls) #:fallback? #t) (and (build-derivations s (list d)) (equal? t (call-with-input-file o |