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