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

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

[Eric Bavier]

From: Eric Bavier <bavier@member.fsf.org>

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 <konrad.hinsen@fastmail.net>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Eric Bavier <bavier@posteo.net>
 ;;;
 ;;; 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

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

[Ludovic Courtès]

Hi,

Eric Bavier <bavier@posteo.net> skribis:

> From: Eric Bavier <bavier@member.fsf.org>
>
> 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.

Good catch!

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

Not sure how to do that.  Since ‘guix pack’ accepts manifests, you could
have a manifest containing a ‘computed-file’ with a file that shouldn’t
be wrapped, and then you could ensure that’s indeed the case.  Or you
could try with ‘git-minimal’ or some other package that exhibits the
problem?

> * guix/scripts/pack.scm (wrapped-package)<build>: Build wrappers for
> executable files and symlink others.

[...]

> -          (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)

I’d prefer srfi-11 ‘let-values’.  :-)

Otherwise LGTM, thanks!

Ludo’.

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

[Ludovic Courtès]

Ping!  :-)

Ludovic Courtès <ludo@gnu.org> skribis:

> Hi,
>
> Eric Bavier <bavier@posteo.net> skribis:
>
>> From: Eric Bavier <bavier@member.fsf.org>
>>
>> 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.
>
> Good catch!
>
>> 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.
>
> Not sure how to do that.  Since ‘guix pack’ accepts manifests, you could
> have a manifest containing a ‘computed-file’ with a file that shouldn’t
> be wrapped, and then you could ensure that’s indeed the case.  Or you
> could try with ‘git-minimal’ or some other package that exhibits the
> problem?
>
>> * guix/scripts/pack.scm (wrapped-package)<build>: Build wrappers for
>> executable files and symlink others.
>
> [...]
>
>> -          (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)
>
> I’d prefer srfi-11 ‘let-values’.  :-)
>
> Otherwise LGTM, thanks!
>
> Ludo’.

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

[Eric Bavier]

[-- Attachment #1: Type: text/plain, Size: 33 bytes --]

Latest patch attached.
-- 
`~Eric

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-wip-guix-pack-Only-wrap-executable-files.patch --]
[-- Type: text/x-diff; name=0001-wip-guix-pack-Only-wrap-executable-files.patch, Size: 5512 bytes --]

From 5b9c0a140837138740b2b4f07338901948f08515 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Mon, 24 Feb 2020 23:47:02 -0600
Subject: [PATCH] wip: 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 git-minimal's
"merge-octopus".
---
 guix/scripts/pack.scm          | 32 ++++++++++++++++++++---------
 tests/guix-pack-relocatable.sh | 37 ++++++++++++++++++++++++++++++++++
 2 files changed, 60 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index b6fb73838d..55ed0958ad 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Eric Bavier <bavier@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -690,9 +691,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.
@@ -743,15 +746,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)
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index e93610eedc..a3d9013133 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2020 Eric Bavier <bavier@posteo.net>
 #
 # This file is part of GNU Guix.
 #
@@ -84,3 +85,39 @@ chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
 tarball="`guix pack -R -S /share=share groff:doc`"
 (cd "$test_directory"; tar xvf "$tarball")
 test -d "$test_directory/share/doc/groff/html"
+chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
+
+# Check that packages that mix executable and support files (e.g. git) in the
+# "binary" directories still work after wrapped.
+tarball="`guix pack $relocatable_option -S /opt= git-minimal`"
+(cd "$test_directory"; tar xvf "$tarball"
+ mkdir foo; cd foo; touch .gitignore bar.txt bif.txt)
+do_test='
+  export GUIX_PROFILE="$test_directory/opt"
+  . $GUIX_PROFILE/etc/profile
+  cd "$test_directory/foo"
+  git config --global user.email "gnu@example.com"
+  git config --global user.name "Gnu Hacker"
+  git --version >"$test_directory/output"
+  git init; git add .gitignore; git commit -m "Initial"
+  git branch a; git branch b
+  git checkout a
+  git add bar.txt; git commit -m "Add bar"
+  git checkout b
+  git add bif.txt; git commit -m "Add bif"
+  git checkout master
+  # Check merge-octopus script which sources libexec/git-core/git-sh-setup
+  git merge a b -m "merge" >>"$test_directory/output"
+'
+if unshare -r true		# Are user namespaces supported?
+then
+    unshare -mrf \
+	    sh -c 'mount -t tmpfs none "$HOME"; # Forbid git to read user configs
+                   mount -t tmpfs none "$STORE_PARENT"; \
+                  '"$do_test"
+    cd -
+else
+    ( $do_test )
+fi
+grep 'git version' "$test_directory/output"
+grep 'octopus' "$test_directory/output"
-- 
2.25.2

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

[Eric Bavier]

On 06.03.2020 05:16, Ludovic Courtès wrote:
> Hi,
> 
> Eric Bavier <bavier@posteo.net> skribis:
> 
>> From: Eric Bavier <bavier@member.fsf.org>
>> 
>> 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.
> 
> Not sure how to do that.  Since ‘guix pack’ accepts manifests, you 
> could
> have a manifest containing a ‘computed-file’ with a file that shouldn’t
> be wrapped, and then you could ensure that’s indeed the case.  Or you
> could try with ‘git-minimal’ or some other package that exhibits the
> problem?

I almost have a working test using 'git-minimal', but I'm not happy with 
the quantity of code needed to setup, and I'm worried now that that test 
would be relying on an implementation detail that could change in the 
future without us noticing (e.g. a git subcommand that's currently a 
shell script is subsumed into git so the test no longer checks what we 
want).

So I think I'll try going the manifest/computed-file route instead.

> 
>> * guix/scripts/pack.scm (wrapped-package)<build>: Build wrappers for
>> executable files and symlink others.
> 
> [...]
> 
>> -          (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)
> 
> I’d prefer srfi-11 ‘let-values’.  :-)

I tried let-values to begin with, but I found 'receive' to be much 
easier on the eyes.  For the case of binding values from a single 
expression, does let-values offer benefits?  And there are no other uses 
of let-values in this module, so precedent/consistency doesn't seem to 
have weight.

> Otherwise LGTM, thanks!

Thanks for review (and ping)!

-- 
`~Eric

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

[Ludovic Courtès]

Hi Eric,

Eric Bavier <bavier@posteo.net> skribis:

> On 06.03.2020 05:16, Ludovic Courtès wrote:

[...]

>>> 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.
>>
>> Not sure how to do that.  Since ‘guix pack’ accepts manifests, you
>> could
>> have a manifest containing a ‘computed-file’ with a file that shouldn’t
>> be wrapped, and then you could ensure that’s indeed the case.  Or you
>> could try with ‘git-minimal’ or some other package that exhibits the
>> problem?
>
> I almost have a working test using 'git-minimal', but I'm not happy
> with the quantity of code needed to setup, and I'm worried now that
> that test would be relying on an implementation detail that could
> change in the future without us noticing (e.g. a git subcommand that's
> currently a shell script is subsumed into git so the test no longer
> checks what we want).
>
> So I think I'll try going the manifest/computed-file route instead.

OK.

>>> -          (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)
>>
>> I’d prefer srfi-11 ‘let-values’.  :-)
>
> I tried let-values to begin with, but I found 'receive' to be much
> easier on the eyes.  For the case of binding values from a single
> expression, does let-values offer benefits?  And there are no other
> uses of let-values in this module, so precedent/consistency doesn't
> seem to have weight.

OK, no big deal.

There are probably more uses of ‘let-values’ than ‘receive’ overall.
That said, I think we can start switching to srfi-71, which is nicer
than both of these.

Thanks,
Ludo’.

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

[Eric Bavier]

[-- Attachment #1: Type: text/plain, Size: 374 bytes --]

Patch rebased on latest master attached.  The new test implements a
small proxy for the behavior exhibited by git and its libexec scripts.

Call for help: the test does not pass!  I get this error:

  hello: run.c:284: exec_in_user_namespace: Unexpected error: No such
file or directory.

Could someone more familiar with user namespaces, etc help me work
this out?

`~Eric

[-- Attachment #2: 0001-guix-pack-Only-wrap-executable-files.patch --]
[-- Type: text/x-patch, Size: 5924 bytes --]

From b31e63c3668e5163eba40f7815ccae19cb2af236 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Mon, 24 Feb 2020 23:47:02 -0600
Subject: [PATCH] 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.
---
 guix/scripts/pack.scm          | 31 ++++++++++++++++++++++---------
 tests/guix-pack-relocatable.sh | 31 +++++++++++++++++++++++++++++++
 2 files changed, 53 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 5fb6aaae0c..1b9609753d 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Eric Bavier <bavier@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -747,11 +748,12 @@ last resort for relocation."
                               (guix elf)))
       #~(begin
           (use-modules (guix build utils)
-                       ((guix build union) #:select (relative-file-name))
+                       ((guix build union) #:select (symlink-relative))
                        (guix elf)
                        (ice-9 binary-ports)
                        (ice-9 ftw)
                        (ice-9 match)
+                       (ice-9 receive)
                        (srfi srfi-1)
                        (rnrs bytevectors))
 
@@ -847,16 +849,27 @@ 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
-                    ;; Note: Trailing slash in case these are symlinks.
-                    (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?
+			 ;; Note: Trailing slash in case these are symlinks.
+                         (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)
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index 52d7212594..2ed497027d 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2020 Eric Bavier <bavier@posteo.net>
 #
 # This file is part of GNU Guix.
 #
@@ -99,6 +100,7 @@ case "`uname -m`" in
 	GUIX_EXECUTION_ENGINE="fakechroot"
 	"$test_directory/Bin/sed" --version > "$test_directory/output"
 	grep 'GNU sed' "$test_directory/output"
+	unset GUIX_EXECUTION_ENGINE
 
 	chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
 	;;
@@ -111,8 +113,37 @@ esac
 tarball="`guix pack -R -S /share=share groff:doc`"
 (cd "$test_directory"; tar xvf "$tarball")
 test -d "$test_directory/share/doc/groff/html"
+chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
 
 # Ensure '-R' applies to propagated inputs.  Failing to do that, it would fail
 # with a profile collision error in this case because 'python-scipy'
 # propagates 'python-numpy'.  See <https://bugs.gnu.org/42510>.
 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)
+             (gnu packages bootstrap))
+(manifest
+ (list (manifest-entry
+	(name "test") (version "0")
+	(item (file-union "test"
+			  `(("bin/hello"
+			     ,(program-file
+                               "hello"
+                               #~(format #t "~d~%" (load "../libexec/msg"))
+                               #:guile %bootstrap-guile))
+			    ("libexec/msg"
+			     ,(plain-file "msg" "42"))))))))
+EOF
+tarball="`guix pack $relocatable_option -S /opt= -m $test_directory/manifest.scm`"
+(cd "$test_directory"; tar xvf "$tarball")
+do_test='"$test_directory/opt/bin/hello" >"$test_directory/output"'
+if unshare -r true		# Are user namespaces supported?
+then
+    unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"; '"$do_test"
+else
+    ( $do_test )
+fi
+test "`cat $test_directory/output`" = "42"
-- 
2.27.0

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

[Eric Bavier]

On Mon, 2020-07-27 at 16:42 -0500, Eric Bavier wrote:
> Call for help: the test does not pass!  I get this error:
> 
>   hello: run.c:284: exec_in_user_namespace: Unexpected error: No such
> file or directory.
> 
> Could someone more familiar with user namespaces, etc help me work
> this out?

After following a helpful suggestion to try using `strace`, turns out the issue is not with user namespaces but mostly
with string manipulation :)  Apologies in advance for wall-of-text.

  $ unshare -mrf strace -s 80 -o trace -ff \
  >  sh -c 'mount -t tmpfs -o ro none "/gnu/store"; 
            /tmp/pack-dir/opt/bin/hello'

and in one the log file corresponding to the exec of the wrapper `hello` I see

  readlink("/proc/self/exe",
           "/tmp/pack-dir/gnu/store/80kbbxnzn3kgs1jkc6m6ydw2m44lnfaq-wrapperR/bin/hello", 4095) = 75
  lstat("/gnu/store/zc92ghli8ws31qshf4bhzw1npzqhs4my-test/bin//hello", 
        0x7ffe308a4980) = -1 ENOENT (No such file or directory)

and in the log corresponding to the child after forking in exec_in_user_namespace we see the call that leads to the
above error:

  mount("/tmp/pack-dir/gnu/store/80", "/tmp/guix-exec-YMr7WJ//gnu/store", 0x4810a7, MS_RDONLY|MS_BIND|MS_REC, NULL) = -1
ENOENT (No such file or directory)
  write(2, "hello: run.c:284: exec_in_user_namespace: Unexpected error: No such file or dire"..., 87) = 87

So exec_in_user_namespace is trying to mount "/tmp/pack-dir/gnu/store/80", which is not a directory.

In gnu/packages/aux-files/run-in-namespace.c:620-626 we try to calculate the name of the relocated store directory.  So
far this calculation seems to "accidentaly" work:

/tmp/pack-dir/gnu/store/78xrsg1z...-emacs-no-x-27.1R/bin/emacs
             /gnu/store/w9csar3m...-emacs-no-x-27.1/bin//emacs

The "R" suffix appended to the wrapper store directory name and the double-slash we get from find-files (c.f.
guix/scripts/pack.scm:881) "cancel out".   But we might not be so fortunate and can get something like this:

                          |
/tmp/pack-dir/gnu/store/80|kbbxnz...-wrapperR/bin/hello (self)
                /gnu/store|/zc92ghli...-test/bin//hello (@PROG@)
                /gnu/store|                     (original_store)
                          |

Because the manifest entry used in the tests added in this patch enters the "else" case of `wrapped-package` (c.f.
guix/scripts/pack.scm:904) the index calculation strays and we get a non-directory mount point.  I can make the test
pass by using a slightly longer name of "testing" for the file-union :)

I don't think we can enforce a stricter match between the wrapper and target store item names to ensure their lengths
are the same, right?  It seems like we maybe want to ignore @WRAPPED_PROGRAM@ and use only /proc/self/exe and
original_store to find the relocated store directory?  A regex search might be too costly.  We could use strstr to
search for the first occurrence of original_store, if we don't mind assuming that most people will probably not unpack
into $HOME/.guix/gnu/store/mine/packs/foo e.g.

--- a/gnu/packages/aux-files/run-in-namespace.c
+++ b/gnu/packages/aux-files/run-in-namespace.c
@@ -619,10 +619,8 @@ main (int argc, char *argv[])
 
   /* SELF is something like "/home/ludo/.local/gnu/store/…-foo/bin/ls" and we
      want to extract "/home/ludo/.local/gnu/store".  */
-  size_t index = strlen (self)
-    - strlen ("@WRAPPED_PROGRAM@") + strlen (original_store);
   char *store = strdup (self);
-  store[index] = '\0';
+  strstr (store, original_store)[sizeof original_store - 1] = '\0';
 
   struct stat statbuf;
 

WDYT?


`~Eric

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

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1930 bytes --]

Hi Eric,

Eric Bavier <bavier@posteo.net> skribis:

> In gnu/packages/aux-files/run-in-namespace.c:620-626 we try to calculate the name of the relocated store directory.  So
> far this calculation seems to "accidentaly" work:
>
> /tmp/pack-dir/gnu/store/78xrsg1z...-emacs-no-x-27.1R/bin/emacs
>              /gnu/store/w9csar3m...-emacs-no-x-27.1/bin//emacs
>
> The "R" suffix appended to the wrapper store directory name and the double-slash we get from find-files (c.f.
> guix/scripts/pack.scm:881) "cancel out".   But we might not be so fortunate and can get something like this:
>
>                           |
> /tmp/pack-dir/gnu/store/80|kbbxnz...-wrapperR/bin/hello (self)
>                 /gnu/store|/zc92ghli...-test/bin//hello (@PROG@)
>                 /gnu/store|                     (original_store)
>                           |
>
> Because the manifest entry used in the tests added in this patch enters the "else" case of `wrapped-package` (c.f.
> guix/scripts/pack.scm:904) the index calculation strays and we get a non-directory mount point.  I can make the test
> pass by using a slightly longer name of "testing" for the file-union :)
>
> I don't think we can enforce a stricter match between the wrapper and target store item names to ensure their lengths
> are the same, right?  It seems like we maybe want to ignore @WRAPPED_PROGRAM@ and use only /proc/self/exe and
> original_store to find the relocated store directory?  A regex search might be too costly.  We could use strstr to
> search for the first occurrence of original_store, if we don't mind assuming that most people will probably not unpack
> into $HOME/.guix/gnu/store/mine/packs/foo e.g.

Good catch!  This is embarrassing.

Instead of searching for an occurrence of ORIGINAL_STORE, can’t we use
the file name of the wrapper (as opposed to WRAPPED_PROGRAM) in the
index calculation?  Along these lines:


[-- Attachment #2: Type: text/x-patch, Size: 1280 bytes --]

diff --git a/gnu/packages/aux-files/run-in-namespace.c b/gnu/packages/aux-files/run-in-namespace.c
index 52a16a5362..947ff02dda 100644
--- a/gnu/packages/aux-files/run-in-namespace.c
+++ b/gnu/packages/aux-files/run-in-namespace.c
@@ -620,7 +620,7 @@ main (int argc, char *argv[])
   /* SELF is something like "/home/ludo/.local/gnu/store/…-foo/bin/ls" and we
      want to extract "/home/ludo/.local/gnu/store".  */
   size_t index = strlen (self)
-    - strlen ("@WRAPPED_PROGRAM@") + strlen (original_store);
+    - strlen (WRAPPER_PROGRAM) + strlen (original_store);
   char *store = strdup (self);
   store[index] = '\0';
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index a5a70d5162..c353f50ced 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -856,6 +856,7 @@ last resort for relocation."
               (mkdir-p (dirname result))
               (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
                      "run.c" "-o" result
+                     (string-append "-DWRAPPER_PROGRAM=\"" result "\"")
                      (append (if proot
                                  (list (string-append "-DPROOT_PROGRAM=\""
                                                       proot "\""))

[-- Attachment #3: Type: text/plain, Size: 21 bytes --]


Thanks,
Ludo’.

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

[Eric Bavier]

Hi Ludo,

On Wed, 2020-10-21 at 11:07 +0200, Ludovic Courtès wrote:
> Hi Eric,
> 
> Instead of searching for an occurrence of ORIGINAL_STORE, can’t we use
> the file name of the wrapper (as opposed to WRAPPED_PROGRAM) in the
> index calculation?  Along these lines:

Good idea, I hadn't considered that we know the destination of the
wrapper in advance.  

This works as long as we make sure "result" is in canonical form, e.g.
no repeated separators, because /proc/self/exe is in canonical form:

diff --git a/gnu/packages/aux-files/run-in-namespace.c b/gnu/packages/aux-files/run-in-namespace.c
index 52a16a5362..947ff02dda 100644
--- a/gnu/packages/aux-files/run-in-namespace.c
+++ b/gnu/packages/aux-files/run-in-namespace.c
@@ -620,7 +620,7 @@ main (int argc, char *argv[])
   /* SELF is something like "/home/ludo/.local/gnu/store/…-foo/bin/ls" and we
      want to extract "/home/ludo/.local/gnu/store".  */
   size_t index = strlen (self)
-    - strlen ("@WRAPPED_PROGRAM@") + strlen (original_store);
+    - strlen (WRAPPER_PROGRAM) + strlen (original_store);
   char *store = strdup (self);
   store[index] = '\0';
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index ac578aa965..8106031d6d 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -776,6 +776,10 @@ last resort for relocation."
                 (#f    base)
                 (index (string-drop base index)))))
 
+          (define (find-input-files dir)
+            ;; Note: Use 'stat' so that symlinks are followed.
+            (find-files (string-append input "/" dir) #:stat stat))
+
           (define (elf-interpreter elf)
             ;; Return the interpreter of ELF as a string, or #f if ELF has no
             ;; interpreter segment.
@@ -849,7 +853,7 @@ last resort for relocation."
               (("@STORE_DIRECTORY@") (%store-directory)))
 
             (let* ((base   (strip-store-prefix program))
-                   (result (string-append target "/" base))
+                   (result (string-append target base))
                    (proot  #$(and proot?
                                   #~(string-drop
                                      #$(file-append (proot) "/bin/proot")
@@ -858,6 +862,7 @@ last resort for relocation."
               (mkdir-p (dirname result))
               (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
                      "run.c" "-o" result
+                     (string-append "-DWRAPPER_PROGRAM=\"" result "\"")
                      (append (if proot
                                  (list (string-append "-DPROOT_PROGRAM=\""
                                                       proot "\""))
@@ -878,10 +883,9 @@ last resort for relocation."
 
           (receive (executables others)
               (partition executable-file?
-                        ;; Note: Trailing slash in case these are symlinks.
-                         (append (find-files (string-append input "/bin/"))
-                                 (find-files (string-append input "/sbin/"))
-                                 (find-files (string-append input "/libexec/"))))
+                         (append (find-input-files "bin")
+                                 (find-input-files "sbin")
+                                 (find-input-files "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

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

[Ludovic Courtès]

Hi Eric,

Eric Bavier <bavier@posteo.net> skribis:

> On Wed, 2020-10-21 at 11:07 +0200, Ludovic Courtès wrote:
>> Hi Eric,
>> 
>> Instead of searching for an occurrence of ORIGINAL_STORE, can’t we use
>> the file name of the wrapper (as opposed to WRAPPED_PROGRAM) in the
>> index calculation?  Along these lines:
>
> Good idea, I hadn't considered that we know the destination of the
> wrapper in advance.  
>
> This works as long as we make sure "result" is in canonical form, e.g.
> no repeated separators, because /proc/self/exe is in canonical form:

Good point.

>                (mkdir-p (dirname result))
>                (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
>                       "run.c" "-o" result
> +                     (string-append "-DWRAPPER_PROGRAM=\"" result "\"")

Can we just write (canonical-path result) here?  That way we wouldn’t
need ‘find-input-files’ and related changes.

Thanks,
Ludo’.

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

[Eric Bavier]

On Wed, 2020-10-21 at 17:35 +0200, Ludovic Courtès wrote:
> Hi Eric,
> 
> Eric Bavier <bavier@posteo.net> skribis:
> 
> >                (mkdir-p (dirname result))
> >                (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
> >                       "run.c" "-o" result
> > +                     (string-append "-DWRAPPER_PROGRAM=\"" result "\"")
> 
> Can we just write (canonical-path result) here?  That way we wouldn’t
> need ‘find-input-files’ and related changes.
> 

Guile's canonicalize-path will raise and error if the path does not
already exist.  We could create a dummy file at result, then call
canonicalize-path? but that seems clumsier than forming a canonical
name in the first place?

`~Eric

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

[Ludovic Courtès]

Hi,

Eric Bavier <bavier@posteo.net> skribis:

> On Wed, 2020-10-21 at 17:35 +0200, Ludovic Courtès wrote:
>> Hi Eric,
>> 
>> Eric Bavier <bavier@posteo.net> skribis:
>> 
>> >                (mkdir-p (dirname result))
>> >                (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
>> >                       "run.c" "-o" result
>> > +                     (string-append "-DWRAPPER_PROGRAM=\"" result "\"")
>> 
>> Can we just write (canonical-path result) here?  That way we wouldn’t
>> need ‘find-input-files’ and related changes.
>> 
>
> Guile's canonicalize-path will raise and error if the path does not
> already exist.  We could create a dummy file at result, then call
> canonicalize-path? but that seems clumsier than forming a canonical
> name in the first place?

Oh you’re right, sorry.

The patch you sent has ‘find-files’ use ‘stat’ instead of the trailing
slash.  It introduces a difference: by using ‘stat’ all the way, it
follows all symlinks, not just the higher-level ones.  I don’t know if
this could have undesired implications, like wrapping the same file
twice because there’s a symlink pointing to it.  (Or am I too paranoid?)

To be on the safe side, we could write:

  (string-append (canonical-path (dirname) result) "/" result)

WDYT?

Thanks,
Ludo’.

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

[Eric Bavier]

[-- Attachment #1: Type: text/plain, Size: 1615 bytes --]

On Wed, 2020-10-21 at 23:31 +0200, Ludovic Courtès wrote:
> Hi,
> 
> Eric Bavier <bavier@posteo.net> skribis:
> 
> > On Wed, 2020-10-21 at 17:35 +0200, Ludovic Courtès wrote:
> > > Hi Eric,
> > > 
> > > Eric Bavier <bavier@posteo.net> skribis:
> > > 
> > > >                (mkdir-p (dirname result))
> > > >                (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
> > > >                       "run.c" "-o" result
> > > > +                     (string-append "-DWRAPPER_PROGRAM=\"" result "\"")
> > > 
> > > Can we just write (canonical-path result) here?  That way we wouldn’t
> > > need ‘find-input-files’ and related changes.
> > > 
> > 
> > Guile's canonicalize-path will raise and error if the path does not
> > already exist.  We could create a dummy file at result, then call
> > canonicalize-path? but that seems clumsier than forming a canonical
> > name in the first place?
> 
> The patch you sent has ‘find-files’ use ‘stat’ instead of the trailing
> slash.  It introduces a difference: by using ‘stat’ all the way, it
> follows all symlinks, not just the higher-level ones.  I don’t know if
> this could have undesired implications, like wrapping the same file
> twice because there’s a symlink pointing to it.  (Or am I too paranoid?)
> 
> To be on the safe side, we could write:
> 
>   (string-append (canonical-path (dirname) result) "/" result)
> 
> WDYT?

I don't like the "stat" change either.  Paranoia is not misplaced, I
think.

Following are current two patches.  I can add copyright to run-in-
namespace.c if you think it's needed.

`~Eric

[-- Attachment #2: 0001-guix-pack-Fix-offset-calculation-for-store-directory.patch --]
[-- Type: text/x-patch, Size: 2864 bytes --]

From 7caaea0b21e5b97836b1a40a44efd2f38dbab7ae Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
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.
---
 gnu/packages/aux-files/run-in-namespace.c | 2 +-
 guix/scripts/pack.scm                     | 6 +++++-
 2 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/gnu/packages/aux-files/run-in-namespace.c b/gnu/packages/aux-files/run-in-namespace.c
index 52a16a5362..947ff02dda 100644
--- a/gnu/packages/aux-files/run-in-namespace.c
+++ b/gnu/packages/aux-files/run-in-namespace.c
@@ -620,7 +620,7 @@ main (int argc, char *argv[])
   /* SELF is something like "/home/ludo/.local/gnu/store/…-foo/bin/ls" and we
      want to extract "/home/ludo/.local/gnu/store".  */
   size_t index = strlen (self)
-    - strlen ("@WRAPPED_PROGRAM@") + strlen (original_store);
+    - strlen (WRAPPER_PROGRAM) + strlen (original_store);
   char *store = strdup (self);
   store[index] = '\0';
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index a5a70d5162..f02f3662a5 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Eric Bavier <bavier@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -847,7 +848,7 @@ last resort for relocation."
               (("@STORE_DIRECTORY@") (%store-directory)))
 
             (let* ((base   (strip-store-prefix program))
-                   (result (string-append target "/" base))
+                   (result (string-append target base))
                    (proot  #$(and proot?
                                   #~(string-drop
                                      #$(file-append (proot) "/bin/proot")
@@ -856,6 +857,9 @@ last resort for relocation."
               (mkdir-p (dirname result))
               (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
                      "run.c" "-o" result
+                     (string-append "-DWRAPPER_PROGRAM=\""
+                                    (canonicalize-path (dirname result)) "/"
+                                    (basename result) "\"")
                      (append (if proot
                                  (list (string-append "-DPROOT_PROGRAM=\""
                                                       proot "\""))
-- 
2.28.0


[-- Attachment #3: 0002-guix-pack-Only-wrap-executable-files.patch --]
[-- Type: text/x-patch, Size: 5519 bytes --]

From 85bd962e929924b016a85d3a0b3dff434ebe8de3 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
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.
---
 guix/scripts/pack.scm          | 30 +++++++++++++++++++++---------
 tests/guix-pack-relocatable.sh | 25 +++++++++++++++++++++++++
 2 files changed, 46 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index f02f3662a5..8e694edbbe 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -749,12 +749,13 @@ last resort for relocation."
                               (guix elf)))
       #~(begin
           (use-modules (guix build utils)
-                       ((guix build union) #:select (relative-file-name))
+                       ((guix build union) #:select (symlink-relative))
                        (guix elf)
                        (guix build gremlin)
                        (ice-9 binary-ports)
                        (ice-9 ftw)
                        (ice-9 match)
+                       (ice-9 receive)
                        (srfi srfi-1)
                        (rnrs bytevectors))
 
@@ -874,16 +875,27 @@ 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
-                    ;; Note: Trailing slash in case these are symlinks.
-                    (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?
+			 ;; Note: Trailing slash in case these are symlinks.
+                         (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)
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index a960ecd209..5ac8cdc718 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2020 Eric Bavier <bavier@posteo.net>
 #
 # This file is part of GNU Guix.
 #
@@ -98,6 +99,7 @@ case "`uname -m`" in
 	run_without_store GUIX_EXECUTION_ENGINE="fakechroot" \
 	"$test_directory/Bin/sed" --version > "$test_directory/output"
 	grep 'GNU sed' "$test_directory/output"
+	unset GUIX_EXECUTION_ENGINE
 
 	chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
 
@@ -133,8 +135,31 @@ esac
 tarball="`guix pack -R -S /share=share groff:doc`"
 (cd "$test_directory"; tar xf "$tarball")
 test -d "$test_directory/share/doc/groff/html"
+chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
 
 # Ensure '-R' applies to propagated inputs.  Failing to do that, it would fail
 # with a profile collision error in this case because 'python-scipy'
 # propagates 'python-numpy'.  See <https://bugs.gnu.org/42510>.
 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)
+             (gnu packages bootstrap))
+(manifest
+ (list (manifest-entry
+	(name "test") (version "0")
+	(item (file-union "test"
+			  `(("bin/hello"
+			     ,(program-file
+                               "hello"
+                               #~(begin (display (load "../libexec/msg"))(newline))
+                               #:guile %bootstrap-guile))
+			    ("libexec/msg"
+			     ,(plain-file "msg" "42"))))))))
+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"
+test "`cat $test_directory/output`" = "42"
-- 
2.28.0

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

[Ludovic Courtès]

Hi Eric,

Eric Bavier <bavier@posteo.net> skribis:

> From 7caaea0b21e5b97836b1a40a44efd2f38dbab7ae Mon Sep 17 00:00:00 2001
> From: Eric Bavier <bavier@member.fsf.org>
> 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 <bavier@member.fsf.org>
> 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’.

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

[Eric Bavier]

[-- Attachment #1: Type: text/plain, Size: 1531 bytes --]

On Fri, 2020-10-23 at 12:48 +0200, Ludovic Courtès wrote:
> Hi Eric,
> 
> Eric Bavier <bavier@posteo.net> skribis:
> 
> > From 7caaea0b21e5b97836b1a40a44efd2f38dbab7ae Mon Sep 17 00:00:00 2001
> > From: Eric Bavier <bavier@member.fsf.org>
> > 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 <bavier@member.fsf.org>
> > 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

[-- Attachment #2: pack-test-better.patch --]
[-- Type: text/x-patch, Size: 1719 bytes --]

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"