summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-03-28 09:50:28 +0200
committerLudovic Courtès <ludo@gnu.org>2017-03-28 10:00:05 +0200
commitbdb59b331bac0dea4a75b055334313ddc7bfecc8 (patch)
tree6315b51845afcab931955a4a229b81602b277665
parent7aeb4ffa5828206f89ec62226863c27f7c1c028d (diff)
downloadguix-bdb59b331bac0dea4a75b055334313ddc7bfecc8.tar.gz
derivations: Do not fetch narinfos for non-substitutable items.
This avoids connections to substitute servers for derivations that are
not substitutable anyway, such as profiles.

Reported by Andy Wingo.

* guix/derivations.scm (substitution-oracle): Skip derivations that do
not pass 'substitutable-derivation?'.
* tests/derivations.scm ("substitution-oracle and #:substitute? #f"):
New test.
-rw-r--r--guix/derivations.scm11
-rw-r--r--tests/derivations.scm29
2 files changed, 39 insertions, 1 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index e02d1ee036..0846d54fa5 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -293,7 +293,14 @@ substituter many times."
     ;; to ask the substituter for just as much as needed, instead of asking it
     ;; for the whole world, which can be significantly faster when substitute
     ;; info is not already in cache.
-    (append-map derivation-input-output-paths
+    ;; Also, skip derivations marked as non-substitutable.
+    (append-map (lambda (input)
+                  (let ((drv (call-with-input-file
+                                 (derivation-input-path input)
+                               read-derivation)))
+                    (if (substitutable-derivation? drv)
+                        (derivation-input-output-paths input)
+                        '())))
                 (derivation-prerequisites drv valid-input?)))
 
   (let* ((paths (delete-duplicates
@@ -304,6 +311,8 @@ substituter many times."
                                          paths))))
                             (cond ((eqv? mode (build-mode check))
                                    (cons (dependencies drv) result))
+                                  ((not (substitutable-derivation? drv))
+                                   (cons (dependencies drv) result))
                                   ((every valid? self)
                                    result)
                                   (else
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 3fbfec3793..75c8d1dfb1 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -888,6 +888,35 @@
               (string=? (derivation-input-path input)
                         (derivation-file-name dep))))))))
 
+(test-assert "substitution-oracle and #:substitute? #f"
+  (with-store store
+    (let* ((dep   (build-expression->derivation store "dep"
+                                                `(begin ,(random-text)
+                                                        (mkdir %output))))
+           (drv   (build-expression->derivation store "not-subst"
+                                                `(begin ,(random-text)
+                                                        (mkdir %output))
+                                                #:substitutable? #f
+                                                #:inputs `(("dep" ,dep))))
+           (query #f))
+      (define (record-substitutable-path-query store paths)
+        (when query
+          (error "already called!" query))
+        (set! query paths)
+        '())
+
+      (mock ((guix store) substitutable-paths
+             record-substitutable-path-query)
+
+            (let ((pred (substitution-oracle store (list drv))))
+              (pred (derivation->output-path drv))))
+
+      ;; Make sure the oracle didn't try to get substitute info for DRV since
+      ;; DRV is mark as non-substitutable.  Assume that GUILE-FOR-BUILD is
+      ;; already in store and thus not part of QUERY.
+      (equal? (pk 'query query)
+              (list (derivation->output-path dep))))))
+
 (test-assert "build-expression->derivation with expression returning #f"
   (let* ((builder  '(begin
                       (mkdir %output)