summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2020-05-07 22:49:20 +0200
committerLudovic Courtès <ludo@gnu.org>2020-05-14 17:21:27 +0200
commit6456232164890dbf5aa20394ee24637feb4b7b9e (patch)
tree8fbdad7a851dd1762756c7178864d6919a62c00f /guix
parent4449e7c5e4c8b746c786fc9a5ea82eab60f6c846 (diff)
pack: Add relocation via ld.so and fakechroot.
* gnu/packages/aux-files/run-in-namespace.c (HAVE_EXEC_WITH_LOADER): New macro. (bind_mount): Rename to... (mirror_directory): ... this. Add 'firmlink' argument and use it instead of calling mkdir/open/close/mount directly. (bind_mount, make_symlink): New functions. (exec_in_user_namespace): Adjust accordingly. (exec_with_loader) [HAVE_EXEC_WITH_LOADER]: New function. (exec_performance): New function. (engines): Add them. * guix/scripts/pack.scm (wrapped-package)[fakechroot-library] [audit-module]: New procedures. [audit-source]: New variable. [build](elf-interpreter, elf-loader-compile-flags): New procedures. (build-wrapper): Use them. * tests/guix-pack-relocatable.sh: Test with 'GUIX_EXECUTION_ENGINE=fakechroot'. * doc/guix.texi (Invoking guix pack): Document the 'performance' and 'fakechroot' engines. * gnu/packages/aux-files/pack-audit.c: New file. * Makefile.am (AUX_FILES): Add it.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/pack.scm87
1 files changed, 81 insertions, 6 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 11d0653d9a..518bf6e7e3 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -684,18 +684,50 @@ last resort for relocation."
(define runner
(local-file (search-auxiliary-file "run-in-namespace.c")))
+ (define audit-source
+ (local-file (search-auxiliary-file "pack-audit.c")))
+
(define (proot)
(specification->package "proot-static"))
+ (define (fakechroot-library)
+ (computed-file "libfakechroot.so"
+ #~(copy-file #$(file-append
+ (specification->package "fakechroot")
+ "/lib/fakechroot/libfakechroot.so")
+ #$output)))
+
+ (define (audit-module)
+ ;; Return an ld.so audit module for use by the 'fakechroot' execution
+ ;; engine that translates file names of all the files ld.so loads.
+ (computed-file "pack-audit.so"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (copy-file #$audit-source "audit.c")
+ (substitute* "audit.c"
+ (("@STORE_DIRECTORY@")
+ (%store-directory)))
+
+ (invoke #$compiler "-std=gnu99"
+ "-shared" "-fPIC" "-Os" "-g0"
+ "-Wall" "audit.c" "-o" #$output)))))
+
(define build
(with-imported-modules (source-module-closure
'((guix build utils)
- (guix build union)))
+ (guix build union)
+ (guix elf)))
#~(begin
(use-modules (guix build utils)
((guix build union) #:select (relative-file-name))
+ (guix elf)
+ (ice-9 binary-ports)
(ice-9 ftw)
- (ice-9 match))
+ (ice-9 match)
+ (srfi srfi-1)
+ (rnrs bytevectors))
(define input
;; The OUTPUT* output of PACKAGE.
@@ -714,6 +746,48 @@ last resort for relocation."
(#f base)
(index (string-drop base index)))))
+ (define (elf-interpreter elf)
+ ;; Return the interpreter of ELF as a string, or #f if ELF has no
+ ;; interpreter segment.
+ (match (find (lambda (segment)
+ (= (elf-segment-type segment) PT_INTERP))
+ (elf-segments elf))
+ (#f #f) ;maybe a .so
+ (segment
+ (let ((bv (make-bytevector (- (elf-segment-memsz segment) 1))))
+ (bytevector-copy! (elf-bytes elf)
+ (elf-segment-offset segment)
+ bv 0 (bytevector-length bv))
+ (utf8->string bv)))))
+
+ (define (elf-loader-compile-flags program)
+ ;; Return the cpp flags defining macros for the ld.so/fakechroot
+ ;; wrapper of PROGRAM.
+
+ ;; TODO: Handle scripts by wrapping their interpreter.
+ (if (elf-file? program)
+ (let* ((bv (call-with-input-file program
+ get-bytevector-all))
+ (elf (parse-elf bv))
+ (interp (elf-interpreter elf))
+ (gconv (and interp
+ (string-append (dirname interp)
+ "/gconv"))))
+ (if interp
+ (list (string-append "-DPROGRAM_INTERPRETER=\""
+ interp "\"")
+ (string-append "-DFAKECHROOT_LIBRARY=\""
+ #$(fakechroot-library) "\"")
+
+ (string-append "-DLOADER_AUDIT_MODULE=\""
+ #$(audit-module) "\"")
+ (if gconv
+ (string-append "-DGCONV_DIRECTORY=\""
+ gconv "\"")
+ "-UGCONV_DIRECTORY"))
+ '()))
+ '()))
+
(define (build-wrapper program)
;; Build a user-namespace wrapper for PROGRAM.
(format #t "building wrapper for '~a'...~%" program)
@@ -733,10 +807,11 @@ last resort for relocation."
(mkdir-p (dirname result))
(apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall"
"run.c" "-o" result
- (if proot
- (list (string-append "-DPROOT_PROGRAM=\""
- proot "\""))
- '()))
+ (append (if proot
+ (list (string-append "-DPROOT_PROGRAM=\""
+ proot "\""))
+ '())
+ (elf-loader-compile-flags program)))
(delete-file "run.c")))
(setvbuf (current-output-port) 'line)