services: Add 'hurd-vm service-type'.
* gnu/services/virtualization.scm (hurd-vm-shepherd-service, hurd-vm-disk-image): New procedures. (%hurd-vm-operating-system, hurd-vm-service-type): New variables. (<hurd-vm-configuration>): New record type. * doc/guix.texi (Virtualization Services): Document it. * gnu/services/shepherd.scm (scm->go): Use let-system, remove FIXME. Fixes fixes cross-building of shepherd modules for the Hurd image.
This commit is contained in:
Jan (janneke) Nieuwenhuizen
Jan Nieuwenhuizen
parent
c9f6e2e5bd
commit
5e9cf93364
|
|
@ -24594,6 +24594,89 @@ 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-vm} provides support for running GNU/Hurd in a
|
||||
virtual machine (VM), a so-called ``Childhurd''. The virtual machine is
|
||||
a Shepherd service that can be controlled with commands such as:
|
||||
|
||||
@example
|
||||
herd start hurd-vm
|
||||
herd stop childhurd
|
||||
@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-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
|
||||
|
||||
Note that by default the VM image is volatile, i.e., once stopped the
|
||||
contents are lost. If you want a stateful image instead, override the
|
||||
configuration's @code{image} and @code{options} without
|
||||
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"))))
|
||||
@end lisp
|
||||
|
||||
@node Version Control Services
|
||||
@subsection Version Control Services
|
||||
|
||||
|
|
|
|||
|
|
@ -266,8 +266,7 @@ stored."
|
|||
(define (scm->go file)
|
||||
"Compile FILE, which contains code to be loaded by shepherd's config file,
|
||||
and return the resulting '.go' file."
|
||||
;; FIXME: %current-target-system may not be bound <https://bugs.gnu.org/29296>
|
||||
(let ((target (%current-target-system)))
|
||||
(let-system (system target)
|
||||
(with-extensions (list shepherd)
|
||||
(computed-file (string-append (basename (scheme-file-name file) ".scm")
|
||||
".go")
|
||||
|
|
|
|||
|
|
@ -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-vm-operating-system
|
||||
hurd-vm-configuration
|
||||
hurd-vm-service-type
|
||||
|
||||
libvirt-configuration
|
||||
libvirt-service-type
|
||||
virtlog-configuration
|
||||
virtlog-service-type
|
||||
|
|
@ -773,3 +791,95 @@ 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: a Childhurd.
|
||||
;;;
|
||||
|
||||
(define %hurd-vm-operating-system
|
||||
(operating-system
|
||||
(inherit %hurd-default-operating-system)
|
||||
(host-name "childhurd")
|
||||
(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-vm-configuration>
|
||||
hurd-vm-configuration make-hurd-vm-configuration
|
||||
hurd-vm-configuration?
|
||||
(os hurd-vm-configuration-os ;<operating-system>
|
||||
(default %hurd-vm-operating-system))
|
||||
(qemu hurd-vm-configuration-qemu ;<package>
|
||||
(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=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-vm-configuration-os config))
|
||||
(disk-size (hurd-vm-configuration-disk-size config)))
|
||||
(system-image
|
||||
(image
|
||||
(inherit hurd-disk-image)
|
||||
(size disk-size)
|
||||
(operating-system os)))))
|
||||
|
||||
(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)))
|
||||
|
||||
(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: a Childhurd.")
|
||||
(provision '(hurd-vm childhurd))
|
||||
(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.")))
|
||||
|
|
|
|||
Loading…
Reference in New Issue