[bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'.

["Ludovic Courtès" <ludo@gnu.org>]

Hey!

That was fast!  :-)

"Jan (janneke) Nieuwenhuizen" <janneke@gnu.org> skribis:

> and doing something like
>
>     ./pre-inst-env guix system vm gnu/system/examples/bare-bones.tmpl --no-offload
>     /gnu/store/96wh3jwsla4p6d4s547mmqxsi4qbbc0r-run-vm.sh -m 2G \
>       --device rtl8139,netdev=net0 \
>       --netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222,hostfwd=tcp:127.0.0.1:5900-:5900
>
> nicely starts a bare-bones VM with the the hurd-in-vm service inside, but I
> cannot seem to connect to the Hurd VM it in any way.  Appending
> ",hostfwd=tcp:127.0.0.1:20022-:20022" (to directly ssh into the Hurd) even
> blocks me from ssh'ing into the GNU/linux host VM.

Weird.

> hurd-in-vm works beautifully when added to my system configuration and
> reconfiguring.
>
> * gnu/services/virtualization.scm (disk-image, hurd-in-vm-shepherd-service,
> hurd-vm-disk-image): New procedures.
> (%hurd-in-vm-operating-system, hurd-in-vm-service-type): New variable.
> (<hurd-in-vm-configuration>): New record type.
> * doc/guix.texi (Virtualization Services): Document it.

[…]

> +@subsubheading The Hurd in a Virtual Machine
> +
> +@cindex @code{hurd}
> +@cindex the Hurd
> +
> +Service @code{hurd-in-vm} provides support for running a Virtual Machine
> +with the GNU@tie{}Hurd.

“… support for running GNU/Hurd in a virtual machine (VM).  The virtual
machine is a Shepherd service that can be controlled with commands such
as:

@example
herd stop hurd-vm
@end example

The given GNU/Hurd operating system configuration is cross-compiled.”

Nitpick: I’d call it “hurd-vm”, because it runs a Hurd VM.  :-)

It’s a volatile VM, due to the use of ‘-snapshot’, right?

(The Hurd actually has “sub-Hurds”¹ and “neighborhurds”².  I wonder if
it’s our duty to coin another term… a guesthurd? a visithurd?)

¹ https://www.gnu.org/software/hurd/hurd/subhurd.html
² https://www.gnu.org/software/hurd/hurd/neighborhurd.html

> +(define* (disk-image os #:key (image-size 'guess) target)
> +  "Return a disk-image for OS with size IMAGE-SIZE, built for TARGET."
> +  (with-store store
      ^
In general, procedures should talk to the user-provided store and never
open a new connection.  They should also never call ‘build-derivations’
explicitly, the only exception so far being the graft implementation.

So you can drop ‘with-store’ here, and then:

> +    (run-with-store store
> +      (let ((file-system-type "ext2"))
> +        (mlet* %store-monad
> +            ((base-image (find-image file-system-type))
> +             (sys        (lower-object
> +                          (system-image
> +                           (image
> +                            (inherit base-image)
> +                            (size image-size)
> +                            (operating-system os)))))
> +             (drvs       (mapm/accumulate-builds lower-object (list sys)))
> +             (%          (built-derivations drvs)))
> +          (let ((output (derivation->output-path sys)))
> +            (return output))))

Mathieu, can we make ‘find-image’ non-monadic?  It really shouldn’t be
because it doesn’t interact with the store.  It can take an optional
‘system’ parameter if we want.

So, assuming ‘find-image’ is non-monadic, the code above becomes
something like:

  (system-image
    (image (inherit base-image)
           (size image-size)
           (operating-system
            (with-parameters ((%current-target-system "i586-pc-gnu"))
              os))))

> +(define %hurd-in-vm-operating-system
> +  (operating-system
> +    (inherit %hurd-default-operating-system)
> +    (host-name "guixydevel")
> +    (timezone "Europe/Amsterdam")
> +    (bootloader (bootloader-configuration
> +                 (bootloader grub-minimal-bootloader)
> +                 (target "/dev/vda")
> +                 (timeout 0)))
> +    (services (cons*
> +               (service openssh-service-type
> +                        (openssh-configuration
> +                         (openssh openssh-sans-x)
> +                         (use-pam? #f)
> +                         (port-number 2222)
> +                         (permit-root-login #t)
> +                         (allow-empty-passwords? #t)
> +                         (password-authentication? #t)))
> +               %base-services/hurd))))

I understand the need to factorize useful configs, but IMO it doesn’t
belong here.  So I’d just leave it out.  There’s already
‘%hurd-default-operating-system’ that does the heavy lifting anyway.

> +(define hurd-in-vm-service-type
> +  (service-type
> +   (name 'hurd-in-vm)
> +   (extensions (list (service-extension shepherd-root-service-type
> +                                        hurd-in-vm-shepherd-service)))
> +   (default-value (hurd-in-vm-configuration))
> +   (description
> +    "Provide a Virtual Machine running the GNU Hurd.")))

Being pedantic: s|the GNU Hurd|GNU/Hurd|.  :-)

Otherwise looks great to me, thank you!

Ludo’.