gexp: Add #:allowed-references parameter to 'gexp->derivation'.
* guix/gexp.scm (lower-references): New procedure.
(gexp->derivation): Add #:allowed-references and honor it.
* tests/gexp.scm ("gexp->derivation #:allowed-references",
"gexp->derivation #:allowed-references, disallowed"): New tests.
* doc/guix.texi (G-Expressions): Update 'gexp->derivation' doc.
master
Ludovic Courtès
parent
aee6180c10
commit
c8351d9a40
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
Reference in New Issue