diff mbox series

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

Message ID 20200610085441.890-1-janneke@gnu.org
State Accepted
Headers show
Series [bug#41785] DRAFT services: Add 'hurd-in-vm service-type'. | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job

Commit Message

Janneke Nieuwenhuizen June 10, 2020, 8:54 a.m. UTC
TODO: Figure-out how to run this hurd VM inside a VM.

Using

--8<---------------cut here---------------start------------->8---

Comments

Mathieu Othacehe June 10, 2020, 11:34 a.m. UTC | #1
Hello Jan,

> TODO: Figure-out how to run this hurd VM inside a VM.

Just to clarify things here, we now have the "disk-image" command that
produces a Hurd bootable disk-image. The "vm-image" command is almost
working, and should produce a very similar result.

The "vm" command that produces a vm-image and spawns a VM isn't working
yet with the Hurd. This command is for now passing directly "kernel" and
"initrd" arguments to QEMU, so a few adaptations will be needed.

Now the goad of hurd-in-vm-service-type is to provide a service that
does almost the same thing as the "vm" command, but as a service, right?

So, I don't get why would we need to run a Hurd VM inside a VM. I've
been struggling a lot with running nested layers of virtualization (for
system generation before the recent patches), and the result is often
too slow to be really usable.

Thanks,

Mathieu
Ludovic Courtès June 11, 2020, 7:43 p.m. UTC | #2
Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> Just to clarify things here, we now have the "disk-image" command that
> produces a Hurd bootable disk-image. The "vm-image" command is almost
> working, and should produce a very similar result.
>
> The "vm" command that produces a vm-image and spawns a VM isn't working
> yet with the Hurd. This command is for now passing directly "kernel" and
> "initrd" arguments to QEMU, so a few adaptations will be needed.
>
> Now the goad of hurd-in-vm-service-type is to provide a service that
> does almost the same thing as the "vm" command, but as a service, right?

That’s my understanding.

> So, I don't get why would we need to run a Hurd VM inside a VM. I've
> been struggling a lot with running nested layers of virtualization (for
> system generation before the recent patches), and the result is often
> too slow to be really usable.

I guess it’s useful if you want to test a GNU/Linux system that uses the
VM service, as in:

  guix system vm my-gnu+linux.scm

where ‘my-gnu+linux.scm’ contains:

   (services (cons (service hurd-vm-service-type)
                   …))

I suppose it should just work, though probably without ‘-enable-kvm’;
janneke?

Thanks,
Ludo’.
Ludovic Courtès June 11, 2020, 7:59 p.m. UTC | #3
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’.
Janneke Nieuwenhuizen June 11, 2020, 7:59 p.m. UTC | #4
Ludovic Courtès writes:

Hello,

> Mathieu Othacehe <othacehe@gnu.org> skribis:
>
>> Just to clarify things here, we now have the "disk-image" command that
>> produces a Hurd bootable disk-image. The "vm-image" command is almost
>> working, and should produce a very similar result.

(yes)

>> The "vm" command that produces a vm-image and spawns a VM isn't working
>> yet with the Hurd. This command is for now passing directly "kernel" and
>> "initrd" arguments to QEMU, so a few adaptations will be needed.
>>
>> Now the goad of hurd-in-vm-service-type is to provide a service that
>> does almost the same thing as the "vm" command, but as a service, right?
>
> That’s my understanding.

Indeed, mine too.

>> So, I don't get why would we need to run a Hurd VM inside a VM. I've
>> been struggling a lot with running nested layers of virtualization (for
>> system generation before the recent patches), and the result is often
>> too slow to be really usable.
>
> I guess it’s useful if you want to test a GNU/Linux system that uses the
> VM service, as in:
>
>   guix system vm my-gnu+linux.scm
>
> where ‘my-gnu+linux.scm’ contains:
>
>    (services (cons (service hurd-vm-service-type)
>                    …))
>
> I suppose it should just work, though probably without ‘-enable-kvm’;
> janneke?

Well -- yes.  That was my thinking.

We would not normally use such a VM-in-VM thing; when you want a Hurd VM
using the "vm" command would be great (or as now, create a disk image
and start QEMU).

However, for writing and debugging (testing?) this Hurd-in-VM service, I
thought adding it to a linux bare-bones.tmpl and using guix vm on that
was a nice and "trivial" way to test it.  That proved so troublesome
that I added it to my system.

As I understand it the intended use for this service is to have a real
simple way to add a Hurd VM to some build machines, so that we can
easily create a herd of Hurd-VMs to aid the Hurd work.  Ludo?

Greetings,
Janneke
Marius Bakke June 11, 2020, 8:01 p.m. UTC | #5
Mathieu Othacehe <othacehe@gnu.org> writes:

> So, I don't get why would we need to run a Hurd VM inside a VM. I've
> been struggling a lot with running nested layers of virtualization (for
> system generation before the recent patches), and the result is often
> too slow to be really usable.

Note that recent processors support nested layers of virtualization
natively with little overhead, but it's disabled by default.

For an Intel processor, it can be enabled by adding this to your system
configuration:

  (kernel-arguments (cons "kvm_intel.nested=1" %default-kernel-arguments))

The corresponding AMD kernel module is called "kvm_amd".
Janneke Nieuwenhuizen June 12, 2020, 6:39 a.m. UTC | #6
Marius Bakke writes:

Hello,

> Mathieu Othacehe <othacehe@gnu.org> writes:
>
>> So, I don't get why would we need to run a Hurd VM inside a VM. I've
>> been struggling a lot with running nested layers of virtualization (for
>> system generation before the recent patches), and the result is often
>> too slow to be really usable.
>
> Note that recent processors support nested layers of virtualization
> natively with little overhead, but it's disabled by default.

Ah!

> For an Intel processor, it can be enabled by adding this to your system
> configuration:
>
>   (kernel-arguments (cons "kvm_intel.nested=1" %default-kernel-arguments))

Is there an obvious downside to enabling this?

Great...So on the host I did

--8<---------------cut here---------------start------------->8---
root@dundal ~# rmmod kvm_intel
root@dundal ~# modprobe kvm_intel kvm_intel.nested=1
root@dundal ~# cat /sys/module/kvm_intel/parameters/nested
Y
--8<---------------cut here---------------end--------------->8---

and the interwebs told me that to start the VM, you have to add "-cpu
host"; so I started it using

--8<---------------cut here---------------start------------->8---
/gnu/store/k2b7nx34cwyi6yk49wgy4hg9mrwcmll5-run-vm.sh -cpu host -m 2G -device rtl8139,netdev=net0 -netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222,hostfwd=tcp:127.0.0.1:25900-:25900
--8<---------------cut here---------------end--------------->8---

and trying to "ssh -p 20022 localhost" from inside the bare-bones VM now
prints

--8<---------------cut here---------------start------------->8---
qemu-system-i386: Slirp: Failed to send package, ret: -1
qemu-system-i386: Slirp: Failed to send package, ret: -1
qemu-system-i386: Slirp: Failed to send package, ret: -1
qemu-system-i386: Slirp: Failed to send package, ret: -1
qemu-system-i386: Slirp: Failed to send package, ret: -1
qemu-system-i386: Slirp: Failed to send package, ret: -1
key_exchange_identification: read: Connection reset by peer
Connection reset by 127.0.0.1 port 20022
--8<---------------cut here---------------end--------------->8---

...something networky with QEMU.  Ideas?

Janneke
Diego Nicola Barbato June 12, 2020, 10:51 a.m. UTC | #7
Hey,

Jan Nieuwenhuizen <janneke@gnu.org> writes:

[...]

> and the interwebs told me that to start the VM, you have to add "-cpu
> host"; so I started it using
>
> /gnu/store/k2b7nx34cwyi6yk49wgy4hg9mrwcmll5-run-vm.sh -cpu host -m 2G -device rtl8139,netdev=net0 -netdev user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222,hostfwd=tcp:127.0.0.1:25900-:25900
>
>
> and trying to "ssh -p 20022 localhost" from inside the bare-bones VM now
> prints
>
> qemu-system-i386: Slirp: Failed to send package, ret: -1
> qemu-system-i386: Slirp: Failed to send package, ret: -1
> qemu-system-i386: Slirp: Failed to send package, ret: -1
> qemu-system-i386: Slirp: Failed to send package, ret: -1
> qemu-system-i386: Slirp: Failed to send package, ret: -1
> qemu-system-i386: Slirp: Failed to send package, ret: -1
> key_exchange_identification: read: Connection reset by peer
> Connection reset by 127.0.0.1 port 20022
>
> ...something networky with QEMU.  Ideas?

I've recently had intermittent issues with 'guix system vm' and hostfwd.
Does it help if you remove the '-nic user,model=virtio-net-pci' option
from (a copy of) the run-vm.sh script so that there's only one netdev?

Regards,

Diego
Mathieu Othacehe June 12, 2020, 2:42 p.m. UTC | #8
Hello Ludo & janneke,

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

Yes, you're right, passing 'target' to 'find-image' should be enough to
make it non-monadic.

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

I would prefer 'target' to be part of the image itself, as I proposed
here: https://lists.gnu.org/archive/html/guix-devel/2020-05/msg00417.html.

There's no way for now, that the image is built without cross-compiling
for "i586-pc-gnu", so I think it could be part of the "image" record
itself.

WDYT?

>> +(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!

Looks really nice to me too :)

Thanks,

Mathieu
Ludovic Courtès June 12, 2020, 3:39 p.m. UTC | #9
Hi Mathieu!

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> 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))))
>
> I would prefer 'target' to be part of the image itself, as I proposed
> here: https://lists.gnu.org/archive/html/guix-devel/2020-05/msg00417.html.
>
> There's no way for now, that the image is built without cross-compiling
> for "i586-pc-gnu", so I think it could be part of the "image" record
> itself.
>
> WDYT?

Yes, why not, a ‘target’ field in <image> sounds fine.

In general, I think lowerable objects should not be parameterized by
target/system.  However, <image> is an exception because it needs to
access the operating system record, and still use the desired target, if
any.

Thanks,
Ludo’.
Janneke Nieuwenhuizen June 13, 2020, 7:30 a.m. UTC | #10
Diego Nicola Barbato writes:

Hi,

> Jan Nieuwenhuizen <janneke@gnu.org> writes:
>
> [...]
>
>> and the interwebs told me that to start the VM, you have to add "-cpu
>> host"; so I started it using
>>
>> /gnu/store/k2b7nx34cwyi6yk49wgy4hg9mrwcmll5-run-vm.sh -cpu host -m
>> 2G -device rtl8139,netdev=net0 -netdev
>> user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222,hostfwd=tcp:127.0.0.1:25900-:25900
>>
>>
>> and trying to "ssh -p 20022 localhost" from inside the bare-bones VM now
>> prints
>>
>> qemu-system-i386: Slirp: Failed to send package, ret: -1
>> qemu-system-i386: Slirp: Failed to send package, ret: -1
>> qemu-system-i386: Slirp: Failed to send package, ret: -1
>> qemu-system-i386: Slirp: Failed to send package, ret: -1
>> qemu-system-i386: Slirp: Failed to send package, ret: -1
>> qemu-system-i386: Slirp: Failed to send package, ret: -1
>> key_exchange_identification: read: Connection reset by peer
>> Connection reset by 127.0.0.1 port 20022
>>
>> ...something networky with QEMU.  Ideas?
>
> I've recently had intermittent issues with 'guix system vm' and hostfwd.
> Does it help if you remove the '-nic user,model=virtio-net-pci' option
> from (a copy of) the run-vm.sh script so that there's only one netdev?

That's helpful!  I now noticed that the QEMU command above I used was
the one I have been using to start the Hurd, networking wise.

After running

--8<---------------cut here---------------start------------->8---
./run-vm.sh -cpu host -m 2G -net nic -net user,id=net0,hostfwd=tcp:127.0.0.1:10022-:2222,hostfwd=tcp:127.0.0.1:5900-:25900,hostfwd=tcp:127.0.0.1:20022-:20022
--8<---------------cut here---------------end--------------->8---

I noticed that instead of two network interfaces, there is now just one,
as expected; much better.

No luck ssh'ing into the second VM, directly or indirectly.  I'm not
exploring this further as we don't have an actually need for this
vm-in-vm thing.

Greetings,
Janneke
diff mbox series

Patch

diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 1035ab1d60..40fb354ea4 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -5,6 +5,8 @@ 
 (use-service-modules networking ssh)
 (use-package-modules screen ssh)

+(use-service-modules hurd virtualization)
+
 (operating-system
   (host-name "komputilo")
   (timezone "Europe/Berlin")
@@ -44,8 +46,12 @@ 
   ;; Add services to the baseline: a DHCP client and
   ;; an SSH server.
   (services (append (list (service dhcp-client-service-type)
+                          (service hurd-in-vm-service-type)
                           (service openssh-service-type
                                    (openssh-configuration
                                     (openssh openssh-sans-x)
-                                    (port-number 2222))))
+                                    (port-number 2222)
+                                    (permit-root-login #t)
+                                    (allow-empty-passwords? #t)
+                                    (password-authentication? #t))))
                     %base-services)))
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 441b1eb7e0..e3560b80b7 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -878,7 +878,7 @@  functionality of the kernel Linux.")))
     (define vm-command
       #~(list
          (string-append #$qemu "/bin/qemu-system-i386")
-         #$@(if (file-exists? "/dev/kvm") '("-enable-kvm") '())
+         ;;huh? breaks hurd in bare-bones VM #$@(if (file-exists? "/dev/kvm") '("-enable-kvm") '())
          "-m" (number->string #$memory-size)
          #$@options
          #+image))
--8<---------------cut here---------------end--------------->8---

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.

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.
---
 doc/guix.texi                   |  61 ++++++++++++++
 gnu/services/virtualization.scm | 140 ++++++++++++++++++++++++++++++--
 2 files changed, 194 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 15e077a41c..cae77288f4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24583,6 +24583,67 @@  Return true if @var{obj} is a platform object.
 Return the name of @var{platform}---a string such as @code{"arm"}.
 @end deffn
 
+
+@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.
+
+@defvr {Scheme Variable} hurd-in-vm-service-type
+This is the type of the Hurd in a Virtual Machine service.  Its value
+must be a @code{hurd-in-vm-configuration} object, which specifies the
+operating system (@pxref{operating-system Reference}) and the disk size
+for the Hurd Virtual Machine, the QEMU package to use as well as the
+options for running it.
+
+For example:
+
+@lisp
+(service hurd-in-vm-service-type
+         (hurd-in-vm-configuration
+          (disk-size (* 5000 (expt 2 20))) ;5G
+          (memory-size 1024)))             ;1024MiB
+@end lisp
+
+would create a disk image big enough to build GNU@tie{}Hello, with some
+extra memory.
+@end defvr
+
+@deftp {Data Type} hurd-in-vm-configuration
+The data type representing the configuration for
+@code{hurd-in-vm-service-type}.
+
+@table @asis
+@item @code{os} (default: @var{%hurd-in-vm-operating-system})
+The operating system to instantiate.  This default is bare-bones with a
+permissive OpenSSH secure shell daemon listening on port 2222
+(@pxref{Networking Services, @code{openssh-service-type}}).
+
+@item @code{qemu} (default: @code{qemu-minimal})
+The QEMU package to use.
+
+@item @code{image} (default: @var{hurd-vm-disk-image})
+The procedure used to build the disk-image built from this
+configuration.
+
+@item @code{disk-size} (default: @code{'guess})
+The size of the disk image.
+
+@item @code{memory-size} (default: @code{512})
+The memory size of the Virtual Machine in mebibytes.
+
+@item @code{options} (default: @code{'("--device"} @code{"rtl8139,netdev=net0"} @
+      @code{"--netdev"} @
+      @code{"user,id=net0,hostfwd=tcp:127.0.0.1:20022-:2222,hostfwd=tcp:127.0.0.1:25900-:5900"} @
+      @code{"--snapshot"} @
+      @code{"--hda")})
+The extra options for running QEMU.
+@end table
+@end deftp
+
 @node Version Control Services
 @subsection Version Control Services
 
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 989e439d5d..441b1eb7e0 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,6 +1,7 @@ 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,24 +19,41 @@ 
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services virtualization)
-  #:use-module (gnu services)
-  #:use-module (gnu services configuration)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu image)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages ssh)
+  #:use-module (gnu packages virtualization)
   #:use-module (gnu services base)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services dbus)
   #:use-module (gnu services shepherd)
-  #:use-module (gnu system shadow)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu services)
   #:use-module (gnu system file-systems)
-  #:use-module (gnu packages admin)
-  #:use-module (gnu packages virtualization)
-  #:use-module (guix records)
+  #:use-module (gnu system hurd)
+  #:use-module (gnu system image)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu system)
+  #:use-module (guix derivations)
   #:use-module (guix gexp)
+  #:use-module (guix monads)
   #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
 
-  #:export (libvirt-configuration
+  #:export (%hurd-in-vm-operating-system
+            hurd-in-vm-configuration
+            hurd-in-vm-service-type
+
+            libvirt-configuration
             libvirt-service-type
             virtlog-configuration
             virtlog-service-type
@@ -773,3 +791,111 @@  given QEMU package."
                  "This service supports transparent emulation of binaries
 compiled for other architectures using QEMU and the @code{binfmt_misc}
 functionality of the kernel Linux.")))
+
+
+;;;
+;;; The Hurd in VM service.
+;;;
+
+(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
+    (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))))
+      #:target target)))
+
+(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))))
+
+(define-record-type* <hurd-in-vm-configuration>
+  hurd-in-vm-configuration make-hurd-in-vm-configuration
+  hurd-in-vm-configuration?
+  (os          hurd-in-vm-configuration-os                 ;<operating-system>
+               (default %hurd-in-vm-operating-system))
+  (qemu        hurd-in-vm-configuration-qemu               ;<package>
+               (default qemu-minimal))
+  (image       hurd-in-vm-configuration-image              ;string
+               (thunked)
+               (default (hurd-vm-disk-image this-record)))
+  (disk-size   hurd-in-vm-configuration-disk-size          ;number or 'guess
+               (default 'guess))
+  (memory-size hurd-in-vm-configuration-memory-size        ;number
+               (default 512))
+  (options     hurd-in-vm-configuration-options            ;list of string
+               (default
+                 `("--device" "rtl8139,netdev=net0"
+                   "--netdev" (string-append
+                               "user,id=net0"
+                               ",hostfwd=tcp:127.0.0.1:20022-:2222"
+                               ",hostfwd=tcp:127.0.0.1:25900-:5900")
+                   "--snapshot"
+                   "--hda"))))
+
+(define (hurd-vm-disk-image config)
+  "Return a disk-image for the Hurd according to CONFIG."
+  (let ((os (hurd-in-vm-configuration-os config))
+        (disk-size (hurd-in-vm-configuration-disk-size config))
+        (target (and (not (%current-target-system)) "i586-pc-gnu")))
+    (disk-image os #:target target #:image-size disk-size)))
+
+(define (hurd-in-vm-shepherd-service config)
+  "Return a <shepherd-service> for a Hurd in a Virtual Machine with CONFIG."
+
+  (let ((image       (hurd-in-vm-configuration-image config))
+        (qemu        (hurd-in-vm-configuration-qemu config))
+        (memory-size (hurd-in-vm-configuration-memory-size config))
+        (options     (hurd-in-vm-configuration-options config)))
+
+    (define vm-command
+      #~(list
+         (string-append #$qemu "/bin/qemu-system-i386")
+         #$@(if (file-exists? "/dev/kvm") '("-enable-kvm") '())
+         "-m" (number->string #$memory-size)
+         #$@options
+         #+image))
+
+    (list
+     (shepherd-service
+      (documentation "Run the Hurd in a Virtual Machine.")
+      (provision '(hurd-in-vm))
+      (requirement '(networking))
+      (start #~(make-forkexec-constructor #$vm-command))
+      (stop  #~(make-kill-destructor))))))
+
+(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.")))