5 files changed, 71 insertions(+), 19 deletions(-)

M guix/scripts/substitute.scm
M guix/tests.scm
M tests/derivations.scm
M tests/guix-daemon.sh
M tests/store.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)

@@ 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.

@@ 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)

@@ 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\")))"

@@ 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