From fecaf550cfb0f0715965f65f57b96c1a033ae954 Mon Sep 17 00:00:00 2001 From: Yelninei Date: Wed, 27 Aug 2025 15:51:39 +0000 Subject: [PATCH] services: hurd-vm: Support different hurd types. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/virtualization.scm (sanitize-hurd-vm-configuration-type): New procedure. (hurd-vm-confiuration): Add type field. (hurd-vm-disk-image): Use it. * doc/guix.texi (hurd-vm-configuration): Document it. * gnu/tests/virtualization.scm (%childhurd64-os): New variable. (run-childhurd-test): Add the os a parameter. (%test-childhurd): Adjust accordingly. (%test-childhurd64): New system test. Change-Id: Ie1c55a9414657ced4bf8b4324527037f1a1f78f4 Signed-off-by: Ludovic Courtès --- doc/guix.texi | 4 ++++ gnu/services/virtualization.scm | 13 ++++++++++++- gnu/tests/virtualization.scm | 32 +++++++++++++++++++++++++++++--- 3 files changed, 45 insertions(+), 4 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 22d26a9ba73dd070601d57d4a2ef784a0a689a3c..100a7ed8b62def8f1ccfa8b7357198da04dd95bd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -40576,6 +40576,10 @@ permissive OpenSSH secure shell daemon listening on port 2222 @item @code{qemu} (default: @code{qemu-minimal}) The QEMU package to use. +@item @code{type} (default: @code{'hurd-qcow2}) +The image type name. Use @code{'hurd-qcow2} for a 32-bit image or +@code{'hurd64-qcow2} for a 64-bit image. + @item @code{image} (default: @var{hurd-vm-disk-image}) The image object representing the disk image of this virtual machine (@pxref{System Images}). diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index 14007e740d7fa9a46848a9d88089cf35568ee961..3f7218f421ac2ab639e2e5170d3d8cb516e888c6 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -61,6 +61,7 @@ #:use-module (guix packages) #:use-module (guix records) #:use-module (guix store) + #:use-module (guix ui) #:use-module (guix utils) #:autoload (guix self) (make-config.scm) #:autoload (guix platform) (platform-system) @@ -83,6 +84,7 @@ hurd-vm-configuration? hurd-vm-configuration-os hurd-vm-configuration-qemu + hurd-vm-configuration-type hurd-vm-configuration-image hurd-vm-configuration-disk-size hurd-vm-configuration-memory-size @@ -1782,6 +1784,11 @@ preventing password-based authentication as 'root'." (inherit config) (authorize-key? #f)))))))) +(define (sanitize-hurd-vm-configuration-type value) + (unless (memq value '(hurd-qcow2 hurd64-qcow2)) + (leave (G_ "hurd-vm: '~a' is not a valid type~%") value)) + value) + (define-record-type* hurd-vm-configuration make-hurd-vm-configuration hurd-vm-configuration? @@ -1789,6 +1796,9 @@ preventing password-based authentication as 'root'." (default %hurd-vm-operating-system)) (qemu hurd-vm-configuration-qemu ;file-like (default qemu-minimal)) + (type hurd-vm-configuration-type ;symbol + (default 'hurd-qcow2) + (sanitize sanitize-hurd-vm-configuration-type)) (image hurd-vm-configuration-image ; (thunked) (default (hurd-vm-disk-image this-record))) @@ -1825,7 +1835,8 @@ is added to the OS specified in CONFIG." (let* ((os (transform (hurd-vm-configuration-os config))) (disk-size (hurd-vm-configuration-disk-size config)) - (type (lookup-image-type-by-name 'hurd-qcow2)) + (type (lookup-image-type-by-name + (hurd-vm-configuration-type config))) (os->image (image-type-constructor type))) (image (inherit (os->image os)) (size disk-size)))) diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index c55a944845ff9a71ccf617bbf5b0c672d2fca655..a882d70e140cf72a43068eefa79618fccc3482c0 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -27,6 +27,7 @@ #:use-module (gnu system) #:use-module (gnu system accounts) #:use-module (gnu system file-systems) + #:use-module (gnu system hurd) #:use-module (gnu system image) #:use-module (gnu system images hurd) #:use-module ((gnu system shadow) #:select (%base-user-accounts)) @@ -45,6 +46,7 @@ #:export (%test-libvirt %test-qemu-guest-agent %test-childhurd + %test-childhurd64 %test-build-vm)) @@ -277,6 +279,22 @@ (password "")) ;empty password %base-user-accounts)))))))) +(define %childhurd64-os + (simple-operating-system + (service dhcpcd-service-type) + (service hurd-vm-service-type + (hurd-vm-configuration + (type 'hurd64-qcow2) + (os (operating-system + (inherit %hurd-vm-operating-system) + (kernel %hurd64-default-operating-system-kernel) + (kernel-arguments '("noide")) ;use rumpdisk + (users (cons (user-account + (name "test") + (group "users") + (password "")) ;empty password + %base-user-accounts)))))))) + (define* (run-command-over-ssh command #:key (port 10022) (user "test")) "Return a program that runs COMMAND over SSH and prints the result on standard @@ -307,7 +325,7 @@ output." (program-file "run-command-over-ssh" run)) -(define (run-childhurd-test) +(define (run-childhurd-test childhurd-os) (define (import-module? module) ;; This module is optional and depends on Guile-Gcrypt, do skip it. (and (guix-module-name? module) @@ -315,7 +333,7 @@ output." (define os (marionette-operating-system - %childhurd-os + childhurd-os #:imported-modules (source-module-closure '((gnu services herd) (guix combinators) @@ -454,7 +472,15 @@ output." (description "Connect to the GNU/Hurd virtual machine service, aka. a childhurd, making sure that the childhurd boots and runs its SSH server.") - (value (run-childhurd-test)))) + (value (run-childhurd-test %childhurd-os)))) + +(define %test-childhurd64 + (system-test + (name "childhurd64") + (description + "Connect to the 64-bit GNU/Hurd virtual machine service, aka. a childhurd, + making sure that the childhurd boots and runs its SSH server.") + (value (run-childhurd-test %childhurd64-os)))) ;;;