tribes/guix-tribes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Revert initrd PID 1 wrapper

Browse Source
This commit is contained in:
Steffen
2026-03-30 10:53:30 +02:00
parent 19a8e5b10a
commit 379dcc77d2
2 changed files with 16 additions and 168 deletions
Download Patch File Download Diff File Expand all files Collapse all files

181
nbde/system/initrd.scm
View File

@@ -2,22 +2,15 @@
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages curl)
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages jose)
#:use-module (gnu packages linux)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-initrd))
#:use-module (gnu system file-systems)
#:use-module (gnu system keyboard)
#:use-module (gnu system linux-initrd)
#:use-module (gnu system mapped-devices)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix records)
#:use-module (nbde packages crypto)
#:use-module (srfi srfi-1)
#:export (nbde-network-configuration
nbde-network-configuration?
nbde-network-configuration-interface
@@ -26,93 +19,6 @@
clevis-initrd-network-pre-mount
clevis-initrd))
(define flat-linux-module-directory*
(@@ (gnu system linux-initrd) flat-linux-module-directory))
;; This mirrors Guix's 'expression->initrd' boundary closely, but wraps the
;; real init with a tiny shell script so Guile does not run as PID 1. If
;; upstream grows a hook for that, this copy should go away.
(define* (expression->initrd-with-proc exp
#:key
(guile %guile-static-initrd)
(name "guile-initrd"))
(define real-init
(program-file "real-init" exp #:guile guile))
(define init-wrapper
(computed-file
"init"
#~(begin
(call-with-output-file #$output
(lambda (port)
(display "#!" port)
(display #$(file-append static-bash "/bin/sh") port)
(newline port)
(display #$(file-append util-linux "/bin/mount") port)
(display " -t proc proc /proc\n" port)
(display #$(file-append guile "/bin/guile") port)
(display " --no-auto-compile " port)
(display #$real-init port)
(display "\nstatus=$?\nexit \"$status\"\n" port)))
(chmod #$output #o555))))
(define (import-module? module)
(and (guix-module-name? module)
(not (equal? module '(guix store deduplication)))))
(define builder
(with-imported-modules
(source-module-closure '((gnu build linux-initrd))
#:select? import-module?)
#~(begin
(use-modules (gnu build linux-initrd)
(guix build store-copy)
(guix build utils)
(system base compile)
(system foreign)
(rnrs bytevectors))
(define (cache-compiled-file-name file)
(format #f ".cache/guile/ccache/~a-~a-~a-~a/~a"
(effective-version)
(if (eq? (native-endianness) (endianness little))
"LE"
"BE")
(sizeof '*)
(effective-version)
file))
(define (compile-to-cache file)
(let ((compiled-file (cache-compiled-file-name file)))
(mkdir-p (dirname compiled-file))
(compile-file file
#:opts %auto-compilation-options
#:output-file compiled-file)))
(mkdir #$output)
(mkdir "contents")
(populate-store '("closure") "contents"
#:deduplicate? #f)
(with-directory-excursion "contents"
(symlink #$init-wrapper "init")
(symlink #$real-init "real-init")
(compile-to-cache "real-init")
(mkdir-p "proc/self")
(symlink (string-append #$guile "/bin/guile") "proc/self/exe")
(readlink "proc/self/exe")
(write-cpio-archive (string-append #$output "/initrd.cpio.gz")
"."
#:gzip (string-append #+gzip "/bin/gzip"))))))
(file-append
(computed-file name builder
#:options
`(#:references-graphs (("closure" ,init-wrapper))))
"/initrd.cpio.gz"))
(define-record-type* <nbde-network-configuration>
nbde-network-configuration make-nbde-network-configuration
nbde-network-configuration?
@@ -197,76 +103,17 @@ for initrds that need Tang."
"Build an initrd with the helper packages needed for Clevis/Tang based root
unlock. NETWORK is an optional @code{<nbde-network-configuration>} record used
to request a minimal DHCP pre-mount hook."
(define device-mapping-commands
(map (lambda (md)
(let* ((source (mapped-device-source md))
(targets (mapped-device-targets md))
(type (mapped-device-type md))
(open (mapped-device-kind-open type)))
(apply open source targets
(mapped-device-arguments md))))
mapped-devices))
(define file-system-scan-commands
(let ((file-system-types (map file-system-type file-systems)))
(if (member "btrfs" file-system-types)
#~((system* (string-append #$btrfs-progs/static "/bin/btrfs")
"device" "scan"))
#~())))
(define kodir
(flat-linux-module-directory* linux linux-modules))
(define helper-packages*
(append (clevis-initrd-helper-packages)
helper-packages
(if keyboard-layout
(list loadkeys-static)
'())))
;; This duplicates the upstream 'raw-initrd' call shape so we can swap in
;; 'expression->initrd-with-proc' above and keep the initrd-specific helper
;; package tweaks local. Upstream factoring here would let this collapse
;; back to a thin wrapper.
(expression->initrd-with-proc
(with-imported-modules
(source-module-closure
'((gnu build linux-boot)
(guix build utils)
(guix build bournish)
(gnu system file-systems)
(gnu build file-systems)))
#~(begin
(use-modules (gnu build linux-boot)
(gnu system file-systems)
((guix build utils) #:hide (delete))
(guix build bournish)
(srfi srfi-1)
(srfi srfi-26)
#$@(append-map (compose mapped-device-kind-modules
mapped-device-type)
mapped-devices))
(with-output-to-port (%make-void-port "w")
(lambda ()
(set-path-environment-variable "PATH" '("bin" "sbin")
'#$helper-packages*)))
(parameterize ((current-warning-port (%make-void-port "w")))
(boot-system #:mounts
(map spec->file-system
'#$(map file-system->spec file-systems))
#:pre-mount (lambda ()
(and #$(and network
(clevis-initrd-network-pre-mount
network))
#$@device-mapping-commands
#$@file-system-scan-commands))
#:linux-modules '#$linux-modules
#:linux-module-directory '#$kodir
#:keymap-file #+(and=> keyboard-layout
keyboard-layout->console-keymap)
#:qemu-guest-networking? #$qemu-networking?
#:volatile-root? '#$volatile-root?
#:on-error '#$on-error))))
#:name "raw-initrd"))
(raw-initrd
file-systems
#:linux linux
#:linux-modules linux-modules
#:mapped-devices mapped-devices
#:keyboard-layout keyboard-layout
#:helper-packages
(append (clevis-initrd-helper-packages) helper-packages)
#:pre-mount
(and network
(clevis-initrd-network-pre-mount network))
#:qemu-networking? qemu-networking?
#:volatile-root? volatile-root?
#:on-error on-error))

3
nbde/system/kexec-initrd.scm
View File

@@ -33,10 +33,11 @@
(newline port)
(display #$(file-append util-linux "/bin/mount") port)
(display " -t proc proc /proc\n" port)
(display "exec " port)
(display #$(file-append guile "/bin/guile") port)
(display " --no-auto-compile " port)
(display #$real-init port)
(display "\nstatus=$?\nexit \"$status\"\n" port)))
(newline port)))
(chmod #$output #o555))))
(define (import-module? module)