diff options
| -rw-r--r-- | doc/guix.texi | 8 | ||||
| -rw-r--r-- | guix/gexp.scm | 35 | ||||
| -rw-r--r-- | tests/gexp.scm | 25 |
3 files changed, 64 insertions, 4 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index f292182231..0c6b1e4384 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2583,8 +2583,8 @@ information about monads.) [#:hash #f] [#:hash-algo #f] @ [#:recursive? #f] [#:env-vars '()] [#:modules '()] @ [#:module-path @var{%load-path}] @ - [#:references-graphs #f] [#:local-build? #f] @ - [#:guile-for-build #f] + [#:references-graphs #f] [#:allowed-references #f] @ + [#:local-build? #f] [#:guile-for-build #f] Return a derivation @var{name} that runs @var{exp} (a gexp) with @var{guile-for-build} (a derivation) on @var{system}. When @var{target} is true, it is used as the cross-compilation target triplet for packages @@ -2612,6 +2612,10 @@ an input of the build process of @var{exp}. In the build environment, each @var{file-name} contains the reference graph of the corresponding item, in a simple text format. +@var{allowed-references} must be either @code{#f} or a list of output names and packages. +In the latter case, the list denotes store items that the result is allowed to +refer to. Any reference to another store item will lead to a build error. + The other arguments are as for @code{derivation} (@pxref{Derivations}). @end deffn diff --git a/guix/gexp.scm b/guix/gexp.scm index 4e8f91df1d..fa712a8b9b 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -118,6 +118,29 @@ corresponding derivation." #:target target))) (return (map cons file-names inputs)))))) +(define* (lower-references lst #:key system target) + "Based on LST, a list of output names and packages, return a list of output +names and file names suitable for the #:allowed-references argument to +'derivation'." + ;; XXX: Currently outputs other than "out" are not supported, and things + ;; other than packages aren't either. + (with-monad %store-monad + (define lower + (match-lambda + ((? string? output) + (return output)) + ((? package? package) + (mlet %store-monad ((drv + (if target + (package->cross-derivation package target + #:system system + #:graft? #f) + (package->derivation package system + #:graft? #f)))) + (return (derivation->output-path drv)))))) + + (sequence %store-monad (map lower lst)))) + (define* (gexp->derivation name exp #:key system (target 'current) @@ -127,6 +150,7 @@ corresponding derivation." (module-path %load-path) (guile-for-build (%guile-for-build)) references-graphs + allowed-references local-build?) "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a derivation) on SYSTEM. When TARGET is true, it is used as the @@ -151,8 +175,9 @@ an input of the build process of EXP. In the build environment, each FILE-NAME contains the reference graph of the corresponding item, in a simple text format. -In that case, the reference graph of each store path is exported in -the build environment in the corresponding file, in a simple text format. +ALLOWED-REFERENCES must be either #f or a list of output names and packages. +In the latter case, the list denotes store items that the result is allowed to +refer to. Any reference to another store item will lead to a build error. The other arguments are as for 'derivation'." (define %modules modules) @@ -207,6 +232,11 @@ The other arguments are as for 'derivation'." #:system system #:target target) (return #f))) + (allowed (if allowed-references + (lower-references allowed-references + #:system system + #:target target) + (return #f))) (guile (if guile-for-build (return guile-for-build) (package->derivation (default-guile) @@ -233,6 +263,7 @@ The other arguments are as for 'derivation'." (_ '()))) #:hash hash #:hash-algo hash-algo #:recursive? recursive? #:references-graphs (and=> graphs graphs-file-names) + #:allowed-references allowed #:local-build? local-build?))) (define* (gexp-inputs exp #:optional (references gexp-references)) diff --git a/tests/gexp.scm b/tests/gexp.scm index d80f14344d..03722e4669 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -27,6 +27,7 @@ #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (ice-9 match) @@ -396,6 +397,30 @@ (equal? (call-with-input-file g-guile read) (list (derivation->output-path guile-drv))))))) +(test-assertm "gexp->derivation #:allowed-references" + (mlet %store-monad ((drv (gexp->derivation "allowed-refs" + #~(begin + (mkdir #$output) + (chdir #$output) + (symlink #$output "self") + (symlink #$%bootstrap-guile + "guile")) + #:allowed-references + (list "out" %bootstrap-guile)))) + (built-derivations (list drv)))) + +(test-assert "gexp->derivation #:allowed-references, disallowed" + (let ((drv (run-with-store %store + (gexp->derivation "allowed-refs" + #~(begin + (mkdir #$output) + (chdir #$output) + (symlink #$%bootstrap-guile "guile")) + #:allowed-references '())))) + (guard (c ((nix-protocol-error? c) #t)) + (build-derivations %store (list drv)) + #f))) + (define shebang (string-append "#!" (derivation->output-path (%guile-for-build)) "/bin/guile --no-auto-compile")) |