From c40e8a2b71b200ec31da05bc76485c5157ce3d88 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Wed, 26 Feb 2020 22:36:04 -0600 Subject: guix: pack: Only wrap executable files. Hello Guix, This patch fixes some uses of relocatable git (e.g. octopus merge). Previously, guix pack would wrap all files in "bin", "sbin", and "libexec", even non-executable files. This would cause issues for git when its shell scripts in libexec would try to source other shell files that had been wrapped and were no longer a valid shell file. I feel like a test should be added to tests/guix-pack-relocatable.sh, but I'm not sure how to do that while keeping the test lightweight. Suggestions welcome. Cheers, `~Eric * guix/scripts/pack.scm (wrapped-package): Build wrappers for executable files and symlink others. --- guix/scripts/pack.scm | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index c8d8546e29..3634326102 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. ;;; @@ -673,9 +674,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. @@ -726,15 +729,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) -- cgit v1.2.3