From: "Jan (janneke) Nieuwenhuizen" <janneke@gnu.org>
To: 41961@debbugs.gnu.org
Cc: rekado@elephly.net
Subject: [bug#41961] [PATCH 1/1] services: childhurd: Support more than one instance.
Date: Sat, 20 Jun 2020 11:19:18 +0200 [thread overview]
Message-ID: <20200620091918.6868-1-janneke@gnu.org> (raw)
In-Reply-To: <20200620091656.6804-1-janneke@gnu.org>
* gnu/services/virtualization.scm (<hurd-vm-configuration>)[id,net-options]:
New fields.
(hurd-vm-net-options): New prodecure. Parameterize port forwarding with ID.
* gnu/services/virtualization.scm (hurd-vm-shepherd-service): Use them.
Parameterize provision with ID, if set.
* doc/guix.texi (Virtualization Services): Document new fields.
---
doc/guix.texi | 35 ++++++++++++++++++++--------
gnu/services/virtualization.scm | 41 +++++++++++++++++++++++++--------
2 files changed, 58 insertions(+), 18 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 2268e159a2..59f8a89387 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24728,12 +24728,31 @@ 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")})
+@item @code{options} (default: @code{'("--snapshot" "--hda")})
The extra options for running QEMU.
+
+@item @code{id} (default: @code{#f})
+If set, a non-zero positive integer used to parameterize Childhurd
+instances. It is appended to the service's name,
+e.g. @code{childhurd1}.
+
+@item @code{net-options} (default: @var{hurd-vm-net-options})
+The procedure used to produce the list of QEMU networking options.
+
+By default, it produces
+
+@lisp
+'("--device" "rtl8139,netdev=net0"
+ "--netdev" "user,id=net0\
+ ,hostfwd=tcp:127.0.0.1:<ssh-port>-:2222\
+ ,hostfwd=tcp:127.0.0.1:<vnc-port>-:5900")
+@end lisp
+with forwarded ports
+@example
+<ssh-port>: @code{(+ 10022 (* 1000 @var{ID}))}
+<vnc-port>: @code{(+ 15900 (* 1000 @var{ID}))}
+@end example
+
@end table
@end deftp
@@ -24745,10 +24764,8 @@ 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"))))
+ (image (const "/out/of/store/writable/hurd.img"))
+ (options '("--hda"))))
@end lisp
@node Version Control Services
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 4e96607680..e60d169791 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -51,6 +51,10 @@
#:export (%hurd-vm-operating-system
hurd-vm-configuration
+ hurd-vm-disk-image
+ hurd-vm-id
+ hurd-vm-net-options
+ hurd-vm-options
hurd-vm-service-type
libvirt-configuration
@@ -833,13 +837,13 @@ functionality of the kernel Linux.")))
(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"))))
+ `("--snapshot"
+ "--hda")))
+ (id hurd-vm-configuration-id ;#f or integer [1..]
+ (default #f))
+ (net-options hurd-vm-configuration-net-options ;list of string
+ (thunked)
+ (default (hurd-vm-net-options this-record))))
(define (hurd-vm-disk-image config)
"Return a disk-image for the Hurd according to CONFIG."
@@ -851,26 +855,45 @@ functionality of the kernel Linux.")))
(size disk-size)
(operating-system os)))))
+(define (hurd-vm-net-options config)
+ (let ((id (or (hurd-vm-configuration-id config) 0)))
+ (define (qemu-vm-port base)
+ (number->string (+ base (* 1000 id))))
+ `("--device" "rtl8139,netdev=net0"
+ "--netdev" ,(string-append
+ "user,id=net0"
+ ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 10022) "-:2222"
+ ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 15900) "-:5900"))))
+
(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)))
+ (options (hurd-vm-configuration-options config))
+ (id (hurd-vm-configuration-id config))
+ (net-options (hurd-vm-configuration-net-options config))
+ (provisions '(hurd-vm childhurd)))
(define vm-command
#~(list
(string-append #$qemu "/bin/qemu-system-i386")
#$@(if (file-exists? "/dev/kvm") '("--enable-kvm") '())
"-m" (number->string #$memory-size)
+ #$@net-options
#$@options
#+image))
(list
(shepherd-service
(documentation "Run the Hurd in a Virtual Machine: a Childhurd.")
- (provision '(hurd-vm childhurd))
+ (provision (if id
+ (map
+ (cute symbol-append <>
+ (string->symbol (number->string id)))
+ provisions)
+ provisions))
(requirement '(networking))
(start #~(make-forkexec-constructor #$vm-command))
(stop #~(make-kill-destructor))))))
--
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com
next prev parent reply other threads:[~2020-06-20 9:20 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-06-20 9:16 [bug#41961] [PATCH 0/1] services: childhurd: Support more than one instance Jan (janneke) Nieuwenhuizen
2020-06-20 9:19 ` Jan (janneke) Nieuwenhuizen [this message]
2020-06-21 8:37 ` [bug#41961] [PATCH 1/1] " Mathieu Othacehe
2020-06-21 9:06 ` Jan Nieuwenhuizen
2020-06-21 9:44 ` Mathieu Othacehe
2020-06-21 10:55 ` bug#41961: " Jan Nieuwenhuizen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200620091918.6868-1-janneke@gnu.org \
--to=janneke@gnu.org \
--cc=41961@debbugs.gnu.org \
--cc=rekado@elephly.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).