[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