From 8a0576f175a656a332c5a4ca65168e76c56af5c3 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 21 Aug 2014 11:30:08 -0400 Subject: gnu-build-system: Add 'patch-usr-bin-file' to %standard-phases. * guix/build/gnu-build-system.scm (patch-usr-bin-file): New procedure. (%standard-phases): Add it. --- guix/build/gnu-build-system.scm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) (limited to 'guix') 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 . +(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))) -- cgit v1.2.3 From 83291101c39c1cd1bf472280c24ad68d94248c2e Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Wed, 27 Aug 2014 10:26:54 -0500 Subject: utils: Preserve makefile shell arguments during patch. * guix/build/utils.scm (patch-makefile-SHELL): Preserve shell arguments. --- guix/build/utils.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 2f3dc9cad0..f38b2cabfc 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -582,14 +582,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:]]+)[[:blank:]]*(.*)$" + _ 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)))) -- cgit v1.2.3 From 11459384968f654c42ad7dba4443dada35191f5b Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Thu, 4 Sep 2014 09:19:24 -0500 Subject: utils: Clean trailing whitespace at end of SHELL * guix/build/utils.scm (patch-makefile-SHELL): Remove trailing whitespace. --- guix/build/utils.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index f38b2cabfc..d169053c7b 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -582,7 +582,7 @@ 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:]]*(.*)$" + (("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$" _ dir shell args) (let* ((old (string-append dir shell)) (new (or (find-shell shell) old))) @@ -590,7 +590,7 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged." (format (current-error-port) "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%" file old new)) - (string-append "SHELL = " new " " args)))) + (string-append "SHELL = " new args)))) (when keep-mtime? (set-file-time file st)))) -- cgit v1.2.3 From de61113857d3ebda1f4557c5a8f6bffe63100060 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Sat, 13 Sep 2014 01:05:03 -0500 Subject: utils: Allow wrap-program to be called multiple times. * guix/build/utils.scm (wrap-program): Multiple invocations of wrap-program for the same file create successive wrappers. Adjust docstring. * tests/build-utils.scm: Test new wrap-program behavior. (%store): New variable. --- guix/build/utils.scm | 44 ++++++++++++++++++++++++++++----------- tests/build-utils.scm | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 88 insertions(+), 13 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index d169053c7b..7257b30dfd 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -687,8 +687,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) @@ -697,23 +696,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 @@ -736,8 +756,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 @@ -745,9 +763,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: diff --git a/tests/build-utils.scm b/tests/build-utils.scm index e94f04b239..a5ea640c47 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -18,9 +18,24 @@ (define-module (test-build-utils) + #:use-module (guix tests) + #:use-module (guix store) + #:use-module (guix derivations) #:use-module (guix build utils) - #:use-module (srfi srfi-64)) + #:use-module (guix packages) + #:use-module (guix build-system) + #:use-module (guix build-system trivial) + #:use-module (gnu packages) + #:use-module (gnu packages bootstrap) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-64) + #:use-module (rnrs io ports) + #:use-module (ice-9 popen)) +(define %store + (open-connection-for-tests)) + + (test-begin "build-utils") (test-equal "alist-cons-before" @@ -80,6 +95,46 @@ port cons))))) +(test-assert "wrap-program, one input, multiple calls" + (let* ((p (package + (name "test-wrap-program") (version "0") (source #f) + (synopsis #f) (description #f) (license #f) (home-page #f) + (build-system trivial-build-system) + (arguments + `(#:guile ,%bootstrap-guile + #:modules ((guix build utils)) + #:builder + (let* ((out (assoc-ref %outputs "out")) + (bash (assoc-ref %build-inputs "bash")) + (foo (string-append out "/foo"))) + (begin + (use-modules (guix build utils)) + (mkdir out) + (call-with-output-file foo + (lambda (p) + (format p + "#!~a~%echo \"${GUIX_FOO} ${GUIX_BAR}\"~%" + bash))) + (chmod foo #o777) + ;; wrap-program uses `which' to find bash for the wrapper + ;; shebang, but it can't know about the bootstrap bash in + ;; the store, since it's not named "bash". Help it out a + ;; bit by providing a symlink it this package's output. + (symlink bash (string-append out "/bash")) + (setenv "PATH" out) + (wrap-program foo `("GUIX_FOO" prefix ("hello"))) + (wrap-program foo `("GUIX_BAR" prefix ("world"))) + #t)))) + (inputs `(("bash" ,(search-bootstrap-binary "bash" + (%current-system))))))) + (d (package-derivation %store p))) + (and (build-derivations %store (pk 'drv d (list d))) + (let* ((p (derivation->output-path d)) + (foo (string-append p "/foo")) + (pipe (open-input-pipe foo)) + (str (get-string-all pipe))) + (equal? str "hello world\n"))))) + (test-end) -- cgit v1.2.3 From c041886d920f2361702c412e0e19e55184fbf7b6 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 14 Sep 2014 11:54:25 -0400 Subject: utils: Import (ice-9 format). * guix/build/utils.scm: Import (ice-9 format). --- guix/build/utils.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 7257b30dfd..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 -- cgit v1.2.3