summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-12-21 22:31:25 +0100
committerLudovic Courtès <ludo@gnu.org>2012-12-21 22:31:25 +0100
commitc089511288820cfb3efc5295e572be24aa83f068 (patch)
treeece62d1d06ee146feb59f60fe5c4d307542205cc
parent8722e80e82f6b2ca326b20a4b3179ed25115ce4f (diff)
downloadguix-c089511288820cfb3efc5295e572be24aa83f068.tar.gz
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'.
-rw-r--r--distro/packages/autotools.scm1
-rw-r--r--distro/packages/base.scm31
-rw-r--r--distro/packages/bash.scm16
-rw-r--r--distro/packages/ncurses.scm8
-rw-r--r--distro/packages/readline.scm14
-rw-r--r--guix/build/gnu-build-system.scm28
-rw-r--r--guix/build/utils.scm90
7 files changed, 92 insertions, 96 deletions
diff --git a/distro/packages/autotools.scm b/distro/packages/autotools.scm
index 1c01b3d3db..171855b937 100644
--- a/distro/packages/autotools.scm
+++ b/distro/packages/autotools.scm
@@ -118,7 +118,6 @@ Standards.  Automake requires the use of Autoconf.")
                             (string-append "-j" ncores)))
 
                    ;; Path references to /bin/sh.
-                   (patch-shebang "libtoolize")
                    (let ((bash (assoc-ref inputs "bash")))
                      (substitute* "tests/testsuite"
                        (("/bin/sh")
diff --git a/distro/packages/base.scm b/distro/packages/base.scm
index 0a937486a4..0289b6c688 100644
--- a/distro/packages/base.scm
+++ b/distro/packages/base.scm
@@ -428,9 +428,6 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
 ~a~%"
                             libc line))))
 
-               ;; Adjust hard-coded #!/bin/sh.
-               (patch-shebang "gcc/exec-tool.in")
-
                ;; Don't retain a dependency on the build-time sed.
                (substitute* "fixincludes/fixincl.x"
                  (("static char const sed_cmd_z\\[\\] =.*;")
@@ -967,29 +964,11 @@ store.")
   ;; FIXME: The Libtool used here, specifically its `bin/libtool' script,
   ;; holds a dependency on the bootstrap Binutils.  Use multiple outputs for
   ;; Libtool, so that that dependency is isolated in the "bin" output.
-  (let ((guile (package (inherit guile-2.0/fixed)
-                 (arguments
-                  (substitute-keyword-arguments
-                      (package-arguments guile-2.0/fixed)
-                    ((#:phases phases)
-                     `(alist-cons-before
-                       'patch-source-shebangs 'delete-encoded-test
-                       (lambda* (#:key inputs #:allow-other-keys)
-                         ;; %BOOTSTRAP-GUILE doesn't know about encodings other
-                         ;; than UTF-8.  That test declares an ISO-8859-1
-                         ;; encoding, which prevents `patch-shebang' from
-                         ;; working, so skip it.
-                         (call-with-output-file
-                             "test-suite/standalone/test-command-line-encoding2"
-                           (lambda (p)
-                             (format p "#!~a/bin/bash\nexit 77"
-                                     (assoc-ref inputs "bash")))))
-                       ,phases)))))))
-    (package-with-bootstrap-guile
-     (package-with-explicit-inputs guile
-                                   %boot4-inputs
-                                   (current-source-location)
-                                   #:guile %bootstrap-guile))))
+  (package-with-bootstrap-guile
+   (package-with-explicit-inputs guile-2.0/fixed
+                                 %boot4-inputs
+                                 (current-source-location)
+                                 #:guile %bootstrap-guile)))
 
 (define-public ld-wrapper
   ;; The final `ld' wrapper, which uses the final Guile.
diff --git a/distro/packages/bash.scm b/distro/packages/bash.scm
index c2022fcf95..f32293d82f 100644
--- a/distro/packages/bash.scm
+++ b/distro/packages/bash.scm
@@ -33,13 +33,6 @@
                                  "-DNON_INTERACTIVE_LOGIN_SHELLS"
                                  "-DSSH_SOURCE_BASHRC")
                                " "))
-        (pre-configure-phase
-         '(lambda* (#:key inputs #:allow-other-keys)
-            ;; Use the right shell for makefiles.
-            (let ((bash (assoc-ref inputs "bash")))
-              (substitute* "configure"
-                (("MAKE_SHELL=[^ ]+")
-                 (format #f "MAKE_SHELL=~a/bin/bash" bash))))))
         (post-install-phase
          '(lambda* (#:key outputs #:allow-other-keys)
             ;; Add a `bash' -> `sh' link.
@@ -80,12 +73,9 @@
         ;; for now.
         #:tests? #f
 
-        #:phases (alist-cons-before
-                  'configure 'pre-configure
-                  ,pre-configure-phase
-                  (alist-cons-after 'install 'post-install
-                                    ,post-install-phase
-                                    %standard-phases))))
+        #:phases (alist-cons-after 'install 'post-install
+                                   ,post-install-phase
+                                   %standard-phases)))
      (synopsis "GNU Bourne-Again Shell")
      (description
       "Bash is the shell, or command language interpreter, that will appear in
diff --git a/distro/packages/ncurses.scm b/distro/packages/ncurses.scm
index 868222ef83..8bde3c1989 100644
--- a/distro/packages/ncurses.scm
+++ b/distro/packages/ncurses.scm
@@ -28,9 +28,6 @@
          '(lambda _
             (substitute* (find-files "." "Makefile.in")
               (("^SHELL[[:blank:]]*=.*$") ""))))
-        (pre-install-phase
-         '(lambda _
-            (for-each patch-shebang (find-files "." "\\.sh$"))))
         (post-install-phase
          '(lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
@@ -93,10 +90,7 @@
                      (alist-cons-before
                       'configure 'patch-makefile-SHELL
                       ,patch-makefile-phase
-                      (alist-cons-before
-                       'install 'pre-install-phase
-                       ,pre-install-phase
-                       %standard-phases)))
+                      %standard-phases))
 
            ;; The `ncursesw5-config' has a #!/bin/sh that we don't want to
            ;; patch, to avoid retaining a reference to the build-time Bash.
diff --git a/distro/packages/readline.scm b/distro/packages/readline.scm
index bf542e90b5..8e2a4cbb5d 100644
--- a/distro/packages/readline.scm
+++ b/distro/packages/readline.scm
@@ -36,14 +36,7 @@
               (for-each (lambda (f) (chmod f #o755))
                         (find-files lib "\\.so"))
               (for-each (lambda (f) (chmod f #o644))
-                        (find-files lib "\\.a")))))
-        (pre-configure-phase
-         '(lambda* (#:key inputs #:allow-other-keys)
-            ;; Use the right shell for makefiles.
-            (let ((bash (assoc-ref inputs "bash")))
-              (substitute* "configure"
-                (("^MAKE_SHELL=.*")
-                 (format #f "MAKE_SHELL=~a/bin/bash" bash)))))))
+                        (find-files lib "\\.a"))))))
     (package
       (name "readline")
       (version "6.2")
@@ -69,10 +62,7 @@
                    #:phases (alist-cons-after
                              'install 'post-install
                              ,post-install-phase
-                             (alist-cons-before
-                              'configure 'pre-configure
-                              ,pre-configure-phase
-                              %standard-phases))))
+                             %standard-phases)))
       (synopsis "GNU Readline, a library for interactive line editing")
       (description
        "The GNU Readline library provides a set of functions for use by
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 18c66e5256..b5eaa26bf5 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -84,24 +84,26 @@
        (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.
+  "Patch shebangs in all source files; this includes non-executable
+files such as `.in' templates.  Most scripts honor $SHELL and
+$CONFIG_SHELL, but some don't, such as `mkinstalldirs' or Automake's
+`missing' script."
+  (for-each patch-shebang
+            (remove file-is-directory? (find-files "." ".*"))))
+
+(define (patch-generated-file-shebangs . rest)
+  "Patch shebangs in generated files, including `SHELL' variables in
+makefiles."
+  ;; Patch executable files, some of which might have been generated by
+  ;; `configure'.
   (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 "\n"))))))
-
-(define patch-generated-files patch-source-shebangs)
+  ;; Patch `SHELL' in generated makefiles.
+  (for-each patch-makefile-SHELL (find-files "." "^(GNU)?[mM]akefile$")))
 
 (define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
                 #:allow-other-keys)
@@ -253,7 +255,7 @@
   (let-syntax ((phases (syntax-rules ()
                          ((_ p ...) `((p . ,p) ...)))))
     (phases set-paths unpack patch
-            patch-source-shebangs configure patch-generated-files
+            patch-source-shebangs configure patch-generated-file-shebangs
             build check install
             patch-shebangs strip)))
 
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)))