From 437fd809922dc8b704fa653d4b5ca2b602cb0888 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 19 Aug 2012 17:54:54 +0200
Subject: build-system/gnu: Add a `patch-shebangs' phase.

* guix/build/gnu-build-system.scm (patch-shebangs): New procedure.
  (%standard-phases): Add it.

* guix/build-system/gnu.scm (gnu-build): New `patch-shebangs?' keyword
  parameter.  Pass it to the builder's `gnu-build'.
---
 guix/build-system/gnu.scm       |  4 +++-
 guix/build/gnu-build-system.scm | 26 +++++++++++++++++++++++++-
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index e12acf20fb..cc00c0fddd 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -48,6 +48,7 @@
                     (patches ''()) (patch-flags ''("--batch" "-p1"))
                     (tests? #t)
                     (parallel-build? #t) (parallel-tests? #t)
+                    (patch-shebangs? #t)
                     (phases '%standard-phases)
                     (system (%current-system))
                     (modules '((guix build gnu-build-system)
@@ -69,7 +70,8 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
                   #:make-flags ,make-flags
                   #:tests? ,tests?
                   #:parallel-build? ,parallel-build?
-                  #:parallel-tests? ,parallel-tests?)))
+                  #:parallel-tests? ,parallel-tests?
+                  #:patch-shebangs? ,patch-shebangs?)))
 
   (build-expression->derivation store name system
                                 builder
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 0790c39256..0a865fca23 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -21,6 +21,7 @@
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (%standard-phases
             gnu-build))
 
@@ -117,11 +118,34 @@
 (define* (install #:key (make-flags '()) #:allow-other-keys)
   (zero? (apply system* "make" "install" make-flags)))
 
+(define* (patch-shebangs #:key outputs (patch-shebangs? #t)
+                         #:allow-other-keys)
+  (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)))))
+             '())))
+
+  (define bindirs
+    (append-map (match-lambda
+                 ((_ . dir)
+                  (list (string-append dir "/bin")
+                        (string-append dir "/sbin"))))
+                outputs))
+
+  (for-each (lambda (dir)
+              (let ((files (list-of-files dir)))
+                (for-each patch-shebang files)))
+            bindirs)
+  #t)
+
 (define %standard-phases
   ;; Standard build phases, as a list of symbol/procedure pairs.
   (let-syntax ((phases (syntax-rules ()
                          ((_ p ...) `((p . ,p) ...)))))
-    (phases set-paths unpack patch configure build check install)))
+    (phases set-paths unpack patch configure build check install
+            patch-shebangs)))
 
 
 (define* (gnu-build #:key (source #f) (outputs #f) (inputs #f)
-- 
cgit v1.2.3