From 5b9c0a140837138740b2b4f07338901948f08515 Mon Sep 17 00:00:00 2001 From: Eric Bavier 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 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 ;;; Copyright © 2018 Chris Marusich ;;; Copyright © 2018 Efraim Flashner +;;; Copyright © 2020 Eric Bavier ;;; ;;; 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 +# Copyright © 2020 Eric Bavier # # 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