Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Sun, 22 Dec 2024 15:57:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #14 received at 75027 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 75027 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 3/3] reconfigure: Call ‘kexec-load-file’. Date: Sun, 22 Dec 2024 16:57:43 +0100
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 <at> sdf.org>
+;;; Copyright © 2024 Ludovic Courtès <ludo <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.