diff options
| author | Eric Bavier <bavier@member.fsf.org> | 2020-02-24 23:47:02 -0600 |
|---|---|---|
| committer | Eric Bavier <bavier@member.fsf.org> | 2020-10-30 10:00:35 -0500 |
| commit | 4184998c70f9c4af101feb28cc19c5550abffcec (patch) | |
| tree | 9dd8c22e966c68b854f4762fc42c6837939e2770 /guix/scripts/pack.scm | |
| parent | a73896425e92e5162766afdf042748b18f2462af (diff) | |
| download | guix-patches-4184998c70f9c4af101feb28cc19c5550abffcec.tar guix-patches-4184998c70f9c4af101feb28cc19c5550abffcec.tar.gz | |
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 example of mixed
executable and non-executable files.
Diffstat (limited to 'guix/scripts/pack.scm')
| -rw-r--r-- | guix/scripts/pack.scm | 30 |
1 files changed, 21 insertions, 9 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index f02f3662a5..8e694edbbe 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -749,12 +749,13 @@ last resort for relocation." (guix elf))) #~(begin (use-modules (guix build utils) - ((guix build union) #:select (relative-file-name)) + ((guix build union) #:select (symlink-relative)) (guix elf) (guix build gremlin) (ice-9 binary-ports) (ice-9 ftw) (ice-9 match) + (ice-9 receive) (srfi srfi-1) (rnrs bytevectors)) @@ -874,16 +875,27 @@ 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 - ;; Note: Trailing slash in case these are symlinks. - (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? + ;; Note: Trailing slash in case these are symlinks. + (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) |