summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJan (janneke) Nieuwenhuizen <janneke@gnu.org>2020-06-20 10:04:30 +0200
committerJan Nieuwenhuizen <janneke@gnu.org>2020-06-21 12:51:36 +0200
commitb7249aa4726193653e05e694ec4bb311aa4ec6c2 (patch)
tree105949f2685e603b97edef5d82c764bf175e03bc
parentgnu: Add poke. (diff)
downloadguix-b7249aa4726193653e05e694ec4bb311aa4ec6c2.tar.gz
guix-b7249aa4726193653e05e694ec4bb311aa4ec6c2.tar.bz2
guix-b7249aa4726193653e05e694ec4bb311aa4ec6c2.tar.xz
services: childhurd: Support more than one instance.
* 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".
-rw-r--r--doc/guix.texi35
-rw-r--r--gnu/services/virtualization.scm43
2 files changed, 58 insertions, 20 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 2268e15..5b854cc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24728,12 +24728,31 @@ The size of the disk image.
24728@item @code{memory-size} (default: @code{512}) 24728@item @code{memory-size} (default: @code{512})
24729The memory size of the Virtual Machine in mebibytes. 24729The memory size of the Virtual Machine in mebibytes.
24730 24730
24731@item @code{options} (default: @code{'("--device"} @code{"rtl8139,netdev=net0"} @ 24731@item @code{options} (default: @code{'("--snapshot")})
24732 @code{"--netdev"} @
24733 @code{"user,id=net0,hostfwd=tcp:127.0.0.1:20022-:2222,hostfwd=tcp:127.0.0.1:25900-:5900"} @
24734 @code{"--snapshot"} @
24735 @code{"--hda")})
24736The extra options for running QEMU. 24732The extra options for running QEMU.
24733
24734@item @code{id} (default: @code{#f})
24735If set, a non-zero positive integer used to parameterize Childhurd
24736instances. It is appended to the service's name,
24737e.g. @code{childhurd1}.
24738
24739@item @code{net-options} (default: @var{hurd-vm-net-options})
24740The procedure used to produce the list of QEMU networking options.
24741
24742By default, it produces
24743
24744@lisp
24745'("--device" "rtl8139,netdev=net0"
24746 "--netdev" "user,id=net0\
24747 ,hostfwd=tcp:127.0.0.1:<ssh-port>-:2222\
24748 ,hostfwd=tcp:127.0.0.1:<vnc-port>-:5900")
24749@end lisp
24750with forwarded ports
24751@example
24752<ssh-port>: @code{(+ 10022 (* 1000 @var{ID}))}
24753<vnc-port>: @code{(+ 15900 (* 1000 @var{ID}))}
24754@end example
24755
24737@end table 24756@end table
24738@end deftp 24757@end deftp
24739 24758
@@ -24745,10 +24764,8 @@ the @code{--snapshot} flag using something along these lines:
24745@lisp 24764@lisp
24746(service hurd-vm-service-type 24765(service hurd-vm-service-type
24747 (hurd-vm-configuration 24766 (hurd-vm-configuration
24748 (image (const "/out/of/store/writable/hurd.img")) 24767 (image (const "/out/of/store/writable/hurd.img"))
24749 (options '("--device" "rtl8139,netdev=net0" 24768 (options '("--hda"))))
24750 "--netdev"
24751 "user,id=net0,hostfwd=tcp:127.0.0.1:20022-:2222"))))
24752@end lisp 24769@end lisp
24753 24770
24754@node Version Control Services 24771@node Version Control Services
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 4e96607..1a15ffb 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -51,6 +51,10 @@
51 51
52 #:export (%hurd-vm-operating-system 52 #:export (%hurd-vm-operating-system
53 hurd-vm-configuration 53 hurd-vm-configuration
54 hurd-vm-disk-image
55 hurd-vm-id
56 hurd-vm-net-options
57 hurd-vm-options
54 hurd-vm-service-type 58 hurd-vm-service-type
55 59
56 libvirt-configuration 60 libvirt-configuration
@@ -832,14 +836,12 @@ functionality of the kernel Linux.")))
832 (memory-size hurd-vm-configuration-memory-size ;number 836 (memory-size hurd-vm-configuration-memory-size ;number
833 (default 512)) 837 (default 512))
834 (options hurd-vm-configuration-options ;list of string 838 (options hurd-vm-configuration-options ;list of string
835 (default 839 (default `("--snapshot")))
836 `("--device" "rtl8139,netdev=net0" 840 (id hurd-vm-configuration-id ;#f or integer [1..]
837 "--netdev" ,(string-append 841 (default #f))
838 "user,id=net0" 842 (net-options hurd-vm-configuration-net-options ;list of string
839 ",hostfwd=tcp:127.0.0.1:20022-:2222" 843 (thunked)
840 ",hostfwd=tcp:127.0.0.1:25900-:5900") 844 (default (hurd-vm-net-options this-record))))
841 "--snapshot"
842 "--hda"))))
843 845
844(define (hurd-vm-disk-image config) 846(define (hurd-vm-disk-image config)
845 "Return a disk-image for the Hurd according to CONFIG." 847 "Return a disk-image for the Hurd according to CONFIG."
@@ -851,26 +853,45 @@ functionality of the kernel Linux.")))
851 (size disk-size) 853 (size disk-size)
852 (operating-system os))))) 854 (operating-system os)))))
853 855
856(define (hurd-vm-net-options config)
857 (let ((id (or (hurd-vm-configuration-id config) 0)))
858 (define (qemu-vm-port base)
859 (number->string (+ base (* 1000 id))))
860 `("--device" "rtl8139,netdev=net0"
861 "--netdev" ,(string-append
862 "user,id=net0"
863 ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 10022) "-:2222"
864 ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 15900) "-:5900"))))
865
854(define (hurd-vm-shepherd-service config) 866(define (hurd-vm-shepherd-service config)
855 "Return a <shepherd-service> for a Hurd in a Virtual Machine with CONFIG." 867 "Return a <shepherd-service> for a Hurd in a Virtual Machine with CONFIG."
856 868
857 (let ((image (hurd-vm-configuration-image config)) 869 (let ((image (hurd-vm-configuration-image config))
858 (qemu (hurd-vm-configuration-qemu config)) 870 (qemu (hurd-vm-configuration-qemu config))
859 (memory-size (hurd-vm-configuration-memory-size config)) 871 (memory-size (hurd-vm-configuration-memory-size config))
860 (options (hurd-vm-configuration-options config))) 872 (options (hurd-vm-configuration-options config))
873 (id (hurd-vm-configuration-id config))
874 (net-options (hurd-vm-configuration-net-options config))
875 (provisions '(hurd-vm childhurd)))
861 876
862 (define vm-command 877 (define vm-command
863 #~(list 878 #~(list
864 (string-append #$qemu "/bin/qemu-system-i386") 879 (string-append #$qemu "/bin/qemu-system-i386")
865 #$@(if (file-exists? "/dev/kvm") '("--enable-kvm") '()) 880 #$@(if (file-exists? "/dev/kvm") '("--enable-kvm") '())
866 "-m" (number->string #$memory-size) 881 "-m" (number->string #$memory-size)
882 #$@net-options
867 #$@options 883 #$@options
868 #+image)) 884 "--hda" #+image))
869 885
870 (list 886 (list
871 (shepherd-service 887 (shepherd-service
872 (documentation "Run the Hurd in a Virtual Machine: a Childhurd.") 888 (documentation "Run the Hurd in a Virtual Machine: a Childhurd.")
873 (provision '(hurd-vm childhurd)) 889 (provision (if id
890 (map
891 (cute symbol-append <>
892 (string->symbol (number->string id)))
893 provisions)
894 provisions))
874 (requirement '(networking)) 895 (requirement '(networking))
875 (start #~(make-forkexec-constructor #$vm-command)) 896 (start #~(make-forkexec-constructor #$vm-command))
876 (stop #~(make-kill-destructor)))))) 897 (stop #~(make-kill-destructor))))))