me
/
guix
Archived
1
0
Fork 0

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'.
master
Ludovic Courtès 2012-12-15 16:35:26 +01:00
parent c1c94acf32
commit d008415219
3 changed files with 28 additions and 2 deletions

View File

@ -55,7 +55,7 @@
(("/bin/pwd") pwd)) (("/bin/pwd") pwd))
(zero? (zero?
(system* "/bin/sh" "./Configure" (system* "./Configure"
(string-append "-Dprefix=" out) (string-append "-Dprefix=" out)
(string-append "-Dman1dir=" out "/share/man/man1") (string-append "-Dman1dir=" out "/share/man/man1")
(string-append "-Dman3dir=" out "/share/man/man3") (string-append "-Dman3dir=" out "/share/man/man3")

View File

@ -82,6 +82,24 @@
(and (zero? (system* "tar" "xvf" source)) (and (zero? (system* "tar" "xvf" source))
(chdir (first-subdirectory ".")))) (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")) (define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
#:allow-other-keys) #:allow-other-keys)
(every (lambda (p) (every (lambda (p)
@ -231,7 +249,8 @@
;; Standard build phases, as a list of symbol/procedure pairs. ;; Standard build phases, as a list of symbol/procedure pairs.
(let-syntax ((phases (syntax-rules () (let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...))))) ((_ 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))) patch-shebangs strip)))

View File

@ -26,6 +26,7 @@
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:export (directory-exists? #:export (directory-exists?
executable-file?
with-directory-excursion with-directory-excursion
mkdir-p mkdir-p
copy-recursively copy-recursively
@ -56,6 +57,12 @@
(and s (and s
(eq? 'directory (stat:type 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 ...) (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)))