nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2012-12-21 22:31:25 +01:00
parent 8722e80e82
commit c089511288
7 changed files with 92 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
distro/packages/autotools.scm
View File

@ -118,7 +118,6 @@ Standards. Automake requires the use of Autoconf.")
(string-append "-j" ncores))) (string-append "-j" ncores)))
;; Path references to /bin/sh. ;; Path references to /bin/sh.
(patch-shebang "libtoolize")
(let ((bash (assoc-ref inputs "bash"))) (let ((bash (assoc-ref inputs "bash")))
(substitute* "tests/testsuite" (substitute* "tests/testsuite"
(("/bin/sh") (("/bin/sh")

31
distro/packages/base.scm
View File

@ -428,9 +428,6 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
~a~%" ~a~%"
libc line)))) libc line))))
;; Adjust hard-coded #!/bin/sh.
(patch-shebang "gcc/exec-tool.in")
;; Don't retain a dependency on the build-time sed. ;; Don't retain a dependency on the build-time sed.
(substitute* "fixincludes/fixincl.x" (substitute* "fixincludes/fixincl.x"
(("static char const sed_cmd_z\\[\\] =.*;") (("static char const sed_cmd_z\\[\\] =.*;")
@ -967,29 +964,11 @@ store.")
;; FIXME: The Libtool used here, specifically its `bin/libtool' script, ;; FIXME: The Libtool used here, specifically its `bin/libtool' script,
;; holds a dependency on the bootstrap Binutils. Use multiple outputs for ;; holds a dependency on the bootstrap Binutils. Use multiple outputs for
;; Libtool, so that that dependency is isolated in the "bin" output. ;; Libtool, so that that dependency is isolated in the "bin" output.
(let ((guile (package (inherit guile-2.0/fixed) (package-with-bootstrap-guile
(arguments (package-with-explicit-inputs guile-2.0/fixed
(substitute-keyword-arguments %boot4-inputs
(package-arguments guile-2.0/fixed) (current-source-location)
((#:phases phases) #:guile %bootstrap-guile)))
`(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))))
(define-public ld-wrapper (define-public ld-wrapper
;; The final `ld' wrapper, which uses the final Guile. ;; The final `ld' wrapper, which uses the final Guile.

16
distro/packages/bash.scm
View File

@ -33,13 +33,6 @@
"-DNON_INTERACTIVE_LOGIN_SHELLS" "-DNON_INTERACTIVE_LOGIN_SHELLS"
"-DSSH_SOURCE_BASHRC") "-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 (post-install-phase
'(lambda* (#:key outputs #:allow-other-keys) '(lambda* (#:key outputs #:allow-other-keys)
;; Add a `bash' -> `sh' link. ;; Add a `bash' -> `sh' link.
@ -80,12 +73,9 @@
;; for now. ;; for now.
#:tests? #f #:tests? #f
#:phases (alist-cons-before #:phases (alist-cons-after 'install 'post-install
'configure 'pre-configure ,post-install-phase
,pre-configure-phase %standard-phases)))
(alist-cons-after 'install 'post-install
,post-install-phase
%standard-phases))))
(synopsis "GNU Bourne-Again Shell") (synopsis "GNU Bourne-Again Shell")
(description (description
"Bash is the shell, or command language interpreter, that will appear in "Bash is the shell, or command language interpreter, that will appear in

8
distro/packages/ncurses.scm
View File

@ -28,9 +28,6 @@
'(lambda _ '(lambda _
(substitute* (find-files "." "Makefile.in") (substitute* (find-files "." "Makefile.in")
(("^SHELL[[:blank:]]*=.*$") "")))) (("^SHELL[[:blank:]]*=.*$") ""))))
(pre-install-phase
'(lambda _
(for-each patch-shebang (find-files "." "\\.sh$"))))
(post-install-phase (post-install-phase
'(lambda* (#:key outputs #:allow-other-keys) '(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
@ -93,10 +90,7 @@
(alist-cons-before (alist-cons-before
'configure 'patch-makefile-SHELL 'configure 'patch-makefile-SHELL
,patch-makefile-phase ,patch-makefile-phase
(alist-cons-before %standard-phases))
'install 'pre-install-phase
,pre-install-phase
%standard-phases)))
;; The `ncursesw5-config' has a #!/bin/sh that we don't want to ;; The `ncursesw5-config' has a #!/bin/sh that we don't want to
;; patch, to avoid retaining a reference to the build-time Bash. ;; patch, to avoid retaining a reference to the build-time Bash.

14
distro/packages/readline.scm
View File

@ -36,14 +36,7 @@
(for-each (lambda (f) (chmod f #o755)) (for-each (lambda (f) (chmod f #o755))
(find-files lib "\\.so")) (find-files lib "\\.so"))
(for-each (lambda (f) (chmod f #o644)) (for-each (lambda (f) (chmod f #o644))
(find-files lib "\\.a"))))) (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)))))))
(package (package
(name "readline") (name "readline")
(version "6.2") (version "6.2")
@ -69,10 +62,7 @@
#:phases (alist-cons-after #:phases (alist-cons-after
'install 'post-install 'install 'post-install
,post-install-phase ,post-install-phase
(alist-cons-before %standard-phases)))
'configure 'pre-configure
,pre-configure-phase
%standard-phases))))
(synopsis "GNU Readline, a library for interactive line editing") (synopsis "GNU Readline, a library for interactive line editing")
(description (description
"The GNU Readline library provides a set of functions for use by "The GNU Readline library provides a set of functions for use by

28
guix/build/gnu-build-system.scm
View File

@ -84,24 +84,26 @@
(chdir (first-subdirectory ".")))) (chdir (first-subdirectory "."))))
(define* (patch-source-shebangs #:key source #:allow-other-keys) (define* (patch-source-shebangs #:key source #:allow-other-keys)
;; Patch shebangs in executable source files. Most scripts honor "Patch shebangs in all source files; this includes non-executable
;; $SHELL and $CONFIG_SHELL, but some don't, such as `mkinstalldirs' files such as `.in' templates. Most scripts honor $SHELL and
;; or Automake's `missing' script. $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 (for-each patch-shebang
(filter (lambda (file) (filter (lambda (file)
(and (executable-file? file) (and (executable-file? file)
(not (file-is-directory? file)))) (not (file-is-directory? file))))
(find-files "." ".*"))) (find-files "." ".*")))
;; Gettext-generated po/Makefile.in.in does not honor $SHELL. ;; Patch `SHELL' in generated makefiles.
(let ((bash (search-path (search-path-as-string->list (getenv "PATH")) (for-each patch-makefile-SHELL (find-files "." "^(GNU)?[mM]akefile$")))
"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)
(define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1")) (define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
#:allow-other-keys) #:allow-other-keys)
@ -253,7 +255,7 @@
(let-syntax ((phases (syntax-rules () (let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...))))) ((_ p ...) `((p . ,p) ...)))))
(phases set-paths unpack patch (phases set-paths unpack patch
patch-source-shebangs configure patch-generated-files patch-source-shebangs configure patch-generated-file-shebangs
build check install build check install
patch-shebangs strip))) patch-shebangs strip)))

90
guix/build/utils.scm
View File

@ -27,6 +27,7 @@
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:export (directory-exists? #:export (directory-exists?
executable-file? executable-file?
call-with-ascii-input-file
with-directory-excursion with-directory-excursion
mkdir-p mkdir-p
copy-recursively copy-recursively
@ -43,6 +44,7 @@
substitute* substitute*
dump-port dump-port
patch-shebang patch-shebang
patch-makefile-SHELL
fold-port-matches fold-port-matches
remove-store-references)) remove-store-references))
@ -63,6 +65,21 @@
(and s (and s
(not (zero? (logand (stat:mode s) #o100)))))) (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 ...) (define-syntax-rule (with-directory-excursion dir body ...)
"Run BODY with DIR as the process's current directory." "Run BODY with DIR as the process's current directory."
(let ((init (getcwd))) (let ((init (getcwd)))
@ -418,30 +435,55 @@ patched, #f otherwise."
(false-if-exception (delete-file template)) (false-if-exception (delete-file template))
#f)))) #f))))
(with-fluids ((%default-port-encoding #f)) ; ASCII (call-with-ascii-input-file file
(call-with-input-file file (lambda (p)
(lambda (p) (and (eq? #\# (read-char p))
(and (eq? #\# (read-char p)) (eq? #\! (read-char p))
(eq? #\! (read-char p)) (let ((line (false-if-exception (read-line p))))
(let ((line (false-if-exception (read-line p)))) (and=> (and line (regexp-exec shebang-rx line))
(and=> (and line (regexp-exec shebang-rx line)) (lambda (m)
(lambda (m) (let* ((cmd (match:substring m 1))
(let* ((cmd (match:substring m 1)) (bin (search-path path (basename cmd))))
(bin (search-path path (if bin
(basename cmd)))) (if (string=? bin cmd)
(if bin #f ; nothing to do
(if (string=? bin cmd) (begin
#f ; nothing to do (format (current-error-port)
(begin "patch-shebang: ~a: changing `~a' to `~a'~%"
(format (current-error-port) file cmd bin)
"patch-shebang: ~a: changing `~a' to `~a'~%" (patch p bin (match:substring m 2))))
file cmd bin) (begin
(patch p bin (match:substring m 2)))) (format (current-error-port)
(begin "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%"
(format (current-error-port) file (basename cmd))
"patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%" #f))))))))))))
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 (define* (fold-port-matches proc init pattern port
#:optional (unmatched (lambda (_ r) r))) #:optional (unmatched (lambda (_ r) r)))