summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Bavier <bavier@member.fsf.org>2020-02-24 23:47:02 -0600
committerGuix Patches Tester <>2020-03-27 02:55:10 +0000
commitc12e1522036d56d0aec2ffcb6e521005bd159d42 (patch)
tree4dd44f7b124196ccd131cdb02e777ca4297b4d54
parent0a76a4e0733741f3140fc394e98fed4febdbebca (diff)
downloadpatches-series-3304.tar
patches-series-3304.tar.gz
wip: guix: pack: Only wrap executable files.series-3304
* 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".
-rw-r--r--guix/scripts/pack.scm32
-rw-r--r--tests/guix-pack-relocatable.sh37
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"