aboutsummaryrefslogtreecommitdiff
path: root/guix/build/utils.scm
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 /guix/build/utils.scm
parent8722e80e82f6b2ca326b20a4b3179ed25115ce4f (diff)
downloadgnu-guix-c089511288820cfb3efc5295e572be24aa83f068.tar
gnu-guix-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'.
Diffstat (limited to 'guix/build/utils.scm')
-rw-r--r--guix/build/utils.scm90
1 files changed, 66 insertions, 24 deletions
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)))