unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 75027@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>,
	"Christopher Baines" <guix@cbaines.net>,
	"Josselin Poiret" <dev@jpoiret.xyz>,
	"Ludovic Courtès" <ludo@gnu.org>,
	"Mathieu Othacehe" <othacehe@gnu.org>,
	"Simon Tournier" <zimon.toutoune@gmail.com>,
	"Tobias Geerinckx-Rice" <me@tobias.gr>
Subject: [bug#75027] [PATCH 3/3] reconfigure: Call ‘kexec-load-file’.
Date: Sun, 22 Dec 2024 16:57:43 +0100	[thread overview]
Message-ID: <137b2d758c517c45aaa71e9555076df6ab7dd477.1734882676.git.ludo@gnu.org> (raw)
In-Reply-To: <cover.1734882676.git.ludo@gnu.org>

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





  parent reply	other threads:[~2024-12-22 15:59 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2024-12-22 15:56 [bug#75027] [PATCH 0/3] 'guix system reconfigure' loads system for kexec reboot Ludovic Courtès
2024-12-22 15:57 ` [bug#75027] [PATCH 1/3] syscalls: Add ‘kexec-load-file’ Ludovic Courtès
2024-12-22 15:57 ` [bug#75027] [PATCH 2/3] system: Export ‘…-initrd-file’ and ‘…-root-file-system’ Ludovic Courtès
2024-12-22 15:57 ` Ludovic Courtès [this message]
2024-12-22 21:47 ` [bug#75027] [PATCH 0/3] 'guix system reconfigure' loads system for kexec reboot Jakob Kirsch via Guix-patches via

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=137b2d758c517c45aaa71e9555076df6ab7dd477.1734882676.git.ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=75027@debbugs.gnu.org \
    --cc=dev@jpoiret.xyz \
    --cc=guix@cbaines.net \
    --cc=me@tobias.gr \
    --cc=othacehe@gnu.org \
    --cc=zimon.toutoune@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).