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

[Eric Bavier <bavier@posteo.net>]

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