02/03: challenge: Disable grafting.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit db8f6b34121b392df12b551b3f7ca16349dc7018
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jul 14 15:25:00 2016 +0200

    challenge: Disable grafting.
    
    * guix/scripts/challenge.scm (guix-challenge): Set %GRAFT? to #f.
---
 guix/scripts/challenge.scm |   40 ++++++++++++++++++++++------------------
 1 file changed, 22 insertions(+), 18 deletions(-)

diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 149647c..590d8f1 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