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.master
parent
18fc84bce8
commit
ca465a9c84
|
@ -35,6 +35,7 @@
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (gexp
|
#:export (gexp
|
||||||
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)
|
(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
|
"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
|
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)
|
(if (gexp? gexp)
|
||||||
(delete-duplicates
|
(delete-duplicates
|
||||||
(append (self-attribute gexp)
|
(append (let ((attribute (self-attribute gexp)))
|
||||||
|
(validate gexp attribute)
|
||||||
|
attribute)
|
||||||
(append-map (match-lambda
|
(append-map (match-lambda
|
||||||
(($ <gexp-input> (? gexp? exp))
|
(($ <gexp-input> (? gexp? exp))
|
||||||
(gexp-attribute exp self-attribute))
|
(gexp-attribute exp self-attribute
|
||||||
|
#:validate validate))
|
||||||
(($ <gexp-input> (lst ...))
|
(($ <gexp-input> (lst ...))
|
||||||
(append-map (lambda (item)
|
(append-map (lambda (item)
|
||||||
(if (gexp? item)
|
(gexp-attribute item self-attribute
|
||||||
(gexp-attribute item
|
#:validate
|
||||||
self-attribute)
|
validate))
|
||||||
'()))
|
|
||||||
lst))
|
lst))
|
||||||
(_
|
(_
|
||||||
'()))
|
'()))
|
||||||
|
@ -788,7 +793,25 @@ false, meaning that GEXP is a plain Scheme object, return the empty list."
|
||||||
(_
|
(_
|
||||||
(equal? 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)
|
(define (gexp-extensions gexp)
|
||||||
"Return the list of Guile extensions (packages) GEXP relies on. If (gexp?
|
"Return the list of Guile extensions (packages) GEXP relies on. If (gexp?
|
||||||
|
|
|
@ -30,6 +30,7 @@
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (gnu packages base)
|
#:use-module (gnu packages base)
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
|
#:use-module ((guix diagnostics) #:select (guix-warning-port))
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
|
@ -818,6 +819,17 @@
|
||||||
'()
|
'()
|
||||||
(gexp-modules #t))
|
(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"
|
(test-assertm "gexp->derivation #:modules"
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((build -> #~(begin
|
((build -> #~(begin
|
||||||
|
|
Reference in New Issue