--- Begin Message ---
Subject: |
[PATCH] DRAFT services: Add 'hurd-in-vm service-type'. |
Date: |
Wed, 10 Jun 2020 10:54:41 +0200 |
TODO: Figure-out how to run this hurd VM inside a VM.
Using
--8<---------------cut here---------------start------------->8---
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.")))
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com
--- End Message ---
--- Begin Message ---
Subject: |
Re: [bug#41785] [PATCH v4] services: Add 'hurd-in-vm service-type'. |
Date: |
Sun, 14 Jun 2020 18:42:10 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) |
Mathieu Othacehe writes:
>> (define (hurd-multiboot-modules os)
>> ...
>> (libc (if target
>> (with-parameters ((%current-target-system #f))
>> ;; TODO: cross-libc has extra patches for the Hurd;
>> ;; remove in next rebuild cycle
>> (cross-libc target))
>> glibc))
>>
>> we take the ELSE branch here -- and that does not work. AIUI, this is
>> really a temporary kludge until the next rebuild cycle we can move some
>> hurd-specific glibc patches from cross-libc to glibc-proper.
>
> Oh, I know why! In "system-image", there are a few calls, in the first
> let, that are outside the "with-parameters", in particular "bootcfg"
> which triggers the problem you are describing above.
Ah, yes that makes sense.
> Maybe something as naive as:
>
> diff --git a/gnu/system/image.scm b/gnu/system/image.scm
[..]
> - (let* ((os (operating-system-for-image image))
[..]
> - (with-parameters ((%current-target-system target))
> + (with-parameters ((%current-target-system target))
> + (let* ((os (operating-system-for-image image))
>
> would do the trick.
It does!
> I went ahead and pushed a variant of this as
> c9f6e2e5bdff186583bdc360832b57f4c56e3427.
Woohoo! I remove the with-parameters in hurd-vm-disk-image and pushed
to master 5e9cf93364d87c70f8bfad915417cd75d21c0fed
Greetings,
Janneke
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com
--- End Message ---