From c089511288820cfb3efc5295e572be24aa83f068 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 21 Dec 2012 22:31:25 +0100
Subject: build-system/gnu: Patch shebangs in all the source; patch SHELL in
 makefiles.

* guix/build/utils.scm (call-with-ascii-input-file): New procedure.
  (patch-shebang): Use it.
  (patch-makefile-SHELL): New procedure.
* guix/build/gnu-build-system.scm (patch-source-shebangs): Patch all the
  files, not just executables; remove `po/Makefile.in.in' patching.
  (patch-generated-files): Rename to...
  (patch-generated-file-shebangs): ... this.  Patch executables and
  makefiles.
  (%standard-phases): Adjust accordingly.

* distro/packages/autotools.scm (libtool): Remove call to `patch-shebang'.
* distro/packages/base.scm (gcc-4.7): Likewise.
  (guile-final): Remove hack to skip `test-command-line-encoding2'.
* distro/packages/bash.scm (bash): Remove `pre-configure-phase'.
* distro/packages/readline.scm (readline): Likewise.
* distro/packages/ncurses.scm (ncurses): Remove `pre-install-phase'.
---
 guix/build/utils.scm | 90 ++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 66 insertions(+), 24 deletions(-)

(limited to 'guix/build/utils.scm')

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 0de7392620..c54c83883b 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -27,6 +27,7 @@
   #:use-module (rnrs io ports)
   #:export (directory-exists?
             executable-file?
+            call-with-ascii-input-file
             with-directory-excursion
             mkdir-p
             copy-recursively
@@ -43,6 +44,7 @@
             substitute*
             dump-port
             patch-shebang
+            patch-makefile-SHELL
             fold-port-matches
             remove-store-references))
 
@@ -63,6 +65,21 @@
     (and s
          (not (zero? (logand (stat:mode s) #o100))))))
 
+(define (call-with-ascii-input-file file proc)
+  "Open FILE as an ASCII or binary file, and pass the resulting port to
+PROC.  FILE is closed when PROC's dynamic extent is left.  Return the
+return values of applying PROC to the port."
+  (let ((port (with-fluids ((%default-port-encoding #f))
+                ;; Use "b" so that `open-file' ignores `coding:' cookies.
+                (open-file file "rb"))))
+    (dynamic-wind
+      (lambda ()
+        #t)
+      (lambda ()
+        (proc port))
+      (lambda ()
+        (close-input-port port)))))
+
 (define-syntax-rule (with-directory-excursion dir body ...)
   "Run BODY with DIR as the process's current directory."
   (let ((init (getcwd)))
@@ -418,30 +435,55 @@ patched, #f otherwise."
               (false-if-exception (delete-file template))
               #f))))
 
-      (with-fluids ((%default-port-encoding #f))  ; ASCII
-        (call-with-input-file file
-          (lambda (p)
-            (and (eq? #\# (read-char p))
-                 (eq? #\! (read-char p))
-                 (let ((line (false-if-exception (read-line p))))
-                   (and=> (and line (regexp-exec shebang-rx line))
-                          (lambda (m)
-                            (let* ((cmd (match:substring m 1))
-                                   (bin (search-path path
-                                                     (basename cmd))))
-                              (if bin
-                                  (if (string=? bin cmd)
-                                      #f          ; nothing to do
-                                      (begin
-                                        (format (current-error-port)
-                                                "patch-shebang: ~a: changing `~a' to `~a'~%"
-                                                file cmd bin)
-                                        (patch p bin (match:substring m 2))))
-                                  (begin
-                                    (format (current-error-port)
-                                            "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%"
-                                            file (basename cmd))
-                                    #f)))))))))))))
+      (call-with-ascii-input-file file
+        (lambda (p)
+          (and (eq? #\# (read-char p))
+               (eq? #\! (read-char p))
+               (let ((line (false-if-exception (read-line p))))
+                 (and=> (and line (regexp-exec shebang-rx line))
+                        (lambda (m)
+                          (let* ((cmd (match:substring m 1))
+                                 (bin (search-path path (basename cmd))))
+                            (if bin
+                                (if (string=? bin cmd)
+                                    #f            ; nothing to do
+                                    (begin
+                                      (format (current-error-port)
+                                              "patch-shebang: ~a: changing `~a' to `~a'~%"
+                                              file cmd bin)
+                                      (patch p bin (match:substring m 2))))
+                                (begin
+                                  (format (current-error-port)
+                                          "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%"
+                                          file (basename cmd))
+                                  #f))))))))))))
+
+(define (patch-makefile-SHELL file)
+  "Patch the `SHELL' variable in FILE, which is supposedly a makefile."
+
+  ;; For instance, Gettext-generated po/Makefile.in.in do not honor $SHELL.
+
+  ;; XXX: Unlike with `patch-shebang', FILE is always touched.
+
+  (define (find-shell name)
+    (let ((shell
+           (search-path (search-path-as-string->list (getenv "PATH"))
+                        name)))
+      (unless shell
+        (format (current-error-port)
+                "patch-makefile-SHELL: warning: no binary for shell `~a' found in $PATH~%"
+                name))
+      shell))
+
+  (substitute* file
+    (("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)[[:blank:]]*" _ dir shell)
+     (let* ((old (string-append dir shell))
+            (new (or (find-shell shell) old)))
+       (unless (string=? new old)
+         (format (current-error-port)
+                 "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
+                 file old new))
+       (string-append "SHELL = " new "\n")))))
 
 (define* (fold-port-matches proc init pattern port
                             #:optional (unmatched (lambda (_ r) r)))
-- 
cgit v1.2.3