From: Eric Bavier <ericbavier@gmail.com>
To: guix-devel@gnu.org
Subject: [PATCH] utils: Allow wrap-program to be called multiple times.
Date: Tue, 09 Sep 2014 17:56:59 -0500 [thread overview]
Message-ID: <871trk2yis.fsf@member.fsf.org> (raw)
[-- Attachment #1: Type: text/plain, Size: 773 bytes --]
Currently, if (@ (guix build utils) wrap-program) is called multiple
times for the same file, the original file ends up being overwritten.
This happened to me when trying to wrap a python program, which had
already once been wrapped by python-build-system. The
python-build-system wrapper sets PYTHON_PATH, and I needed to wrap the
program again in order to set PATH.
Comments are very welcome on this patch to core-updates, as I hacked it
together rather quickly.
A description of what ends up happening, e.g.:
1) Initially::
$ ls
foo
2) Then after first call to wrap-program::
$ ls
foo -> ./.foo-wrap-01
.foo-real
.foo-wrap-01
3) And then after another call to wrap-program::
$ ls
foo -> ./.foo-wrap-02
.foo-real
.foo-wrap-01
.foo-wrap-02
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-utils-Allow-wrap-program-to-be-called-multiple-times.patch --]
[-- Type: text/x-diff, Size: 2785 bytes --]
From 231130db4444685d8f3264e61d680634eaead9fb Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Tue, 9 Sep 2014 17:47:31 -0500
Subject: [PATCH] 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.
---
guix/build/utils.scm | 26 +++++++++++++++++++++-----
1 file changed, 21 insertions(+), 5 deletions(-)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 2f3dc9c..d4435b4 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -711,8 +711,24 @@ contents:
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")))
+ (define (wrapper-path num)
+ (format #f "~a/.~a-wrap-~2'0d" (dirname prog) (basename prog) num))
+ (let* ((current-wrappers
+ (find-files (dirname prog)
+ (string-append "\\." (basename prog) "-wrap-.*")))
+ (wrapper-num (if (null? current-wrappers)
+ 0
+ (string->number
+ (string-take-right (last current-wrappers) 2))))
+ (wrapper-tgt (if (zero? wrapper-num)
+ (let ((prog-real (string-append
+ (dirname prog) "/."
+ (basename prog) "-real")))
+ (copy-file prog prog-real)
+ prog-real)
+ (wrapper-path wrapper-num)))
+ (wrapper (wrapper-path (1+ wrapper-num)))
+ (prog-tmp (string-append wrapper-tgt "-tmp")))
(define (export-variable lst)
;; Return a string that exports an environment variable.
(match lst
@@ -735,8 +751,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 +758,11 @@ modules in $GUILE_LOAD_PATH, etc."
(which "bash")
(string-join (map export-variable vars)
"\n")
- (canonicalize-path prog-real))))
+ (canonicalize-path wrapper-tgt))))
(chmod prog-tmp #o755)
+ (rename-file prog-tmp wrapper)
+ (symlink wrapper prog-tmp)
(rename-file prog-tmp prog)))
;;; Local Variables:
--
1.7.9.5
[-- Attachment #3: Type: text/plain, Size: 17 bytes --]
--
Eric Bavier
next reply other threads:[~2014-09-09 22:56 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-09-09 22:56 Eric Bavier [this message]
2014-09-10 13:40 ` [PATCH] utils: Allow wrap-program to be called multiple times Ludovic Courtès
2014-09-10 19:16 ` Eric Bavier
2014-09-11 13:10 ` Ludovic Courtès
2014-09-13 6:12 ` Eric Bavier
2014-09-13 12:20 ` Ludovic Courtès
2014-09-14 4:05 ` mhw
2014-09-14 14:27 ` Ludovic Courtès
2014-09-14 15:16 ` Eric Bavier
2014-09-14 15:58 ` Mark H Weaver
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=871trk2yis.fsf@member.fsf.org \
--to=ericbavier@gmail.com \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.