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

@@ -55,7 +55,7 @@ (define-public perl
                 (("/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")

guix/build/gnu-build-system.scm

@@ -82,6 +82,24 @@ (define* (unpack #:key source #:allow-other-keys)
   (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 @@ (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-source-shebangs patch configure
+            build check install
             patch-shebangs strip)))
 
 

guix/build/utils.scm

@@ -26,6 +26,7 @@ (define-module (guix build utils)
   #: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 @@ (define (directory-exists? dir)
     (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)))