ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Warn when importing (guix config) or (ice-9 …).

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2020-11-05 14:52:29 +01:00
parent 18fc84bce8
commit ca465a9c84
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 44 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
guix/gexp.scm
View file

@ -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?

12
tests/gexp.scm
View file

@ -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