summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-07-14 15:25:00 +0200
committerLudovic Courtès <ludo@gnu.org>2016-07-14 19:07:07 +0200
commitdb8f6b34121b392df12b551b3f7ca16349dc7018 (patch)
treee493791cef82961c58d72ca2d9abb1636bb2e890
parenta7a3b390600351014bee523cadb25c9a242064e9 (diff)
downloadguix-db8f6b34121b392df12b551b3f7ca16349dc7018.tar.gz
challenge: Disable grafting.
* guix/scripts/challenge.scm (guix-challenge): Set %GRAFT? to #f.
-rw-r--r--guix/scripts/challenge.scm40
1 files changed, 22 insertions, 18 deletions
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 149647cfdf..590d8f1099 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -21,6 +21,7 @@
   #:use-module (guix scripts)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module (guix grafts)
   #:use-module (guix monads)
   #:use-module (guix base32)
   #:use-module (guix packages)
@@ -222,23 +223,26 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
            (urls     (assoc-ref opts 'substitute-urls)))
       (leave-on-EPIPE
        (with-store store
-         (let ((files (match files
-                        (()
-                         (filter (cut locally-built? store <>)
-                                 (live-paths store)))
-                        (x
-                         files))))
-           (set-build-options store
-                              #:use-substitutes? #f)
-
-           (run-with-store store
-             (mlet* %store-monad ((items  (mapm %store-monad
-                                                ensure-store-item files))
-                                  (issues (discrepancies items urls)))
-               (for-each summarize-discrepancy issues)
-               (unless (null? issues)
-                 (exit 2))
-               (return (null? issues)))
-             #:system system)))))))
+         ;; Disable grafts since substitute servers normally provide only
+         ;; ungrafted stuff.
+         (parameterize ((%graft? #f))
+           (let ((files (match files
+                          (()
+                           (filter (cut locally-built? store <>)
+                                   (live-paths store)))
+                          (x
+                           files))))
+             (set-build-options store
+                                #:use-substitutes? #f)
+
+             (run-with-store store
+               (mlet* %store-monad ((items  (mapm %store-monad
+                                                  ensure-store-item files))
+                                    (issues (discrepancies items urls)))
+                 (for-each summarize-discrepancy issues)
+                 (unless (null? issues)
+                   (exit 2))
+                 (return (null? issues)))
+               #:system system))))))))
 
 ;;; challenge.scm ends here