unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* [PATCH] utils: Allow wrap-program to be called multiple times.
@ 2014-09-09 22:56 Eric Bavier
  2014-09-10 13:40 ` Ludovic Courtès
  2014-09-11 13:10 ` Ludovic Courtès
  0 siblings, 2 replies; 10+ messages in thread
From: Eric Bavier @ 2014-09-09 22:56 UTC (permalink / raw)
  To: guix-devel

[-- 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

^ permalink raw reply related	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2014-09-14 15:59 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2014-09-09 22:56 [PATCH] utils: Allow wrap-program to be called multiple times Eric Bavier
2014-09-10 13:40 ` 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

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).