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.
This commit is contained in:
Ludovic Courtès 2015-02-11 22:10:14 +01:00
parent aee6180c10
commit c8351d9a40
3 changed files with 64 additions and 4 deletions

View File

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

View File

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

View File

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