From b53be755e465be04dc05e9069178874cb9f1f44d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 1 Jun 2014 23:32:26 +0200
Subject: 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.
---
 tests/derivations.scm | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

(limited to 'tests/derivations.scm')

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 @@ (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
-- 
cgit v1.2.3