summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-22 23:06:33 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-22 23:06:33 +0200
commitf07aa672fddd7b5405fc730ffebcda67daa71ae1 (patch)
tree52b2a3f246f5022ef7eaa7e20cb9aac067e10d05 /guix
parent52ac153e2a83035ce2bc875f9c414cb26db5f6fc (diff)
parentdd68dd137a4a70cde7e344bd969ef7849355d018 (diff)
Merge branch 'core-updates'
Diffstat (limited to 'guix')
-rw-r--r--guix/build/gnu-build-system.scm30
-rw-r--r--guix/build/utils.scm50
2 files changed, 66 insertions, 14 deletions
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 8636931ed9..17fa7afd8d 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -106,6 +106,35 @@ working directory."
(and (zero? (system* "tar" "xvf" source))
(chdir (first-subdirectory ".")))))
+;; See <http://bugs.gnu.org/17840>.
+(define* (patch-usr-bin-file #:key native-inputs inputs
+ (patch-/usr/bin/file? #t)
+ #:allow-other-keys)
+ "Patch occurrences of /usr/bin/file in configure, if present."
+ (when patch-/usr/bin/file?
+ (let ((file "configure")
+ (file-command (or (and=> (assoc-ref (or native-inputs inputs) "file")
+ (cut string-append <> "/bin/file"))
+ (which "file"))))
+ (cond ((not (file-exists? file))
+ (format (current-error-port)
+ "patch-usr-bin-file: warning: `~a' not found~%"
+ file))
+ ((not file-command)
+ (format (current-error-port)
+ "patch-usr-bin-file: warning: `file' not found in PATH~%"))
+ (else
+ (let ((st (stat file)))
+ (substitute* file
+ (("/usr/bin/file")
+ (begin
+ (format (current-error-port)
+ "patch-usr-bin-file: ~a: changing `~a' to `~a'~%"
+ file "/usr/bin/file" file-command)
+ file-command)))
+ (set-file-time file st))))))
+ #t)
+
(define* (patch-source-shebangs #:key source #:allow-other-keys)
"Patch shebangs in all source files; this includes non-executable
files such as `.in' templates. Most scripts honor $SHELL and
@@ -353,6 +382,7 @@ makefiles."
(let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...)))))
(phases set-paths unpack
+ patch-usr-bin-file
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 2f3dc9cad0..cda4fb12ef 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -25,6 +25,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 format)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:re-export (alist-cons
@@ -582,14 +583,15 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged."
(let ((st (stat file)))
(substitute* file
- (("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)[[:blank:]]*" _ dir shell)
+ (("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$"
+ _ dir shell args)
(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"))))
+ (string-append "SHELL = " new args))))
(when keep-mtime?
(set-file-time file st))))
@@ -686,8 +688,7 @@ known as `nuke-refs' in Nixpkgs."
result))))))
(define* (wrap-program prog #:rest vars)
- "Rename PROG to .PROG-real and make PROG a wrapper. VARS should look like
-this:
+ "Make a wrapper for PROG. VARS should look like this:
'(VARIABLE DELIMITER POSITION LIST-OF-DIRECTORIES)
@@ -696,23 +697,44 @@ where DELIMITER is optional. ':' will be used if DELIMITER is not given.
For example, this command:
(wrap-program \"foo\"
- '(\"PATH\" \":\" = (\"/nix/.../bar/bin\"))
- '(\"CERT_PATH\" suffix (\"/nix/.../baz/certs\"
+ '(\"PATH\" \":\" = (\"/gnu/.../bar/bin\"))
+ '(\"CERT_PATH\" suffix (\"/gnu/.../baz/certs\"
\"/qux/certs\")))
will copy 'foo' to '.foo-real' and create the file 'foo' with the following
contents:
#!location/of/bin/bash
- export PATH=\"/nix/.../bar/bin\"
- export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/nix/.../baz/certs:/qux/certs\"
+ export PATH=\"/gnu/.../bar/bin\"
+ export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/gnu/.../baz/certs:/qux/certs\"
exec location/of/.foo-real
This is useful for scripts that expect particular programs to be in $PATH, for
programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or
-modules in $GUILE_LOAD_PATH, etc."
- (let ((prog-real (string-append (dirname prog) "/." (basename prog) "-real"))
- (prog-tmp (string-append (dirname prog) "/." (basename prog) "-tmp")))
+modules in $GUILE_LOAD_PATH, etc.
+
+If PROG has previously been wrapped by wrap-program the wrapper will point to
+the previous wrapper."
+ (define (wrapper-file-name number)
+ (format #f "~a/.~a-wrap-~2'0d" (dirname prog) (basename prog) number))
+ (define (next-wrapper-number)
+ (let ((wrappers
+ (find-files (dirname prog)
+ (string-append "\\." (basename prog) "-wrap-.*"))))
+ (if (null? wrappers)
+ 0
+ (string->number (string-take-right (last wrappers) 2)))))
+ (define (wrapper-target number)
+ (if (zero? number)
+ (let ((prog-real (string-append (dirname prog) "/."
+ (basename prog) "-real")))
+ (copy-file prog prog-real)
+ prog-real)
+ (wrapper-file-name number)))
+ (let* ((number (next-wrapper-number))
+ (target (wrapper-target number))
+ (wrapper (wrapper-file-name (1+ number)))
+ (prog-tmp (string-append target "-tmp")))
(define (export-variable lst)
;; Return a string that exports an environment variable.
(match lst
@@ -735,8 +757,6 @@ modules in $GUILE_LOAD_PATH, etc."
(format #f "export ~a=\"$~a${~a:+:}~a\""
var var var (string-join rest ":")))))
- (copy-file prog prog-real)
-
(with-output-to-file prog-tmp
(lambda ()
(format #t
@@ -744,9 +764,11 @@ modules in $GUILE_LOAD_PATH, etc."
(which "bash")
(string-join (map export-variable vars)
"\n")
- (canonicalize-path prog-real))))
+ (canonicalize-path target))))
(chmod prog-tmp #o755)
+ (rename-file prog-tmp wrapper)
+ (symlink wrapper prog-tmp)
(rename-file prog-tmp prog)))
;;; Local Variables: