Revert initrd PID 1 wrapper

nbde/system/initrd.scm

@@ -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
+  (raw-initrd
-    (map (lambda (md)
+   file-systems
-           (let* ((source  (mapped-device-source md))
+   #:linux linux
-                  (targets (mapped-device-targets md))
+   #:linux-modules linux-modules
-                  (type    (mapped-device-type md))
+   #:mapped-devices mapped-devices
-                  (open    (mapped-device-kind-open type)))
+   #:keyboard-layout keyboard-layout
-             (apply open source targets
+   #:helper-packages
-                    (mapped-device-arguments md))))
+   (append (clevis-initrd-helper-packages) helper-packages)
-         mapped-devices))
+   #:pre-mount
-
+   (and network
-  (define file-system-scan-commands
+        (clevis-initrd-network-pre-mount network))
-    (let ((file-system-types (map file-system-type file-systems)))
+   #:qemu-networking? qemu-networking?
-      (if (member "btrfs" file-system-types)
+   #:volatile-root? volatile-root?
-          #~((system* (string-append #$btrfs-progs/static "/bin/btrfs")
+   #:on-error on-error))
-                      "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"))

nbde/system/kexec-initrd.scm

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