amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: pack: Only wrap executable files.

Browse source 
* 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.
This commit is contained in:
Eric Bavier 2020-02-24 23:47:02 -06:00
parent a73896425e
commit 4184998c70
No known key found for this signature in database
GPG key ID: FD73CAC719D32566
2 changed files with 56 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

30
guix/scripts/pack.scm
View file

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