From mboxrd@z Thu Jan 1 00:00:00 1970 From: Eric Bavier Subject: [PATCH] utils: Allow wrap-program to be called multiple times. Date: Tue, 09 Sep 2014 17:56:59 -0500 Message-ID: <871trk2yis.fsf@member.fsf.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:55907) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XRULA-0004zD-J9 for guix-devel@gnu.org; Tue, 09 Sep 2014 18:56:54 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XRUL3-00066B-Co for guix-devel@gnu.org; Tue, 09 Sep 2014 18:56:48 -0400 Received: from mail-ie0-x233.google.com ([2607:f8b0:4001:c03::233]:60527) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XRUL3-00065i-8U for guix-devel@gnu.org; Tue, 09 Sep 2014 18:56:41 -0400 Received: by mail-ie0-f179.google.com with SMTP id rl12so5034857iec.38 for ; Tue, 09 Sep 2014 15:56:40 -0700 (PDT) Received: from cooper.gmail.com (chippewa-nat.cray.com. [136.162.34.1]) by mx.google.com with ESMTPSA id e16sm404914igz.8.2014.09.09.15.56.38 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Tue, 09 Sep 2014 15:56:39 -0700 (PDT) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org --=-=-= 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-utils-Allow-wrap-program-to-be-called-multiple-times.patch >From 231130db4444685d8f3264e61d680634eaead9fb Mon Sep 17 00:00:00 2001 From: Eric Bavier 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 --=-=-= -- Eric Bavier --=-=-=--