[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'.
|
From: |
Jan Nieuwenhuizen |
|
Subject: |
[bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'. |
|
Date: |
Thu, 11 Jun 2020 23:57:06 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) |
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
>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.
---
gnu/system/image.scm | 21 ++++++++++-----------
gnu/tests/install.scm | 5 +++--
guix/scripts/system.scm | 3 ++-
3 files changed, 15 insertions(+), 14 deletions(-)
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index a0e6bf31f1..66a9f6b335 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -551,16 +552,14 @@ image, depending on IMAGE format."
"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))))))
;;; image.scm ends here
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 6bd8c7d3d2..d18e33179f 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -228,8 +229,8 @@ packages defined in installation-os."
(mlet* %store-monad ((_ (set-grafting #f))
(system (current-system))
(target (operating-system-derivation target-os))
- (base-image (find-image
- installation-disk-image-file-system-type))
+ (base-image -> (find-image
+
installation-disk-image-file-system-type))
;; Since the installation system has no network access,
;; we cheat a little bit by adding TARGET to its GC
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3d7aa77cb7..fc92b9f07b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -801,7 +802,7 @@ static checks."
(check-initrd-modules os)))
(mlet* %store-monad
- ((image (find-image file-system-type))
+ ((image -> (find-image file-system-type))
(sys (system-derivation-for-action os image action
#:file-system-type
file-system-type
#:image-size image-size
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com
>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
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com
[bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'., Ludovic Courtès, 2020/06/11
- [bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'.,
Jan Nieuwenhuizen <=
- [bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'., Mathieu Othacehe, 2020/06/12
- [bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'., Jan Nieuwenhuizen, 2020/06/12
- [bug#41785] [PATCH v4] services: Add 'hurd-in-vm service-type'., Jan Nieuwenhuizen, 2020/06/14
- [bug#41785] [PATCH v4] services: Add 'hurd-in-vm service-type'., Mathieu Othacehe, 2020/06/14
- [bug#41785] [PATCH v4] services: Add 'hurd-in-vm service-type'., Jan Nieuwenhuizen, 2020/06/14
- [bug#41785] [PATCH v4] services: Add 'hurd-in-vm service-type'., Mathieu Othacehe, 2020/06/14
- [bug#41785] [PATCH v4] services: Add 'hurd-in-vm service-type'., Mathieu Othacehe, 2020/06/14