[bug#75027] [PATCH 0/3] 'guix system reconfigure' loads system for kexec reboot

[bug#75027] [PATCH 0/3] 'guix system reconfigure' loads system for kexec reboot

[Ludovic Courtès]

Hello Guix,

Following work by Jakob Kirsch adding kexec support in the Shepherd
(the new ‘reboot -k’ option), here’s the Guix side of it: with these
patches, ‘guix system reconfigure’ loads the new system so that one
can run ‘reboot -k’ to quickly reboot into it.

Thoughts?

Ludo’.

PS: It took me a while to debug until I realized it was working
    very well: it’s just that I was booting a kernel with “quiet”
    on its command line, so I couldn’t see anything. 🤦

Ludovic Courtès (3):
  syscalls: Add ‘kexec-load-file’.
  system: Export ‘…-initrd-file’ and ‘…-root-file-system’.
  reconfigure: Call ‘kexec-load-file’.

 gnu/system.scm                      |  4 +-
 gnu/tests/reconfigure.scm           | 77 +++++++++++++++++++++++++++++
 guix/build/syscalls.scm             | 54 ++++++++++++++++++++
 guix/scripts/system/reconfigure.scm | 25 ++++++++++
 tests/syscalls.scm                  | 13 +++++
 5 files changed, 172 insertions(+), 1 deletion(-)


base-commit: 9f53e10235cced7a85697481c859829742b9912c
-- 
2.46.0

[bug#75027] [PATCH 1/3] syscalls: Add ‘kexec-load-file’.

[Ludovic Courtès]

* guix/build/syscalls.scm (string->utf-8/nul-terminated)
(kexec-load-file): New procedures.
* tests/syscalls.scm ("kexec-load-file"): New test.

Change-Id: I3724226a14ecc07f346e77519fb5b0591096c7f6
---
 guix/build/syscalls.scm | 54 +++++++++++++++++++++++++++++++++++++++++
 tests/syscalls.scm      | 13 ++++++++++
 2 files changed, 67 insertions(+)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 2c20edf058..f8c9937f54 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -146,6 +146,12 @@ (define-module (guix build syscalls)
             clone
             setns
 
+            kexec-load-file
+            KEXEC_FILE_UNLOAD
+            KEXEC_FILE_ON_CRASH
+            KEXEC_FILE_NO_INITRAMFS
+            KEXEC_FILE_DEBUG
+
             PF_PACKET
             AF_PACKET
             all-network-interface-names
@@ -765,6 +771,54 @@ (define-as-needed load-linux-module
                  (list (strerror err))
                  (list err)))))))
 
+(define (string->utf-8/nul-terminated str)
+  "Serialize STR to UTF-8; return the resulting bytevector, including
+terminating nul character."
+  (let* ((source (string->utf8 str))
+         (bv     (make-bytevector (+ (bytevector-length source) 1) 0)))
+    (bytevector-copy! source 0 bv 0 (bytevector-length source))
+    bv))
+
+;; Constants from <linux/kexec.h>.
+(define KEXEC_FILE_UNLOAD	#x00000001)
+(define KEXEC_FILE_ON_CRASH	#x00000002)
+(define KEXEC_FILE_NO_INITRAMFS	#x00000004)
+(define KEXEC_FILE_DEBUG	#x00000008)
+
+(define kexec-load-file
+  (let* ((proc (syscall->procedure int "syscall"
+                                   (list long             ;sysno
+                                         int              ;kernel fd
+                                         int              ;initrd fd
+                                         unsigned-long    ;cmdline length
+                                         '*               ;cmdline
+                                         unsigned-long))) ;flags
+         ;; TODO: Don't do this.
+         (syscall-id (match (utsname:machine (uname))
+                       ("i686"    320)
+                       ("x86_64"  320)
+                       ("armv7l"  401)
+                       ("aarch64" 401)
+                       ;; XXX: There's apparently no support for ppc64le and
+                       ;; riscv64.
+                       (_ #f))))
+    (lambda* (kernel-fd initrd-fd command-line #:optional (flags 0))
+      "Load for eventual use of kexec(8) the Linux kernel from
+@var{kernel-fd}, its initial RAM disk from @var{initrd-fd}, with the given
+@var{command-line} (a string).  Optionally, @var{flags} can be a bitwise or of
+the KEXEC_FILE_* constants."
+      (let*-values (((command-line)
+                     (string->utf-8/nul-terminated command-line))
+                    ((ret err)
+                     (proc syscall-id kernel-fd initrd-fd
+                           (bytevector-length command-line)
+                           (bytevector->pointer command-line)
+                           flags)))
+        (when (= ret -1)
+          (throw 'system-error "kexec-load-file" "~A"
+                 (list (strerror err))
+                 (list err)))))))
+
 (define (linux-process-flags pid)                 ;copied from the Shepherd
   "Return the process flags of @var{pid} (or'd @code{PF_} constants), assuming
 the Linux /proc file system is mounted; raise a @code{system-error} exception
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 13f4f11721..eef864d097 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -679,6 +679,19 @@ (define perform-container-tests?
         (lambda args
           (system-error-errno args))))))
 
+(when (or (zero? (getuid))
+          (not (string-contains %host-type "linux")))
+  (test-skip 1))
+(test-equal "kexec-load-file"
+  EPERM
+  (catch 'system-error
+    (lambda ()
+      (let ((fd1 (open-fdes "/dev/null" O_RDONLY))
+            (fd2 (open-fdes "/dev/null" O_RDONLY)))
+        (kexec-load-file fd1 fd2 "gnu.repl=yes")))
+    (lambda args
+      (system-error-errno args))))
+
 (test-end)
 
 (false-if-exception (delete-file temp-file))
-- 
2.46.0

[bug#75027] [PATCH 2/3] system: Export ‘…-initrd-file’ and ‘…-root-file-system’.

[Ludovic Courtès]

* gnu/system.scm (operating-system-initrd-file): Fix docstring and
export.
(operating-system-root-file-system): Export.

Change-Id: I5254d82ce547e8014027ed20675b8bfe5a5847c5
---
 gnu/system.scm | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index dfcb8fb279..252a26cac3 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -110,6 +110,7 @@ (define-module (gnu system)
             operating-system-default-label
             operating-system-initrd-modules
             operating-system-initrd
+            operating-system-initrd-file
             operating-system-users
             operating-system-groups
             operating-system-issue
@@ -119,6 +120,7 @@ (define-module (gnu system)
             operating-system-locale-libcs
             operating-system-mapped-devices
             operating-system-file-systems
+            operating-system-root-file-system
             operating-system-store-file-system
             operating-system-user-mapped-devices
             operating-system-boot-mapped-devices
@@ -1355,7 +1357,7 @@ (define (operating-system-root-file-system os)
                (location (operating-system-location os)))))))
 
 (define (operating-system-initrd-file os)
-  "Return a gexp denoting the initrd file of OS."
+  "Return a file-like object for the initrd file of OS."
   (define boot-file-systems
     (filter file-system-needed-for-boot?
             (operating-system-file-systems os)))
-- 
2.46.0

[bug#75027] [PATCH 3/3] reconfigure: Call ‘kexec-load-file’.

[Ludovic Courtès]

This allows rebooting straight into the new system with ‘reboot -k’.

* guix/scripts/system/reconfigure.scm (kexec-loading-program): New
procedure.
(upgrade-shepherd-services): Use it.
* gnu/tests/reconfigure.scm (run-kexec-test): New procedure.
(%test-upgrade-kexec): New variable.

Change-Id: I86d11f1c348e4359bc9e73c86e5aebff60fe875c
---
 gnu/tests/reconfigure.scm           | 77 +++++++++++++++++++++++++++++
 guix/scripts/system/reconfigure.scm | 25 ++++++++++
 2 files changed, 102 insertions(+)

diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..8d33bdac9b 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,9 +19,12 @@
 
 (define-module (gnu tests reconfigure)
   #:use-module (gnu bootloader)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system)
   #:use-module (gnu system accounts)
+  #:use-module (gnu system file-systems)
   #:use-module (gnu system shadow)
   #:use-module (gnu system vm)
   #:use-module (gnu tests)
@@ -31,6 +35,7 @@ (define-module (gnu tests reconfigure)
   #:use-module (guix store)
   #:export (%test-switch-to-system
             %test-upgrade-services
+            %test-upgrade-kexec
             %test-install-bootloader))
 
 ;;; Commentary:
@@ -178,6 +183,72 @@ (define* (run-upgrade-services-test)
           (disable (upgrade-services-program '() '() '(dummy) '())))
      (test enable disable))))
 
+(define* (run-kexec-test)
+  (define os
+    (marionette-operating-system
+     (operating-system
+       (inherit %simple-os)
+       (services (modify-services %base-services
+                   (syslog-service-type
+                    config => (syslog-configuration
+                               (inherit config)
+                               (config-file
+                                (plain-file
+                                 "syslog.conf"
+                                 "*.* /dev/console\n")))))))
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define new-os
+    (marionette-operating-system
+     (virtualized-operating-system               ;run as with "guix system vm"
+      (operating-system
+        (inherit %simple-os)
+        (host-name "the-new-os")
+        (kernel-arguments '("console=ttyS0")))    ;be verbose
+      #:volatile? #t)                             ;mount root read-only
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm (virtual-machine os))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "kexec")
+
+          (test-equal "host name"
+            #$(operating-system-host-name os)
+            (marionette-eval '(gethostname) marionette))
+
+          (test-assert "kexec-loading-program"
+            (marionette-eval
+             '(primitive-load #$(kexec-loading-program new-os))
+             marionette))
+
+          (test-assert "reboot/kexec"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (with-shepherd-action 'root ('kexec) result
+                  (pk 'reboot-kexec result)))
+             marionette))
+
+          (test-equal "host name of new OS"
+            #$(operating-system-host-name new-os)
+            (marionette-eval '(gethostname) marionette))
+
+          (test-end))))
+
+  (gexp->derivation "kexec-test" test))
+
 (define* (run-install-bootloader-test)
   "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
 bootloader's configuration file."
@@ -268,6 +339,12 @@ (define %test-upgrade-services
 loading new services.")
    (value (run-upgrade-services-test))))
 
+(define %test-upgrade-kexec
+  (system-test
+   (name "upgrade-kexec")
+   (description "FIXME")
+   (value (run-kexec-test))))
+
 (define %test-install-bootloader
   (system-test
    (name "install-bootloader")
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index ddb561d28c..9e08179613 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -31,6 +31,7 @@ (define-module (guix scripts system reconfigure)
   #:use-module (gnu services herd)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system)
+  #:autoload   (gnu system file-systems) (file-system-device)
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix monads)
@@ -51,6 +52,7 @@ (define-module (guix scripts system reconfigure)
 
             upgrade-services-program
             upgrade-shepherd-services
+            kexec-loading-program
 
             install-bootloader-program
             install-bootloader
@@ -176,6 +178,27 @@ (define (upgrade-services-program service-files to-start to-unload to-restart)
         (for-each unload-service '#$to-unload)
         (for-each start-service '#$to-start)))))
 
+(define (kexec-loading-program os)
+  "Return a program that calls 'kexec_file_load' to allow rebooting into OS
+via 'kexec'."
+  (let ((root-device (file-system-device
+                      (operating-system-root-file-system os))))
+    (program-file
+     "kexec-load-system.scm"
+     (with-imported-modules '((guix build syscalls))
+       #~(begin
+           (use-modules (guix build syscalls))
+
+           (let ((kernel (open-fdes #$(operating-system-kernel-file os)
+                                    O_RDONLY))
+                 (initrd (open-fdes #$(operating-system-initrd-file os)
+                                    O_RDONLY)))
+             (kexec-load-file kernel initrd
+                              (string-join
+                               (list #$@(operating-system-kernel-arguments
+                                         os root-device)))
+                              KEXEC_FILE_DEBUG)))))))
+
 (define* (upgrade-shepherd-services eval os)
   "Using EVAL, a monadic procedure taking a single G-Expression as an argument,
 upgrade the Shepherd (PID 1) by unloading obsolete services and loading new
@@ -200,6 +223,8 @@ (define* (upgrade-shepherd-services eval os)
                                         running))
            (service-files (map shepherd-service-file target-services)))
       (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+                (when (string-contains %host-type "-linux")
+                  (primitive-load #$(kexec-loading-program os)))
                 (primitive-load #$(upgrade-services-program service-files
                                                             to-start
                                                             to-unload
-- 
2.46.0