3 files changed, 53 insertions(+), 6 deletions(-)

M doc/guix.texi
M guix/derivations.scm
M tests/derivations.scm

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

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

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