diff mbox series

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

Message ID 87wo4d2rm5.fsf@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 11, 2020, 9:57 p.m. UTC 
Ludovic Courtès writes:

Hello,

> That was fast!  :-)

Yeah...we need this, right ;)

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

Nice, thanks!

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

Done!

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

By default: Yes.  That seemed more ready-to-use.  A stateful VM image
would need to an out-of-store, writable copy.  You can actually do that
and modify the hurd-vm-configuration.

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

Oh, that's cool!  Associating along from the neighborhurd pun, what
about a "childhurd" (as a pun on childhood -- only needed while the Hurd
is growing up)?

"herd start childhurd" -- hmm?  In the updated patch, I still have
hurd-vm.  If we do our duty and coin "childhurd", should I just
s/hurd-vm/childhurd/g ?

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

It seems that "just works".  I've made that change in a separate patch
(attached).

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

Hmm...I don't think that I understand.  This

--8<---------------cut here---------------start------------->8---
(define* (disk-image os #:key (image-size 'guess) target)
  "Return a disk-image for OS with size IMAGE-SIZE, built for TARGET."
  (let ((base-image (find-image "ext2")))
    (system-image
     (image (inherit base-image)
            (size image-size)
            (operating-system
              (with-parameters ((%current-target-system target))
                os))))))

--8<---------------cut here---------------end--------------->8---

gives

--8<---------------cut here---------------start------------->8---
$ ~/src/guix/master/pre-inst-env guix system build dundal.scm
%default-substitute-urls:("https://ci.guix.gnu.org")
Backtrace:
In ice-9/boot-9.scm:
  1736:10  4 (with-exception-handler _ _ #:unwind? _ #:unwind-for-type _)
In unknown file:
           3 (apply-smob/0 #<thunk 7f4ce92e3980>)
In ice-9/boot-9.scm:
    718:2  2 (call-with-prompt _ _ #<procedure default-prompt-handler (k proc)>)
In ice-9/eval.scm:
    619:8  1 (_ #(#(#<directory (guile-user) 7f4ce8f05f00>)))
In guix/ui.scm:
  1945:12  0 (run-guix-command _ . _)

guix/ui.scm:1945:12: In procedure run-guix-command:
In procedure operating-system-file-systems: Wrong type argument: #<<parameterized> bindings: ((#<<parameter> 7f4ce7c23740 proc: #<procedure 7f4ce7c28200 at ice-9/boot-9.scm:1299:5 () | (x)>> #<procedure 7f4cd32f83c0 at gnu/services/virtualization.scm:806:14 ()>)) thunk: #<procedure 7f4cd32f8340 at gnu/services/virtualization.scm:806:14 ()>>
--8<---------------cut here---------------end--------------->8---

...I could do with some help here.

>> +(define %hurd-in-vm-operating-system
[..]
>> +  (operating-system
>> +               (service openssh-service-type
>> +                        (openssh-configuration
>> +                         (openssh openssh-sans-x)
[..]
>> +               %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.

Sure, removed!  Users will most probably want to add an openssh server
using openssh-sans-x; but I guess that's something for a blog post or
cookbook then.

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

Great; thanks...find two new patches attached.

Janneke

Comments

Janneke Nieuwenhuizen June 12, 2020, 6:46 a.m. UTC | #1 
Jan Nieuwenhuizen writes:

> Ludovic Courtès writes:
>
> Hello,
>
>> That was fast!  :-)
>
> Yeah...we need this, right ;)

Sometimes...too fast :-(

So...there's still the run-with-store/with-parameters puzzle; but just
wanted to say that

>>From e5bdf050f628cc7ea1b6bc4ccdcfeb757429820f Mon Sep 17 00:00:00 2001
> From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
> Date: Wed, 10 Jun 2020 00:10:28 +0200
> Subject: [PATCH v2 2/2] services: Add 'hurd-vm service-type'.

[...]

>  gnu/system/examples/bare-bones.tmpl |   8 +-

Oops...


> diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
> index 1035ab1d60..1d4f7743ab 100644
> --- a/gnu/system/examples/bare-bones.tmpl
> +++ b/gnu/system/examples/bare-bones.tmpl

...without this bits, of course!!

Janneke
Ludovic Courtès June 12, 2020, 2:45 p.m. UTC | #2 
Hi!

Jan Nieuwenhuizen <janneke@gnu.org> skribis:

>> It’s a volatile VM, due to the use of ‘-snapshot’, right?
>
> By default: Yes.  That seemed more ready-to-use.  A stateful VM image
> would need to an out-of-store, writable copy.  You can actually do that
> and modify the hurd-vm-configuration.

It’s maybe worth mentioning in the manual.

>> (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
>
> Oh, that's cool!  Associating along from the neighborhurd pun, what
> about a "childhurd" (as a pun on childhood -- only needed while the Hurd
> is growing up)?

“Childhurd”, LOVE IT!

> "herd start childhurd" -- hmm?  In the updated patch, I still have
> hurd-vm.  If we do our duty and coin "childhurd", should I just
> s/hurd-vm/childhurd/g ?

Shepherd services can have more than one name, so I propose to have both!

>> 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))))
>
> Hmm...I don't think that I understand.  This
>
> (define* (disk-image os #:key (image-size 'guess) target)
>   "Return a disk-image for OS with size IMAGE-SIZE, built for TARGET."
>   (let ((base-image (find-image "ext2")))
>     (system-image
>      (image (inherit base-image)
>             (size image-size)
>             (operating-system
>               (with-parameters ((%current-target-system target))
>                 os))))))
>
>
> gives
>
> $ ~/src/guix/master/pre-inst-env guix system build dundal.scm
> %default-substitute-urls:("https://ci.guix.gnu.org")
> Backtrace:
> In ice-9/boot-9.scm:
>   1736:10  4 (with-exception-handler _ _ #:unwind? _ #:unwind-for-type _)
> In unknown file:
>            3 (apply-smob/0 #<thunk 7f4ce92e3980>)
> In ice-9/boot-9.scm:
>     718:2  2 (call-with-prompt _ _ #<procedure default-prompt-handler (k proc)>)
> In ice-9/eval.scm:
>     619:8  1 (_ #(#(#<directory (guile-user) 7f4ce8f05f00>)))
> In guix/ui.scm:
>   1945:12  0 (run-guix-command _ . _)
>
> guix/ui.scm:1945:12: In procedure run-guix-command:
> In procedure operating-system-file-systems: Wrong type argument: #<<parameterized> bindings: ((#<<parameter> 7f4ce7c23740 proc: #<procedure 7f4ce7c28200 at ice-9/boot-9.scm:1299:5 () | (x)>> #<procedure 7f4cd32f83c0 at gnu/services/virtualization.scm:806:14 ()>)) thunk: #<procedure 7f4cd32f8340 at gnu/services/virtualization.scm:806:14 ()>>
>
> ...I could do with some help here.

Ooh, sadness.  We can’t do that because the image machinery really
expects an <operating-system>.

What if you move ‘with-parameters’ around (system-image …) instead?

>>> +(define %hurd-in-vm-operating-system
> [..]
>>> +  (operating-system
>>> +               (service openssh-service-type
>>> +                        (openssh-configuration
>>> +                         (openssh openssh-sans-x)
> [..]
>>> +               %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.
>
> Sure, removed!  Users will most probably want to add an openssh server
> using openssh-sans-x; but I guess that's something for a blog post or
> cookbook then.

Yeah.

Hmm, come to think about it, we need a default value here anyway, so
after all, we have a good reason to have it here.  (Says the guy who
changes his mind.)

> From b01b8d2a46a6a04cb8f09d74c06cbbc82878f070 Mon Sep 17 00:00:00 2001
> From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
> Date: Thu, 11 Jun 2020 22:52:12 +0200
> Subject: [PATCH v2 1/2] image: Make 'find-image' non-monadic.
>
> * gnu/system/image.scm (find-image): Make non-monadic.
> * gnu/tests/install.scm (run-install): Update caller.
> * guix/scripts/system.scm (perform-action): Likewise.

[...]

>    "Find and return an image that could match the given FILE-SYSTEM-TYPE.  This
>  is useful to adapt to interfaces written before the addition of the <image>
>  record."
> -  (mlet %store-monad ((target (current-target-system)))
> -    (mbegin %store-monad
> -      (return
> -       (match file-system-type
> -         ("iso9660" iso9660-image)
> -         (_ (cond
> -             ((and target
> -                   (hurd-triplet? target))
> -              hurd-disk-image)
> -             (else
> -              efi-disk-image))))))))
> +  (let ((target (%current-target-system)))
> +    (match file-system-type
> +      ("iso9660" iso9660-image)
> +      (_ (cond
> +          ((and target
> +                (hurd-triplet? target))
> +           hurd-disk-image)
> +          (else
> +           efi-disk-image))))))

I’d prefer:

  (define* (find-image #:optional (system (%current-system)))
    …)

In your case, you’d need to make this call:

  (find-image "i586-gnu")

(Beware of the triplet/system type distinction!)

Perhaps the other call sites need to be adjusted.

> From e5bdf050f628cc7ea1b6bc4ccdcfeb757429820f Mon Sep 17 00:00:00 2001
> From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
> Date: Wed, 10 Jun 2020 00:10:28 +0200
> Subject: [PATCH v2 2/2] services: Add 'hurd-vm service-type'.
>
> * gnu/services/virtualization.scm (disk-image, hurd-in-vm-shepherd-service,
> hurd-vm-disk-image): New procedures.
> (hurd-in-vm-service-type): New variable.
> (<hurd-in-vm-configuration>): New record type.
> * doc/guix.texi (Virtualization Services): Document it.

s/hurd-in-vm/hurd-vm/ in the commit log.

Otherwise LGTM, thank you!

Ludo’.
Mathieu Othacehe June 12, 2020, 3:04 p.m. UTC | #3 
Hey janneke,

> +  (let ((target (%current-target-system)))
> +    (match file-system-type
> +      ("iso9660" iso9660-image)
> +      (_ (cond
> +          ((and target
> +                (hurd-triplet? target))
> +           hurd-disk-image)
> +          (else
> +           efi-disk-image))))))

I think it would be safe to pass a "target" argument. Then the two
actual callers could pass (current-target-system) as target
argument. This is guaranteed to return a correct value, whereas
%current-target-system is not here.

> +@lisp
> +(service hurd-vm-service-type
> +         (hurd-vm-configuration
> +          (disk-size (* 5000 (expt 2 20))) ;5G
> +          (memory-size 1024)))             ;1024MiB

That's really nice! We could really use a (guix units) module or so
where we would put those definitions: "(define MiB (expt 2 20))". Then
we could use:

--8<---------------cut here---------------start------------->8---
(service hurd-vm-service-type
         (hurd-vm-configuration
          (disk-size (* 5 GiB)
          (memory-size (* 1024 MiB)))
--8<---------------cut here---------------end--------------->8---

Well, this is really not a blocking thing.

> +(define* (disk-image os #:key (image-size 'guess) target)
> +  "Return a disk-image for OS with size IMAGE-SIZE, built for TARGET."
> +  (let ((base-image (find-image "ext2")))
> +    (system-image
> +     (image (inherit base-image)
> +            (size image-size)
> +            (operating-system
> +              (with-parameters ((%current-target-system target))
> +                os))))))

Yeah then again, I think it would be nice to use something like the
"hurd-disk-image" as I proposed here:
https://lists.gnu.org/archive/html/guix-devel/2020-05/msg00417.html.

This way, no need to call "find-image". You could just write:

--8<---------------cut here---------------start------------->8---
(define (image os #:key (image-size 'guess))
  (image
   (inherit hurd-disk-image)
   (size image-size)
   (operating-system os)))
--8<---------------cut here---------------end--------------->8---

> +  (image       hurd-vm-configuration-image              ;string
> +               (thunked)

Then the thunked field wouldn't be required.

Mostly comments related to the fact that (gnu image) needs some
polishing, your patches are really nice here :)

Thanks,

Mathieu
Janneke Nieuwenhuizen June 12, 2020, 9:33 p.m. UTC | #4 
Mathieu Othacehe writes:

Hello Mathieu,

>> +  (let ((target (%current-target-system)))
>> +    (match file-system-type
>> +      ("iso9660" iso9660-image)
>> +      (_ (cond
>> +          ((and target
>> +                (hurd-triplet? target))
>> +           hurd-disk-image)
>> +          (else
>> +           efi-disk-image))))))
>
> I think it would be safe to pass a "target" argument. Then the two
> actual callers could pass (current-target-system) as target
> argument. This is guaranteed to return a correct value, whereas
> %current-target-system is not here.

Okay, sure.  I've made that change for now.

>> +@lisp
>> +(service hurd-vm-service-type
>> +         (hurd-vm-configuration
>> +          (disk-size (* 5000 (expt 2 20))) ;5G
>> +          (memory-size 1024)))             ;1024MiB
>
> That's really nice! We could really use a (guix units) module or so
> where we would put those definitions: "(define MiB (expt 2 20))". Then
> we could use:
>
> (service hurd-vm-service-type
>          (hurd-vm-configuration
>           (disk-size (* 5 GiB)
>           (memory-size (* 1024 MiB)))

I like it!

> Well, this is really not a blocking thing.

>> +(define* (disk-image os #:key (image-size 'guess) target)
>> +  "Return a disk-image for OS with size IMAGE-SIZE, built for TARGET."
>> +  (let ((base-image (find-image "ext2")))
>> +    (system-image
>> +     (image (inherit base-image)
>> +            (size image-size)
>> +            (operating-system
>> +              (with-parameters ((%current-target-system target))
>> +                os))))))
>
> Yeah then again, I think it would be nice to use something like the
> "hurd-disk-image" as I proposed here:
> https://lists.gnu.org/archive/html/guix-devel/2020-05/msg00417.html.
>
> This way, no need to call "find-image". You could just write:
>
> (define (image os #:key (image-size 'guess))
>   (image
>    (inherit hurd-disk-image)
>    (size image-size)
>    (operating-system os)))

Oh yes...that's great.  It seems that until we have that, as Ludo
suggested with this:

--8<---------------cut here---------------start------------->8---
    (with-parameters ((%current-target-system target))
      (system-image
       (image (inherit base-image)
              (size disk-size)
              (operating-system os))))))
--8<---------------cut here---------------end--------------->8---

we have now something "that works" for the Hurd.

>> +  (image       hurd-vm-configuration-image              ;string
>> +               (thunked)
>
> Then the thunked field wouldn't be required.
>
> Mostly comments related to the fact that (gnu image) needs some
> polishing, your patches are really nice here :)

Thank you.  I'll be working to prepare a v3 series that works on master
right now; then we can see how to proceed.

Thanks!
Janneke
Janneke Nieuwenhuizen June 12, 2020, 9:33 p.m. UTC | #5 
Ludovic Courtès writes:

Hello,

> Jan Nieuwenhuizen <janneke@gnu.org> skribis:
>
>>> It’s a volatile VM, due to the use of ‘-snapshot’, right?
>>
>> By default: Yes.  That seemed more ready-to-use.  A stateful VM image
>> would need to an out-of-store, writable copy.  You can actually do that
>> and modify the hurd-vm-configuration.
>
> It’s maybe worth mentioning in the manual.

Ah right, I wanted to do that after your remark...but forgot.  Could be
an unpleasant surprise to lose everything.  I've now added

--8<---------------cut here---------------start------------->8---
Note that by default the VM image is volatile, i.e., once stopped the
contents are lost.  If you want a stateful image instead, override the
configuration's @code{image} and @code{options} without
the @code{--snapshot} flag using something along these lines:

@lisp
(service hurd-vm-service-type
         (hurd-vm-configuration
          (image    (const "/out/of/store/writable/hurd.img"))
          (options '("--device" "rtl8139,netdev=net0"
                     "--netdev"
                     "user,id=net0,hostfwd=tcp:127.0.0.1:20022-:2222"))))
@end lisp
--8<---------------cut here---------------end--------------->8---

to the patch.

>>> (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
>>
>> Oh, that's cool!  Associating along from the neighborhurd pun, what
>> about a "childhurd" (as a pun on childhood -- only needed while the Hurd
>> is growing up)?
>
> “Childhurd”, LOVE IT!

Heh; ...

>> "herd start childhurd" -- hmm?  In the updated patch, I still have
>> hurd-vm.  If we do our duty and coin "childhurd", should I just
>> s/hurd-vm/childhurd/g ?
>
> Shepherd services can have more than one name, so I propose to have both!

... great, now lemme see where to mention this.  I just put in in the
code

--8<---------------cut here---------------start------------->8---
    (list
     (shepherd-service
      (documentation "Run the Hurd in a Virtual Machine: a Childhurd.")
      (provision '(hurd-vm childhurd))
--8<---------------cut here---------------end--------------->8---

and docs here

--8<---------------cut here---------------start------------->8---
@example
herd start hurd-vm
herd stop childhurd
@end example
--8<---------------cut here---------------end--------------->8---

> Ooh, sadness.  We can’t do that because the image machinery really
> expects an <operating-system>.
>
> What if you move ‘with-parameters’ around (system-image …) instead?

=> \o/ that works!  You're genius ;-)

>>>> +(define %hurd-in-vm-operating-system
>> [..]
>>>> +  (operating-system
>>>> +               (service openssh-service-type
>>>> +                        (openssh-configuration
>>>> +                         (openssh openssh-sans-x)
>> [..]
>>>> +               %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.
>>
>> Sure, removed!  Users will most probably want to add an openssh server
>> using openssh-sans-x; but I guess that's something for a blog post or
>> cookbook then.
>
> Yeah.
>
> Hmm, come to think about it, we need a default value here anyway, so
> after all, we have a good reason to have it here.  (Says the guy who
> changes his mind.)

Heh, it's such a pleasure working with you.  I've put it back again,
without the -in- bit.  (says the guy who was easily convinced we didn't
need it.)

>> From b01b8d2a46a6a04cb8f09d74c06cbbc82878f070 Mon Sep 17 00:00:00 2001
>> From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
>> Date: Thu, 11 Jun 2020 22:52:12 +0200
>> Subject: [PATCH v2 1/2] image: Make 'find-image' non-monadic.
>>
>> * gnu/system/image.scm (find-image): Make non-monadic.
>> * gnu/tests/install.scm (run-install): Update caller.
>> * guix/scripts/system.scm (perform-action): Likewise.
>
> [...]
>
>>    "Find and return an image that could match the given FILE-SYSTEM-TYPE.  This
>>  is useful to adapt to interfaces written before the addition of the <image>
>>  record."
>> -  (mlet %store-monad ((target (current-target-system)))
>> -    (mbegin %store-monad
>> -      (return
>> -       (match file-system-type
>> -         ("iso9660" iso9660-image)
>> -         (_ (cond
>> -             ((and target
>> -                   (hurd-triplet? target))
>> -              hurd-disk-image)
>> -             (else
>> -              efi-disk-image))))))))
>> +  (let ((target (%current-target-system)))
>> +    (match file-system-type
>> +      ("iso9660" iso9660-image)
>> +      (_ (cond
>> +          ((and target
>> +                (hurd-triplet? target))
>> +           hurd-disk-image)
>> +          (else
>> +           efi-disk-image))))))
>
> I’d prefer:
>
>   (define* (find-image #:optional (system (%current-system)))
>     …)
>
> In your case, you’d need to make this call:
>
>   (find-image "i586-gnu")
>
> (Beware of the triplet/system type distinction!)
>
> Perhaps the other call sites need to be adjusted.

Then Mathieu writes

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

and Ludo writes

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

So...I'm sticking with a the 'target' parameter for now; as that was
Mathieu's suggestion and a closer match to the final solution of
moving TARGET into image.

>> From e5bdf050f628cc7ea1b6bc4ccdcfeb757429820f Mon Sep 17 00:00:00 2001
>> From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
>> Date: Wed, 10 Jun 2020 00:10:28 +0200
>> Subject: [PATCH v2 2/2] services: Add 'hurd-vm service-type'.
>>
>> * gnu/services/virtualization.scm (disk-image, hurd-in-vm-shepherd-service,
>> hurd-vm-disk-image): New procedures.
>> (hurd-in-vm-service-type): New variable.
>> (<hurd-in-vm-configuration>): New record type.
>> * doc/guix.texi (Virtualization Services): Document it.
>
> s/hurd-in-vm/hurd-vm/ in the commit log.
>
> Otherwise LGTM, thank you!

Thanks!  I'll be sending a v3 series that should be OK (apart from the
image work that's not finished yet), and we can decide what to do.

Greetings,
Janneke
diff mbox series

Patch

From e5bdf050f628cc7ea1b6bc4ccdcfeb757429820f Mon Sep 17 00:00:00 2001
From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
Date: Wed, 10 Jun 2020 00:10:28 +0200
Subject: [PATCH v2 2/2] services: Add 'hurd-vm service-type'.

* gnu/services/virtualization.scm (disk-image, hurd-in-vm-shepherd-service,
hurd-vm-disk-image): New procedures.
(hurd-in-vm-service-type): New variable.
(<hurd-in-vm-configuration>): New record type.
* doc/guix.texi (Virtualization Services): Document it.
---
 doc/guix.texi                       |  66 +++++++++++++++++
 gnu/services/virtualization.scm     | 110 ++++++++++++++++++++++++++--
 gnu/system/examples/bare-bones.tmpl |   8 +-
 3 files changed, 176 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 15e077a41c..2c924e5313 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24583,6 +24583,72 @@  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-vm} provides 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.
+
+@defvr {Scheme Variable} hurd-vm-service-type
+This is the type of the Hurd in a Virtual Machine service.  Its value
+must be a @code{hurd-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-vm-service-type
+         (hurd-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-vm-configuration
+The data type representing the configuration for
+@code{hurd-vm-service-type}.
+
+@table @asis
+@item @code{os} (default: @var{%hurd-default-operating-system})
+The operating system to instantiate.
+
+@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..f2a5e7200e 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,40 @@ 
 ;;; 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-vm-configuration
+            hurd-vm-service-type
+
+            libvirt-configuration
             libvirt-service-type
             virtlog-configuration
             virtlog-service-type
@@ -773,3 +790,82 @@  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."
+  (let ((base-image (find-image "ext2")))
+    (system-image
+     (image (inherit base-image)
+            (size image-size)
+            (operating-system
+              (with-parameters ((%current-target-system target))
+                os))))))
+
+(define-record-type* <hurd-vm-configuration>
+  hurd-vm-configuration make-hurd-vm-configuration
+  hurd-vm-configuration?
+  (os          hurd-vm-configuration-os                 ;<operating-system>
+               (default %hurd-default-operating-system))
+  (qemu        hurd-vm-configuration-qemu               ;<package>
+               (default qemu-minimal))
+  (image       hurd-vm-configuration-image              ;string
+               (thunked)
+               (default (hurd-vm-disk-image this-record)))
+  (disk-size   hurd-vm-configuration-disk-size          ;number or 'guess
+               (default 'guess))
+  (memory-size hurd-vm-configuration-memory-size        ;number
+               (default 512))
+  (options     hurd-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-vm-configuration-os config))
+        (disk-size (hurd-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-vm-shepherd-service config)
+  "Return a <shepherd-service> for a Hurd in a Virtual Machine with CONFIG."
+
+  (let ((image       (hurd-vm-configuration-image config))
+        (qemu        (hurd-vm-configuration-qemu config))
+        (memory-size (hurd-vm-configuration-memory-size config))
+        (options     (hurd-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-vm))
+      (requirement '(networking))
+      (start #~(make-forkexec-constructor #$vm-command))
+      (stop  #~(make-kill-destructor))))))
+
+(define hurd-vm-service-type
+  (service-type
+   (name 'hurd-vm)
+   (extensions (list (service-extension shepherd-root-service-type
+                                        hurd-vm-shepherd-service)))
+   (default-value (hurd-vm-configuration))
+   (description
+    "Provide a Virtual Machine running the GNU/Hurd.")))
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 1035ab1d60..1d4f7743ab 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-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)))
-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com