3 files changed, 45 insertions(+), 4 deletions(-)

M doc/guix.texi
M gnu/services/virtualization.scm
M gnu/tests/virtualization.scm

@@ 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}).

@@ 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>
   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              ;<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))))

@@ 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))))
 
 
 ;;;