diff options
author | Nikita Karetnikov <nikita@karetnikov.org> | 2013-03-03 23:20:28 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-03-07 00:46:23 +0100 |
commit | 30db6af1de2066430ac59cec7dbf0105c3230ff0 (patch) | |
tree | bfa3181689abcbe903e061c2b90fca1b5d4938fd | |
parent | b16c5a5857c449c4a952115d47ba8fe09948724e (diff) | |
download | patches-30db6af1de2066430ac59cec7dbf0105c3230ff0.tar patches-30db6af1de2066430ac59cec7dbf0105c3230ff0.tar.gz |
utils: Add 'wrap-program'.
* guix/build/utils.scm (wrap-program): New procedure.
-rw-r--r-- | guix/build/utils.scm | 68 |
1 files changed, 67 insertions, 1 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm index ef215e60bb..356dd46b52 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> +;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,7 +52,8 @@ patch-shebang patch-makefile-SHELL fold-port-matches - remove-store-references)) + remove-store-references + wrap-program)) ;;; @@ -652,6 +654,70 @@ known as `nuke-refs' in Nixpkgs." (put-u8 out (char->integer char)) result)))))) +(define* (wrap-program prog #:rest vars) + "Rename PROG to .PROG-real and make PROG a wrapper. VARS should look like +this: + + '(VARIABLE DELIMITER POSITION LIST-OF-DIRECTORIES) + +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\" + \"/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\" + 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 "." prog "-real")) + (prog-tmp (string-append "." prog "-tmp"))) + (define (export-variable lst) + ;; Return a string that exports an environment variable. + (match lst + ((var sep '= rest) + (format #f "export ~a=\"~a\"" + var (string-join rest sep))) + ((var sep 'prefix rest) + (format #f "export ~a=\"~a${~a~a+~a}$~a\"" + var (string-join rest sep) var sep sep var)) + ((var sep 'suffix rest) + (format #f "export ~a=\"$~a${~a~a+~a}~a\"" + var var var sep sep (string-join rest sep))) + ((var '= rest) + (format #f "export ~a=\"~a\"" + var (string-join rest ":"))) + ((var 'prefix rest) + (format #f "export ~a=\"~a${~a:+:}$~a\"" + var (string-join rest ":") var var)) + ((var 'suffix rest) + (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 + "#!~a~%~a~%exec ~a~%" + (which "bash") + (string-join (map export-variable vars) + "\n") + (canonicalize-path prog-real)))) + + (chmod prog-tmp #o755) + (rename-file prog-tmp prog))) + ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'with-throw-handler 'scheme-indent-function 1) |