derivations: Add #:allowed-references 'derivation' parameter.

* guix/derivations.scm (derivation): Add #:allowed-references
  parameter.
  [user+system-env-vars]: Honor it.
* tests/derivations.scm ("derivation #:allowed-references, ok",
  "derivation #:allowed-references, not allowed",
  "derivation #:allowed-references, self allowed",
  "derivation #:allowed-references, self not allowed"): New tests.
* doc/guix.texi (Derivations): Document #:allowed-references.
This commit is contained in:
Ludovic Courtès 2014-06-01 23:32:26 +02:00
parent 5a6a3ba43a
commit b53be755e4
3 changed files with 53 additions and 6 deletions

View file

@ -1737,7 +1737,7 @@ a derivation is the @code{derivation} procedure:
@var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
[#:recursive? #f] [#:inputs '()] [#:env-vars '()] @
[#:system (%current-system)] [#:references-graphs #f] @
[#:local-build? #f]
[#:allowed-references #f] [#:local-build? #f]
Build a derivation with the given arguments, and return the resulting
@code{<derivation>} object.
@ -1753,6 +1753,9 @@ name/store path pairs. 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.
When @var{allowed-references} is true, it must be a list of store items
or outputs that the derivation's output may refer to.
When @var{local-build?} is true, declare that the derivation is not a
good candidate for offloading and should rather be built locally
(@pxref{Daemon Offload Setup}). This is the case for small derivations

View file

@ -565,7 +565,7 @@ (define* (derivation store name builder args
(system (%current-system)) (env-vars '())
(inputs '()) (outputs '("out"))
hash hash-algo recursive?
references-graphs
references-graphs allowed-references
local-build?)
"Build a derivation with the given arguments, and return the resulting
<derivation> object. When HASH and HASH-ALGO are given, a
@ -578,6 +578,9 @@ (define* (derivation store name builder args
pairs. 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.
When ALLOWED-REFERENCES is true, it must be a list of store items or outputs
that the derivation's output may refer to.
When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
for offloading and should rather be built locally. This is the case for small
derivations where the costs of data transfers would outweigh the benefits."
@ -615,10 +618,14 @@ (define (user+system-env-vars)
;; Some options are passed to the build daemon via the env. vars of
;; derivations (urgh!). We hide that from our API, but here is the place
;; where we kludgify those options.
(let ((env-vars (if local-build?
`(("preferLocalBuild" . "1")
,@env-vars)
env-vars)))
(let ((env-vars `(,@(if local-build?
`(("preferLocalBuild" . "1"))
'())
,@(if allowed-references
`(("allowedReferences"
. ,(string-join allowed-references)))
'())
,@env-vars)))
(match references-graphs
(((file . path) ...)
(let ((value (map (cut string-append <> " " <>)

View file

@ -390,6 +390,43 @@ (define (deps path . deps)
((p2 . _)
(string<? p1 p2)))))))))))))))
(test-assert "derivation #:allowed-references, ok"
(let ((drv (derivation %store "allowed" %bash
'("-c" "echo hello > $out")
#:inputs `((,%bash))
#:allowed-references '())))
(build-derivations %store (list drv))))
(test-assert "derivation #:allowed-references, not allowed"
(let* ((txt (add-text-to-store %store "foo" "Hello, world."))
(drv (derivation %store "disallowed" %bash
`("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt))
#:allowed-references '())))
(guard (c ((nix-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
#f)))
(test-assert "derivation #:allowed-references, self allowed"
(let ((drv (derivation %store "allowed" %bash
'("-c" "echo $out > $out")
#:inputs `((,%bash))
#:allowed-references '("out"))))
(build-derivations %store (list drv))))
(test-assert "derivation #:allowed-references, self not allowed"
(let ((drv (derivation %store "disallowed" %bash
`("-c" ,"echo $out > $out")
#:inputs `((,%bash))
#:allowed-references '())))
(guard (c ((nix-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
#f)))
(define %coreutils
(false-if-exception