[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

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

[Jakob Kirsch via Guix-patches via]

Would it be possible to expose the output of kexec-loading-program as a file in the output directory of the operating system (e.g. as /run/current-system/kexec)?

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

[Jakob Kirsch via Guix-patches via]

On Mon, Dec 23, 2024 at 12:22:20PM +0100, Ludovic Courtès wrote:
> In addition to or instead of running it by default?

I would say in addition to but with a flag to not load it (like with "--no-bootloader" for the bootloader).

Btw I've also noticed that the framebuffer is only initialized after something graphical (gdm in my case) has been started. This usually isn't an issue for most users but my disks are encrypted so I can't see the password prompt but I can still type in my password.

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

[Ludovic Courtès]

Hi,

Jakob Kirsch <jakob.kirsch@web.de> skribis:

> On Mon, Dec 23, 2024 at 12:22:20PM +0100, Ludovic Courtès wrote:
>> In addition to or instead of running it by default?
>
> I would say in addition to but with a flag to not load it (like with "--no-bootloader" for the bootloader).

I sent v2, which includes some of your suggestions, but unfortunately
not the “kexec” system entry.

> Btw I've also noticed that the framebuffer is only initialized after something graphical (gdm in my case) has been started. This usually isn't an issue for most users but my disks are encrypted so I can't see the password prompt but I can still type in my password.

Weird; for me the Linux framebuffer is initialized early on.

Perhaps report a bug with details about your hardware and OS config?

Ludo’.

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

[Ludovic Courtès]

Hello,

Changes compared to v1:

  • Move kexec code outside of ‘upgrade-shepherd-services’.  Now both
    (guix scripts system) and (gnu machine ssh) have to explicitly
    call ‘load-system-for-kexec’.

  • Add ‘--no-kexec’ command-line option for ‘guix system reconfigure’,
    as Jakob suggested.

  • Document kexec support under “Invoking guix system”.

The one thing I didn’t do is add a “kexec” symlink in the system; as it
turns out that’s not easily doable because of the circular dependency:
code returned by ‘kexec-loading-program’ needs to refer to the operating
system in which it would appear.

If we find a way to work around this, maybe we can add this later.

Thoughts?

Ludo’.

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

 doc/guix.texi                       | 11 +++-
 gnu/machine/ssh.scm                 |  9 +++-
 gnu/system.scm                      |  4 +-
 gnu/tests/reconfigure.scm           | 78 +++++++++++++++++++++++++++++
 guix/build/syscalls.scm             | 54 ++++++++++++++++++++
 guix/scripts/system.scm             | 17 ++++++-
 guix/scripts/system/reconfigure.scm | 31 ++++++++++++
 tests/syscalls.scm                  | 13 +++++
 8 files changed, 213 insertions(+), 4 deletions(-)


base-commit: f96c14e3ca6b22e56621cc04a1bf06a8cac6ca23
-- 
2.46.0

[bug#75027] [PATCH v2 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 v2 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 v2 3/3] reconfigure: Support loading the system for kexec reboot.

[Ludovic Courtès]

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

* guix/scripts/system/reconfigure.scm (kexec-loading-program)
(load-system-for-kexec): New procedures.
* gnu/tests/reconfigure.scm (run-kexec-test): New procedure.
(%test-upgrade-kexec): New variable.
* guix/scripts/system.scm (perform-action): Add #:load-for-kexec?.
Call ‘load-system-for-kexec’.
(show-help, %options): Add ‘--no-kexec’.
(%default-options): Add ‘load-for-kexec?’.
(process-action): Honor it and pass it to ‘perform-action’.
* gnu/machine/ssh.scm (deploy-managed-host): Add call to
‘load-system-for-kexec’.
* doc/guix.texi (Invoking guix system): Document it.

Change-Id: I86d11f1c348e4359bc9e73c86e5aebff60fe875c
---
 doc/guix.texi                       | 11 +++-
 gnu/machine/ssh.scm                 |  9 +++-
 gnu/tests/reconfigure.scm           | 78 +++++++++++++++++++++++++++++
 guix/scripts/system.scm             | 17 ++++++-
 guix/scripts/system/reconfigure.scm | 31 ++++++++++++
 5 files changed, 143 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index da4d2f5ebc..7bf14a49e9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -43599,11 +43599,20 @@ Invoking guix system
 overwritten.  This behavior mirrors that of @command{guix package}
 (@pxref{Invoking guix package}).
 
-It also adds a bootloader menu entry for the new OS configuration,
+It adds a bootloader menu entry for the new OS configuration,
 ---unless @option{--no-bootloader} is passed.  For GRUB, it moves
 entries for older configurations to a submenu, allowing you to choose
 an older system generation at boot time should you need it.
 
+@cindex kexec, for fast reboots
+@cindex rebooting @i{via} Linux kexec
+On Linux, @command{guix system reconfigure} also loads the new system
+for fast reboot @i{via} kexec: running @command{reboot --kexec} will
+boot the new system by directly executing its kernel, thus bypassing the
+BIOS initialization phase and bootloader (@pxref{Invoking reboot,,,
+shepherd, The GNU Shepherd Manual}).  You can avoid this behavior by
+passing the @option{--no-kexec} option.
+
 @cindex provenance tracking, of the operating system
 Upon completion, the new system is deployed under
 @file{/run/current-system}.  This directory contains @dfn{provenance
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 3e10d984e7..f58fcdaf4a 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
-;;; Copyright © 2020-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2024 Ricardo <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -552,6 +552,13 @@ (define (deploy-managed-host machine)
                                                       (inferior-exception-arguments
                                                        c)))
                                            os)
+                (load-system-for-kexec (eval/error-handling c
+                                         (warning (G_ "\
+failed to load system of '~a' for kexec reboot:~%~{~s ~}~%")
+                                                  host
+                                                  (inferior-exception-arguments
+                                                   c)))
+                                       os)
                 (install-bootloader (eval/error-handling c
                                       (raise (formatted-message
                                               (G_ "\
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..a24a953e6e 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,73 @@ (define* (run-upgrade-services-test)
           (disable (upgrade-services-program '() '() '(dummy) '())))
      (test enable disable))))
 
+(define (run-kexec-test)
+  "Run a test aiming to reboot via Linux kexec into a new system."
+  (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 +340,12 @@ (define %test-upgrade-services
 loading new services.")
    (value (run-upgrade-services-test))))
 
+(define %test-upgrade-kexec
+  (system-test
+   (name "upgrade-kexec")
+   (description "Load a system and reboot into it via Linux kexec.")
+   (value (run-kexec-test))))
+
 (define %test-install-bootloader
   (system-test
    (name "install-bootloader")
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index dd34f6cd15..f174c8ada1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -798,6 +798,7 @@ (define* (perform-action action image
                          save-provenance?
                          skip-safety-checks?
                          install-bootloader?
+                         load-for-kexec?
                          dry-run? derivations-only?
                          use-substitutes? target
                          full-boot?
@@ -900,7 +901,13 @@ (define* (perform-action action image
 To complete the upgrade, run 'herd restart SERVICE' to stop,
 upgrade, and restart each service that was not automatically restarted.\n")))
                 (return (format #t (G_ "\
-Run 'herd status' to view the list of services on your system.\n"))))))
+Run 'herd status' to view the list of services on your system.\n"))))
+               (mwhen load-for-kexec?
+                 (mlet %store-monad ((kexec? (load-system-for-kexec local-eval
+                                                                    os)))
+                   (mwhen kexec?
+                     (return (info (G_ "system loaded for fast reboot \
+ with 'reboot --kexec'~%"))))))))
             ((init)
              (newline)
              (format #t (G_ "initializing operating system under '~a'...~%")
@@ -1025,6 +1032,8 @@ (define (show-help)
       --image-size=SIZE  for 'image', produce an image of SIZE"))
   (display (G_ "
       --no-bootloader    for 'init', do not install a bootloader"))
+  (display (G_ "
+      --no-kexec         for 'reconfigure', do not load system for kexec reboot"))
   (display (G_ "
       --volatile         for 'image', make the root file system volatile"))
   (display (G_ "
@@ -1127,6 +1136,9 @@ (define %options
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
+         (option '("no-kexec") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'load-for-kexec? #f result)))
          (option '("volatile") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'volatile-image-root? #t result)))
@@ -1198,6 +1210,7 @@ (define %default-options
     (image-type . mbr-hybrid-raw)
     (image-size . guess)
     (install-bootloader? . #t)
+    (load-for-kexec? . #t)
     (label . #f)
     (volatile-image-root? . #f)
     (volatile-vm-root? . #t)
@@ -1275,6 +1288,7 @@ (define (process-action action args opts)
                            (leave (G_ "no configuration specified~%")))))))
          (dry?        (assoc-ref opts 'dry-run?))
          (bootloader? (assoc-ref opts 'install-bootloader?))
+         (kexec?      (assoc-ref opts 'load-for-kexec?))
          (label       (assoc-ref opts 'label))
          (image-type  (lookup-image-type-by-name
                        (assoc-ref opts 'image-type)))
@@ -1360,6 +1374,7 @@ (define (process-action action args opts)
                                                         (_ #f))
                                                       opts)
                                #:install-bootloader? bootloader?
+                               #:load-for-kexec? kexec?
                                #:target target-file
                                #:gc-root (assoc-ref opts 'gc-root)))))
           #:target target
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index ddb561d28c..e9e16e3422 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)
@@ -52,6 +53,9 @@ (define-module (guix scripts system reconfigure)
             upgrade-services-program
             upgrade-shepherd-services
 
+            kexec-loading-program
+            load-system-for-kexec
+
             install-bootloader-program
             install-bootloader
 
@@ -176,6 +180,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
@@ -205,6 +230,12 @@ (define* (upgrade-shepherd-services eval os)
                                                             to-unload
                                                             to-restart)))))))
 
+(define (load-system-for-kexec eval os)
+  "Load OS so that it can be rebooted into via kexec, if supported.  Return
+true on success."
+  (eval #~(and (string-contains %host-type "-linux")
+               (primitive-load #$(kexec-loading-program os)))))
+
 \f
 ;;;
 ;;; Bootloader configuration.
-- 
2.46.0