services: hurd-vm: Support different hurd types.

* 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 <ludo@gnu.org>

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

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

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