diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-11-05 14:52:29 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-11-05 16:13:50 +0100 |
commit | ca465a9c8454289b7aded22719cd5d919e441780 (patch) | |
tree | 4b0eb37a79eacd5df06157dbf6df99cd9d493141 /guix/gexp.scm | |
parent | 18fc84bce86eedb85d44a8708a9a5ef7c1b23da5 (diff) |
gexp: Warn when importing (guix config) or (ice-9 …).
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.
Diffstat (limited to 'guix/gexp.scm')
-rw-r--r-- | guix/gexp.scm | 41 |
1 files changed, 32 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 @@ #: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 @@ whether this should be considered a \"native\" input or not." (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 @@ false, meaning that GEXP is a plain Scheme object, return the empty list." (_ (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? |