From ca465a9c8454289b7aded22719cd5d919e441780 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 5 Nov 2020 14:52:29 +0100
Subject: gexp: Warn when importing (guix config) or (ice-9 …).
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

While importing those modules from the host system is valid, it is often
a mistake that introduces non-reproducibility.  This patch prints a
warning when that happens.

* guix/gexp.scm (gexp-attribute): Add #:validate parameter and honor it.
(gexp-modules)[validate-modules]: New procedure.
Pass it to 'gexp-attribute'.
* tests/gexp.scm ("gexp-modules, warning"): New test.
---
 guix/gexp.scm  | 41 ++++++++++++++++++++++++++++++++---------
 tests/gexp.scm | 12 ++++++++++++
 2 files changed, 44 insertions(+), 9 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 97a6101868..051831238e 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -35,6 +35,7 @@ (define-module (guix gexp)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (gexp
             gexp?
@@ -747,22 +748,26 @@ (define (write-gexp-output output port)
 
 (set-record-type-printer! <gexp-output> write-gexp-output)
 
-(define* (gexp-attribute gexp self-attribute #:optional (equal? equal?))
+(define* (gexp-attribute gexp self-attribute #:optional (equal? equal?)
+                         #:key (validate (const #t)))
   "Recurse on GEXP and the expressions it refers to, summing the items
 returned by SELF-ATTRIBUTE, a procedure that takes a gexp.  Use EQUAL? as the
-second argument to 'delete-duplicates'."
+second argument to 'delete-duplicates'.  Pass VALIDATE every gexp and
+attribute that is traversed."
   (if (gexp? gexp)
       (delete-duplicates
-       (append (self-attribute gexp)
+       (append (let ((attribute (self-attribute gexp)))
+                 (validate gexp attribute)
+                 attribute)
                (append-map (match-lambda
                              (($ <gexp-input> (? gexp? exp))
-                              (gexp-attribute exp self-attribute))
+                              (gexp-attribute exp self-attribute
+                                              #:validate validate))
                              (($ <gexp-input> (lst ...))
                               (append-map (lambda (item)
-                                            (if (gexp? item)
-                                                (gexp-attribute item
-                                                                self-attribute)
-                                                '()))
+                                            (gexp-attribute item self-attribute
+                                                            #:validate
+                                                            validate))
                                           lst))
                              (_
                               '()))
@@ -788,7 +793,25 @@ (define (module=? m1 m2)
       (_
        (equal? m1 m2))))
 
-  (gexp-attribute gexp gexp-self-modules module=?))
+  (define (validate-modules gexp modules)
+    ;; Warn if MODULES, imported by GEXP, contains modules that in general
+    ;; should not be imported from the host because they vary from user to
+    ;; user and may thus be a source of non-reproducibility.  This includes
+    ;; (guix config) as well as modules that come with Guile.
+    (match (filter (match-lambda
+                     ((or ('guix 'config) ('ice-9 . _)) #t)
+                     (_ #f))
+                   modules)
+      (() #t)
+      (suspects
+       (warning (gexp-location gexp)
+                (N_ "importing module~{ ~a~} from the host~%"
+                    "importing modules~{ ~a~} from the host~%"
+                    (length suspects))
+                suspects))))
+
+  (gexp-attribute gexp gexp-self-modules module=?
+                  #:validate validate-modules))
 
 (define (gexp-extensions gexp)
   "Return the list of Guile extensions (packages) GEXP relies on.  If (gexp?
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 0487f2a96d..686334af61 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -30,6 +30,7 @@ (define-module (test-gexp)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
+  #:use-module ((guix diagnostics) #:select (guix-warning-port))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64)
@@ -818,6 +819,17 @@ (define result
   '()
   (gexp-modules #t))
 
+(test-assert "gexp-modules, warning"
+  (string-match "tests/gexp.scm:[0-9]+:[0-9]+: warning: \
+importing.* \\(guix config\\) from the host"
+                (call-with-output-string
+                  (lambda (port)
+                    (parameterize ((guix-warning-port port))
+                      (let* ((x (with-imported-modules '((guix config))
+                                  #~(+ 1 2 3)))
+                             (y #~(+ 39 #$x)))
+                        (gexp-modules y)))))))
+
 (test-assertm "gexp->derivation #:modules"
   (mlet* %store-monad
       ((build ->  #~(begin
-- 
cgit v1.2.3