From cf9703770b6db07b1826a9f9082c061919b6d061 Mon Sep 17 00:00:00 2001
From: Hynek Urban <address@hidden>
Date: Thu, 26 Nov 2015 22:38:32 +0100
Subject: [PATCH] substitute: Print a warning in case of store directory
 mismatch.

    * guix/scripts/substitute.scm (fetch-narinfos): Print a warning in case
      store directory differs between local installation and the substitute
      server.
---
 guix/scripts/substitute.scm | 45 ++++++++++++++++++++++++---------------------
 1 file changed, 24 insertions(+), 21 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 964df94..53e9321 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -569,27 +569,30 @@ if file doesn't exist, and the narinfo otherwise."
     (download-cache-info url))
 
   (and cache-info
-       (string=? (cache-info-store-directory cache-info)
-                 (%store-prefix))
-       (let ((uri (string->uri url)))
-         (case (and=> uri uri-scheme)
-           ((http)
-            (let ((requests (map (cut narinfo-request url <>) paths)))
-              (update-progress!)
-              (let ((result (http-multiple-get url
-                                               handle-narinfo-response '()
-                                               requests)))
-                (newline (current-error-port))
-                result)))
-           ((file #f)
-            (let* ((base  (string-append (uri-path uri) "/"))
-                   (files (map (compose (cut string-append base <> ".narinfo")
-                                        store-path-hash-part)
-                               paths)))
-              (filter-map (cut narinfo-from-file <> url) files)))
-           (else
-            (leave (_ "~s: unsupported server URI scheme~%")
-                   (if uri (uri-scheme uri) url)))))))
+      (let ((cache-store-directory (cache-info-store-directory cache-info))
+        (uri (string->uri url)))
+        (if (string=? cache-store-directory (%store-prefix))
+            (case (and=> uri uri-scheme)
+              ((http)
+               (let ((requests (map (cut narinfo-request url <>) paths)))
+                 (update-progress!)
+                 (let ((result (http-multiple-get url
+                                                  handle-narinfo-response '()
+                                                  requests)))
+                   (newline (current-error-port))
+                   result)))
+              ((file #f)
+               (let* ((base (string-append (uri-path uri) "/"))
+                      (get-filename (cut string-append base <> ".narinfo"))
+                      (files (map (compose get-filename store-path-hash-part)
+                                   paths)))
+                 (filter-map (cut narinfo-from-file <> url) files)))
+              (else
+               (leave (_ "~s: unsupported server URI scheme~%")
+                      (if uri (uri-scheme uri) url))))
+            (begin
+              (warning (_ "skipping ~a due to store directory mismatch~%") url)
+              #f)))))
 
 (define (lookup-narinfos cache paths)
   "Return the narinfos for PATHS, invoking the server at CACHE when no
-- 
2.1.4