From debbugs-submit-bounces@debbugs.gnu.org Thu Jun 11 17:57:33 2020 Received: (at 41785) by debbugs.gnu.org; 11 Jun 2020 21:57:33 +0000 Received: from localhost ([127.0.0.1]:38309 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjVCQ-00037c-0j for submit@debbugs.gnu.org; Thu, 11 Jun 2020 17:57:33 -0400 Received: from eggs.gnu.org ([209.51.188.92]:34298) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjVCI-00036q-Dw for 41785@debbugs.gnu.org; Thu, 11 Jun 2020 17:57:24 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:41898) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jjVCC-0005Kh-9R; Thu, 11 Jun 2020 17:57:12 -0400 Received: from [2001:980:1b4f:1:42d2:832d:bb59:862] (port=59488 helo=dundal.peder.onsbrabantnet.nl) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jjVC9-0002Jn-9e; Thu, 11 Jun 2020 17:57:10 -0400 From: Jan Nieuwenhuizen To: Ludovic =?utf-8?Q?Court=C3=A8s?= Subject: Re: [bug#41785] [PATCH] DRAFT services: Add 'hurd-in-vm service-type'. Organization: AvatarAcademy.nl References: <20200610085441.890-1-janneke@gnu.org> <87eeql9xvt.fsf@gnu.org> X-Url: http://AvatarAcademy.nl Date: Thu, 11 Jun 2020 23:57:06 +0200 In-Reply-To: <87eeql9xvt.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Thu, 11 Jun 2020 21:59:50 +0200") Message-ID: <87wo4d2rm5.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 41785 Cc: Mathieu Othacehe , 41785@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s writes: Hello, > That was fast! :-) Yeah...we need this, right ;) > "Jan (janneke) Nieuwenhuizen" 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=3Dnet0 \ >> --netdev user,id=3Dnet0,hostfwd=3Dtcp:127.0.0.1:10022-:2222,hostfw= d=3Dtcp:127.0.0.1:5900-:5900 >> >> nicely starts a bare-bones VM with the the hurd-in-vm service inside, bu= t I >> cannot seem to connect to the Hurd VM it in any way. Appending >> ",hostfwd=3Dtcp: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-servi= ce, >> hurd-vm-disk-image): New procedures. >> (%hurd-in-vm-operating-system, hurd-in-vm-service-type): New variable. >> (): New record type. >> * doc/guix.texi (Virtualization Services): Document it. > > [=E2=80=A6] > >> +@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. > > =E2=80=9C=E2=80=A6 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.=E2= =80=9D Nice, thanks! > Nitpick: I=E2=80=99d call it =E2=80=9Churd-vm=E2=80=9D, because it runs a= Hurd VM. :-) Done! > It=E2=80=99s a volatile VM, due to the use of =E2=80=98-snapshot=E2=80=99= , 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 =E2=80=9Csub-Hurds=E2=80=9D=C2=B9 and =E2=80=9Cnei= ghborhurds=E2=80=9D=C2=B2. I wonder if > it=E2=80=99s our duty to coin another term=E2=80=A6 a guesthurd? a visith= urd?) > > =C2=B9 https://www.gnu.org/software/hurd/hurd/subhurd.html > =C2=B2 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 =E2=80=98build-deriva= tions=E2=80=99 > explicitly, the only exception so far being the graft implementation. > > So you can drop =E2=80=98with-store=E2=80=99 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 =E2=80=98find-image=E2=80=99 non-monadic? It really= shouldn=E2=80=99t be > because it doesn=E2=80=99t interact with the store. It can take an optio= nal > =E2=80=98system=E2=80=99 parameter if we want. It seems that "just works". I've made that change in a separate patch (attached). > So, assuming =E2=80=98find-image=E2=80=99 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 #) In ice-9/boot-9.scm: 718:2 2 (call-with-prompt _ _ #) In ice-9/eval.scm: 619:8 1 (_ #(#(#))) 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: #< bindings: ((#< 7f4ce7c23740 proc: #> #)) thunk: #> --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=E2=80= =99t > belong here. So I=E2=80=99d just leave it out. There=E2=80=99s already > =E2=80=98%hurd-default-operating-system=E2=80=99 that does the heavy lift= ing 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 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=v2-0001-image-Make-find-image-non-monadic.patch Content-Transfer-Encoding: quoted-printable From b01b8d2a46a6a04cb8f09d74c06cbbc82878f070 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" 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 =C2=A9 2020 Mathieu Othacehe +;;; Copyright =C2=A9 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; 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 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)))))) =20 ;;; 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 =C2=A9 2017, 2019 Tobias Geerinckx-Rice ;;; Copyright =C2=A9 2020 Mathieu Othacehe ;;; Copyright =C2=A9 2020 Danny Milosavljevic +;;; Copyright =C2=A9 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; 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-ty= pe)) + (base-image -> (find-image + installation-disk-image-file-system= -type)) =20 ;; Since the installation system has no network acc= ess, ;; 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 =C2=A9 2017, 2019 Mathieu Othacehe ;;; Copyright =C2=A9 2018 Ricardo Wurmus ;;; Copyright =C2=A9 2019 Christopher Baines +;;; Copyright =C2=A9 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -801,7 +802,7 @@ static checks." (check-initrd-modules os))) =20 (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-sy= stem-type #:image-size image-size --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.com --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=v2-0002-services-Add-hurd-vm-service-type.patch Content-Transfer-Encoding: quoted-printable From e5bdf050f628cc7ea1b6bc4ccdcfeb757429820f Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" 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. (): 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 =20 + +@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= =3Dnet0"} @ + @code{"--netdev"} @ + @code{"user,id=3Dnet0,hostfwd=3Dtcp:127.0.0.1:20022-:2222,hostfwd=3D= 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 =20 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 =C2=A9 2017 Ryan Moe ;;; Copyright =C2=A9 2018 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,24 +19,40 @@ ;;; along with GNU Guix. If not, see . =20 (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) =20 - #: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 make-hurd-vm-configuration + hurd-vm-configuration? + (os hurd-vm-configuration-os ; + (default %hurd-default-operating-system)) + (qemu hurd-vm-configuration-qemu ; + (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=3Dnet0" + "--netdev" (string-append + "user,id=3Dnet0" + ",hostfwd=3Dtcp:127.0.0.1:20022-:2222" + ",hostfwd=3Dtcp: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 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) =20 +(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))) --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.com --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.com --=-=-=--