pack: ‘-R’ (once) does not include fakechroot fallback.

Previously, ‘guix pack -R’ would build a wrapper containing both the
“userns” and “fakechroot” engines, instead of providing nothing but the
“userns” engine as the manual says.  This patch fixes it.

* guix/scripts/pack.scm (wrapped-package): Add #:fakechroot?
[build]: When FAKECHROOT? is false, ‘elf-loader-compile-flags’ always
returns '().

Change-Id: Ic75cc8c36bf0a3881f299b274d78bd9fc2d4e2bb
This commit is contained in:
Ludovic Courtès 2024-04-12 11:48:26 +02:00 committed by Ludovic Courtès
parent 5f89f45e74
commit a15db2ee50
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2017-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net> ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
@ -1066,10 +1066,11 @@ (define* (wrapped-package package
#:optional #:optional
(output* "out") (output* "out")
(compiler (c-compiler)) (compiler (c-compiler))
#:key proot?) #:key proot? (fakechroot? proot?))
"Return the OUTPUT of PACKAGE with its binaries wrapped such that they are "Return the OUTPUT of PACKAGE with its binaries wrapped such that they are
relocatable. When PROOT? is true, include PRoot in the result and use it as a relocatable. When PROOT? is true, include PRoot in the result and use it as a
last resort for relocation." last resort for relocation. When FAKECHROOT? is true, include
libfakechroot.so and related ld.so machinery as a fallback."
(define runner (define runner
(local-file (search-auxiliary-file "run-in-namespace.c"))) (local-file (search-auxiliary-file "run-in-namespace.c")))
@ -1161,43 +1162,44 @@ (define (runpath file)
(define (elf-loader-compile-flags program) (define (elf-loader-compile-flags program)
;; Return the cpp flags defining macros for the ld.so/fakechroot ;; Return the cpp flags defining macros for the ld.so/fakechroot
;; wrapper of PROGRAM. ;; wrapper of PROGRAM.
#$(if fakechroot?
;; 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) "\"")
;; TODO: Handle scripts by wrapping their interpreter. (string-append "-DLOADER_AUDIT_MODULE=\""
(if (elf-file? program) #$(audit-module) "\"")
(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=\"" ;; XXX: Normally (runpath #$(audit-module)) is
#$(audit-module) "\"") ;; enough. However, to work around
;; <https://sourceware.org/bugzilla/show_bug.cgi?id=26634>
;; XXX: Normally (runpath #$(audit-module)) is ;; (glibc <= 2.32), pass the whole search path of
;; enough. However, to work around ;; PROGRAM, which presumably is a superset of that
;; <https://sourceware.org/bugzilla/show_bug.cgi?id=26634> ;; of the audit module.
;; (glibc <= 2.32), pass the whole search path of (string-append "-DLOADER_AUDIT_RUNPATH={ "
;; PROGRAM, which presumably is a superset of that (string-join
;; of the audit module. (map object->string
(string-append "-DLOADER_AUDIT_RUNPATH={ " (runpath program))
(string-join ", " 'suffix)
(map object->string "NULL }")
(runpath program)) (if gconv
", " 'suffix) (string-append "-DGCONV_DIRECTORY=\""
"NULL }") gconv "\"")
(if gconv "-UGCONV_DIRECTORY"))
(string-append "-DGCONV_DIRECTORY=\"" '()))
gconv "\"") '())
"-UGCONV_DIRECTORY")) #~'()))
'()))
'()))
(define (build-wrapper program) (define (build-wrapper program)
;; Build a user-namespace wrapper for PROGRAM. ;; Build a user-namespace wrapper for PROGRAM.