From d008415219df27f0b0ab000ceed12226183cd9b2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 15 Dec 2012 16:35:26 +0100
Subject: [PATCH] build-system/gnu: Patch shebangs in executable source files.

This allows many packages to build in a chroot that lacks /bin and
thus /bin/sh.

* guix/build/gnu-build-system.scm (patch-source-shebangs): New
  procedure.
  (%standard-phases): Add it.
* guix/build/utils.scm (executable-file?): New procedure.
* distro/packages/perl.scm (perl): Don't use /bin/sh to run `Configure'.
---
 distro/packages/perl.scm        |  2 +-
 guix/build/gnu-build-system.scm | 21 ++++++++++++++++++++-
 guix/build/utils.scm            |  7 +++++++
 3 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/distro/packages/perl.scm b/distro/packages/perl.scm
index b17342f7ad..26b25b154d 100644
--- a/distro/packages/perl.scm
+++ b/distro/packages/perl.scm
@@ -55,7 +55,7 @@
                 (("/bin/pwd") pwd))
 
               (zero?
-               (system* "/bin/sh" "./Configure"
+               (system* "./Configure"
                         (string-append "-Dprefix=" out)
                         (string-append "-Dman1dir=" out "/share/man/man1")
                         (string-append "-Dman3dir=" out "/share/man/man3")
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 3b139a99b8..b67918552c 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -82,6 +82,24 @@
   (and (zero? (system* "tar" "xvf" source))
        (chdir (first-subdirectory "."))))
 
+(define* (patch-source-shebangs #:key source #:allow-other-keys)
+  ;; Patch shebangs in executable source files.  Most scripts honor
+  ;; $SHELL and $CONFIG_SHELL, but some don't, such as `mkinstalldirs'
+  ;; or Automake's `missing' script.
+  (for-each patch-shebang
+            (filter (lambda (file)
+                      (and (executable-file? file)
+                           (not (file-is-directory? file))))
+                    (find-files "." ".*")))
+
+  ;; Gettext-generated po/Makefile.in.in does not honor $SHELL.
+  (let ((bash (search-path (search-path-as-string->list (getenv "PATH"))
+                           "bash")))
+    (when (file-exists? "po/Makefile.in.in")
+      (substitute* "po/Makefile.in.in"
+        (("^SHELL[[:blank:]]*=.*$")
+         (string-append "SHELL = " bash))))))
+
 (define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
                 #:allow-other-keys)
   (every (lambda (p)
@@ -231,7 +249,8 @@
   ;; 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-source-shebangs patch configure
+            build check install
             patch-shebangs strip)))
 
 
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 8f0eb66d39..99a43cfebd 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -26,6 +26,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:export (directory-exists?
+            executable-file?
             with-directory-excursion
             mkdir-p
             copy-recursively
@@ -56,6 +57,12 @@
     (and s
          (eq? 'directory (stat:type s)))))
 
+(define (executable-file? file)
+  "Return #t if FILE exists and is executable."
+  (let ((s (stat file #f)))
+    (and s
+         (not (zero? (logand (stat:mode s) #o100))))))
+
 (define-syntax-rule (with-directory-excursion dir body ...)
   "Run BODY with DIR as the process's current directory."
   (let ((init (getcwd)))