bug#27003: [PATCH 1/3] build/utils: Add 'program-wrapper'.

[Alex Sassmannshausen]

* guix/build/utils.scm (program-wrapper): New procedure.
---
 guix/build/utils.scm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index e8efb0653..af5583651 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -78,6 +78,7 @@
             patch-/usr/bin/file
             fold-port-matches
             remove-store-references
+            program-wrapper
             wrap-program
 
             locale-category->string))
@@ -956,6 +957,41 @@ known as `nuke-refs' in Nixpkgs."
                              (put-u8 out (char->integer char))
                              result))))))
 
+(define (program-wrapper path-proc env-var)
+  "Return a procedure, which, invoked as part of a 'wrap' phase, is capable of
+wrapping executables inside an environment in which ENV-VAR is correctly set.
+
+The string ENV-VAR is the name of the environmental variable we are setting
+for the executable we are wrapping.  PATH-PROC is a procedure of 2 arguments,
+'inputs' and 'outputs', returning the value that we should set ENV-VAR to.
+
+This is a specialized version of 'wrap-program' below, intended specifically
+to grant all executables that are part of our output access to all libraries
+that were declared in our inputs.  This is of use for languages such as Perl,
+Python and Guile."
+  (define (list-of-files dir)
+    (map (cut string-append dir "/" <>)
+         (or (scandir dir (lambda (f)
+                            (let ((s (stat (string-append dir "/" f))))
+                              (eq? 'regular (stat:type s)))))
+             '())))
+  (lambda* (#:key inputs outputs #:allow-other-keys)
+    (define bindirs
+      (append-map (match-lambda
+                    ((_ . dir)
+                     (list (string-append dir "/bin")
+                           (string-append dir "/sbin"))))
+                  outputs))
+    (define vars
+      `(,env-var prefix ,(cons (path-proc inputs outputs)
+                               (search-path-as-string->list
+                                (or (getenv env-var) "")))))
+    (for-each (lambda (dir)
+                (let ((files (list-of-files dir)))
+                  (for-each (cut wrap-program <> vars)
+                            files)))
+              bindirs)))
+
 (define* (wrap-program prog #:rest vars)
   "Make a wrapper for PROG.  VARS should look like this:
 
-- 
2.12.2