diff options
| -rw-r--r-- | doc/guix.texi | 5 | ||||
| -rw-r--r-- | guix/derivations.scm | 17 | ||||
| -rw-r--r-- | tests/derivations.scm | 37 |
3 files changed, 53 insertions, 6 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index eeadb04d78..cfdfcd8b78 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/derivations.scm b/guix/derivations.scm index 09b7ec079e..8d0c9c08df 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -565,7 +565,7 @@ HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for (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 @@ When REFERENCES-GRAPHS is true, it must be a list of file 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 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 @@ derivations where the costs of data transfers would outweigh the benefits." ;; 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 <> " " <>) diff --git a/tests/derivations.scm b/tests/derivations.scm index 0b785029a7..87609108d6 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -390,6 +390,43 @@ ((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 |