ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 05:39:41 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: childhurd: Support more than one instance.

Browse source 
* gnu/services/virtualization.scm (<hurd-vm-configuration>)[options]: Remove
"--hda" option.
[id,net-options]: New fields.
(hurd-vm-net-options): New procedure.  Parameterize port forwarding with ID.
* gnu/services/virtualization.scm (hurd-vm-shepherd-service): Use them.
Parameterize provision with ID, if set.  Hardcode "--hda" option for image.
* doc/guix.texi (Virtualization Services): Document new fields.  Update for
hardcoding of "--hda".
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-06-20 10:04:30 +02:00 committed by Jan Nieuwenhuizen
parent 512d23c65d
commit b7249aa472
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 58 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
doc/guix.texi
View file

@ -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")})
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

43
gnu/services/virtualization.scm
View file

@ -51,6 +51,10 @@ (define-module (gnu services virtualization)
#: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
@ -832,14 +836,12 @@ (define-record-type* <hurd-vm-configuration>
(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"))))
(default `("--snapshot")))
(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 +853,45 @@ (define (hurd-vm-disk-image config)
(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))
"--hda" #+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))))))