From b15d79dfe65353f4101b0ad653c97e3ef0d4a8b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 6 Jun 2014 17:18:17 +0200
Subject: [PATCH] build-system/gnu: Add #:allowed-references.

* guix/build-system/gnu.scm (gnu-build): Add #:allowed-references.
  [canonicalize-reference]: New procedure.
  Pass #:allowed-references to 'build-expression->derivation'.
  (gnu-cross-build): Likewise.
---
 guix/build-system/gnu.scm | 41 +++++++++++++++++++++++++++++++++++----
 1 file changed, 37 insertions(+), 4 deletions(-)

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index a50ca134f29..0c3f1ea4e3c 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -265,7 +265,8 @@ (define* (gnu-build store name source inputs
                     (system (%current-system))
                     (implicit-inputs? #t)    ; useful when bootstrapping
                     (imported-modules %default-modules)
-                    (modules %default-modules))
+                    (modules %default-modules)
+                    allowed-references)
   "Return a derivation called NAME that builds from tarball SOURCE, with
 input derivation INPUTS, using the usual procedure of the GNU Build
 System.  The builder is run with GUILE, or with the distro's final Guile
@@ -276,7 +277,10 @@ (define* (gnu-build store name source inputs
 the builder's environment, from the host.  Note that we distinguish
 between both, because for Guile's own modules like (ice-9 foo), we want
 to use GUILE's own version of it, rather than import the user's one,
-which could lead to gratuitous input divergence."
+which could lead to gratuitous input divergence.
+
+ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs
+are allowed to refer to."
   (define implicit-inputs
     (and implicit-inputs?
          (parameterize ((%store store))
@@ -287,6 +291,16 @@ (define implicit-search-paths
         (standard-search-paths)
         '()))
 
+  (define canonicalize-reference
+    (match-lambda
+     ((? package? p)
+      (derivation->output-path (package-derivation store p system)))
+     (((? package? p) output)
+      (derivation->output-path (package-derivation store p system)
+                               output))
+     ((? string? output)
+      output)))
+
   (define builder
     `(begin
        (use-modules ,@modules)
@@ -337,6 +351,10 @@ (define guile-for-build
                                               outputs
                                               (delete "debug" outputs))
                                 #:modules imported-modules
+                                #:allowed-references
+                                (and allowed-references
+                                     (map canonicalize-reference
+                                          allowed-references))
                                 #:guile-for-build guile-for-build))
 
 
@@ -403,7 +421,8 @@ (define* (gnu-cross-build store name target source inputs native-inputs
                           (imported-modules '((guix build gnu-build-system)
                                               (guix build utils)))
                           (modules '((guix build gnu-build-system)
-                                     (guix build utils))))
+                                     (guix build utils)))
+                          allowed-references)
   "Cross-build NAME for TARGET, where TARGET is a GNU triplet.  INPUTS are
 cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
 platform."
@@ -428,6 +447,16 @@ (define implicit-target-search-paths
         (standard-cross-search-paths target 'target)
         '()))
 
+  (define canonicalize-reference
+    (match-lambda
+     ((? package? p)
+      (derivation->output-path (package-cross-derivation store p system)))
+     (((? package? p) output)
+      (derivation->output-path (package-cross-derivation store p system)
+                               output))
+     ((? string? output)
+      output)))
+
   (define builder
     `(begin
        (use-modules ,@modules)
@@ -512,6 +541,10 @@ (define guile-for-build
                                               outputs
                                               (delete "debug" outputs))
                                 #:modules imported-modules
+                                #:allowed-references
+                                (and allowed-references
+                                     (map canonicalize-reference
+                                          allowed-references))
                                 #:guile-for-build guile-for-build))
 
 (define gnu-build-system
-- 
GitLab