From 24f5aaaf24e009de7f7402f2d311a26cafbf4f4a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 13 Jul 2015 15:46:12 +0200
Subject: substitute: Honor "substitute-urls" option passed by "untrusted"
 clients.

* guix/scripts/substitute.scm (or*): New macro.
  (%cache-url): Honor "untrusted-substitute-urls".
* guix/tests.scm (%test-substitute-urls): New variable.
  (open-connection-for-tests): Use it.
* tests/derivations.scm ("derivation-prerequisites-to-build and substitutes",
  "derivation-prerequisites-to-build and substitutes, non-substitutable
  build", "derivation-prerequisites-to-build and substitutes, local build"):
  Pass it to 'set-build-options'.
* tests/guix-daemon.sh: Likewise.
* tests/store.scm ("substitute query, alternating URLs"): New test.
  ("substitute query", "substitute", "substitute + build-things with output
  path", "substitute, corrupt output hash", "substitute --fallback"): Pass
  #:substitute-urls to 'set-build-options'.
---
 tests/store.scm | 45 ++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 40 insertions(+), 5 deletions(-)

(limited to 'tests/store.scm')

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
-- 
cgit v1.2.3