~ruther/guix-local

bdb59b331bac0dea4a75b055334313ddc7bfecc8 — Ludovic Courtès 9 years ago 7aeb4ff
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.
2 files changed, 39 insertions(+), 1 deletions(-)

M guix/derivations.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +10 -1
@@ 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

M tests/derivations.scm => tests/derivations.scm +29 -0
@@ 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)