Subject: bug#39807: closed (Re: [bug#39807] [PATCH] guix: pack: Only wrap executable files.)

From: [email-masked] (GNU bug Tracking System)
Date: Fri, 30 Oct 2020 15:14:01 +0000

Your bug report

#39807: [PATCH] guix: pack: Only wrap executable files.

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
39807: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=39807
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: [bug#39807] [PATCH] guix: pack: Only wrap executable files.
From: Eric Bavier <[email-masked]>
To: [email-masked]
Date: Fri, 30 Oct 2020 10:13:41 -0500
List-Id: <debbugs-submit.debbugs.gnu.org>

On Fri, 2020-10-23 at 12:48 +0200, Ludovic Courtès wrote:
> Hi Eric,
> 
> Eric Bavier <[email-masked]> skribis:
> 
> > From 7caaea0b21e5b97836b1a40a44efd2f38dbab7ae Mon Sep 17 00:00:00 2001
> > From: Eric Bavier <[email-masked]>
> > Date: Wed, 21 Oct 2020 18:33:52 -0500
> > Subject: [PATCH 1/2] guix: pack: Fix offset calculation for store directory
> >  mount point.
> > 
> > Fixes wrapping of non-package things, where the target store directory may
> > differ in length from the original.
> > 
> > * guix/scripts/pack.scm (wrapped-package)<build-wrapper>: Define
> > WRAPPER_PROGRAM macro with wrapper's file name.
> > * gnu/packages/aux-files/run-in-namespace.c (main): Offset index by len of
> > that file name.
> 
> LGTM!  Perhaps add a link to this discussion in the commit log.
> 
> > From 85bd962e929924b016a85d3a0b3dff434ebe8de3 Mon Sep 17 00:00:00 2001
> > From: Eric Bavier <[email-masked]>
> > Date: Mon, 24 Feb 2020 23:47:02 -0600
> > Subject: [PATCH 2/2] guix: pack: Only wrap executable files.
> > 
> > * guix/scripts/pack.scm (wrapped-package)<build>: Build wrappers for
> > executable files and symlink others.
> > * tests/guix-pack-relocatable.sh: Test relocatable example of mixed
> > executable and non-executable files.
> 
> LGTM too!
> 
> Thanks,
> Ludo’.

Pushed in a73896425e92e5162766afdf042748b18f2462af and
4184998c70f9c4af101feb28cc19c5550abffcec after some small changes to
the test to more faithfully mimic the failure case that was causing
wrapped git commands to fail.

`~Eric
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index 5ac8cdc718..0255075fb1 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -145,7 +145,7 @@ guix pack -RR python-numpy python-scipy --no-grafts -n
 # Check that packages that mix executable and support files (e.g. git) in the
 # "binary" directories still work after wrapped.
 cat >"$test_directory/manifest.scm" <<'EOF'
-(use-modules (guix) (guix profiles)
+(use-modules (guix) (guix profiles) (guix search-paths)
              (gnu packages bootstrap))
 (manifest
  (list (manifest-entry
@@ -154,12 +154,22 @@ cat >"$test_directory/manifest.scm" <<'EOF'
 			  `(("bin/hello"
 			     ,(program-file
                                "hello"
-                               #~(begin (display (load "../libexec/msg"))(newline))
+			       #~(begin
+				   (add-to-load-path (getenv "HELLO_EXEC_PATH"))
+				   (display (load-from-path "msg"))(newline))
                                #:guile %bootstrap-guile))
-			    ("libexec/msg"
-			     ,(plain-file "msg" "42"))))))))
+			    ("libexec/hello/msg"
+			     ,(plain-file "msg" "42")))))
+	(search-paths
+	 (list (search-path-specification
+		(variable "HELLO_EXEC_PATH")
+		(files '("libexec/hello"))
+		(separator #f)))))))
 EOF
 tarball="`guix pack -RR -S /opt= -m $test_directory/manifest.scm`"
 (cd "$test_directory"; tar xvf "$tarball")
-run_without_store "$test_directory/opt/bin/hello" > "$test_directory/output"
+( export GUIX_PROFILE=$test_directory/opt
+  . $GUIX_PROFILE/etc/profile
+  run_without_store "$test_directory/opt/bin/hello" > "$test_directory/output" )
+cat "$test_directory/output"
 test "`cat $test_directory/output`" = "42"

Subject: [PATCH] guix: pack: Only wrap executable files.
From: Eric Bavier <[email-masked]>
To: [email-masked]
Cc: Eric Bavier <[email-masked]>
Date: Wed, 26 Feb 2020 22:36:04 -0600
List-Id: <debbugs-submit.debbugs.gnu.org>

From: Eric Bavier <[email-masked]>

Hello Guix,

This patch fixes some uses of relocatable git (e.g.  octopus merge). 
Previously, guix pack would wrap all files in "bin", "sbin", and "libexec",
even non-executable files.  This would cause issues for git when its shell
scripts in libexec would try to source other shell files that had been
wrapped and were no longer a valid shell file.

I feel like a test should be added to tests/guix-pack-relocatable.sh, but
I'm not sure how to do that while keeping the test lightweight.  Suggestions
welcome.

Cheers,
`~Eric

* guix/scripts/pack.scm (wrapped-package)<build>: Build wrappers for
executable files and symlink others.
---
 guix/scripts/pack.scm | 32 +++++++++++++++++++++++---------
 1 file changed, 23 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index c8d8546e29..3634326102 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018 Konrad Hinsen <[email-masked]>
 ;;; Copyright © 2018 Chris Marusich <[email-masked]>
 ;;; Copyright © 2018 Efraim Flashner <[email-masked]>
+;;; Copyright © 2020 Eric Bavier <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -673,9 +674,11 @@ last resort for relocation."
                               (guix build union)))
       #~(begin
           (use-modules (guix build utils)
-                       ((guix build union) #:select (relative-file-name))
+                       ((guix build union) #:select (symlink-relative))
+                       (srfi srfi-1)
                        (ice-9 ftw)
-                       (ice-9 match))
+                       (ice-9 match)
+                       (ice-9 receive))
 
           (define input
             ;; The OUTPUT* output of PACKAGE.
@@ -726,15 +729,26 @@ last resort for relocation."
           (mkdir target)
           (for-each (lambda (file)
                       (unless (member file '("." ".." "bin" "sbin" "libexec"))
-                        (let ((file* (string-append input "/" file)))
-                          (symlink (relative-file-name target file*)
-                                   (string-append target "/" file)))))
+                        (symlink-relative (string-append input  "/" file)
+                                          (string-append target "/" file))))
                     (scandir input))
 
-          (for-each build-wrapper
-                    (append (find-files (string-append input "/bin"))
-                            (find-files (string-append input "/sbin"))
-                            (find-files (string-append input "/libexec")))))))
+          (receive (executables others)
+              (partition executable-file?
+                         (append (find-files (string-append input "/bin"))
+                                 (find-files (string-append input "/sbin"))
+                                 (find-files (string-append input "/libexec"))))
+            ;; Wrap only executables, since the wrapper will eventually need
+            ;; to execve them.  E.g. git's "libexec" directory contains many
+            ;; shell scripts that are source'd from elsewhere, which fails if
+            ;; they are wrapped.
+            (for-each build-wrapper executables)
+            ;; Link any other non-executable files
+            (for-each (lambda (old)
+                        (let ((new (string-append target (strip-store-prefix old))))
+                          (mkdir-p (dirname new))
+                          (symlink-relative old new)))
+                      others)))))
 
   (computed-file (string-append
                   (cond ((package? package)
-- 
2.25.1