all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Eric Bavier <bavier@posteo.net>
To: 39807 <39807@debbugs.gnu.org>
Subject: [bug#39807] [PATCH] guix: pack: Only wrap executable files.
Date: Thu, 26 Mar 2020 21:53:18 -0500	[thread overview]
Message-ID: <9929712b169123d7f35169919dfaaa9c@posteo.net> (raw)
In-Reply-To: <87h7ydljyv.fsf@gnu.org>

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


  reply	other threads:[~2020-03-27  2:54 UTC|newest]

Thread overview: 16+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-02-27  4:36 [bug#39807] [PATCH] guix: pack: Only wrap executable files Eric Bavier
2020-03-06 11:16 ` Ludovic Courtès
2020-03-24 17:51   ` Ludovic Courtès
2020-03-27  2:53     ` Eric Bavier [this message]
2020-03-27  2:29   ` Eric Bavier
     [not found]   ` <8d8a2e1209d82e136d36222683967956@posteo.net>
2020-03-29 14:39     ` Ludovic Courtès
2020-07-27 21:42 ` Eric Bavier
2020-10-21  5:09   ` Eric Bavier
2020-10-21  9:07     ` Ludovic Courtès
2020-10-21 15:12       ` Eric Bavier
2020-10-21 15:35         ` Ludovic Courtès
2020-10-21 16:21           ` Eric Bavier
2020-10-21 21:31             ` Ludovic Courtès
2020-10-21 23:51               ` Eric Bavier
2020-10-23 10:48                 ` Ludovic Courtès
2020-10-30 15:13                   ` bug#39807: " Eric Bavier

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=9929712b169123d7f35169919dfaaa9c@posteo.net \
    --to=bavier@posteo.net \
    --cc=39807@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.