[bug#27887] [PATCH] services: Add libvirt services

[Christopher Baines]

On Mon, 31 Jul 2017 11:13:08 -0700
Ryan Moe <address@hidden> wrote:

> * gnu/services/virtualization.scm: New file.
> * doc/guix.texi (Virtualization Services): Document it.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> ---
>  doc/guix.texi                   | 709
> ++++++++++++++++++++++++++++++++++++++++
> gnu/local.mk                    |   1 +
> gnu/services/virtualization.scm | 495 ++++++++++++++++++++++++++++ 3
> files changed, 1205 insertions(+) create mode 100644
> gnu/services/virtualization.scm

Awesome stuff Ryan, I'm not that knowledgeable on libvirt, but this
looks like a well put together patch.

> diff --git a/doc/guix.texi b/doc/guix.texi
> index 932b118f7..94b660ac6 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -226,6 +226,7 @@ Services
>  * Network File System::         NFS related services.
>  * Continuous Integration::      The Cuirass service.
>  * Power management Services::   The TLP tool.
> +* Virtualization Services::     Virtualization services.
>  * Miscellaneous Services::      Other services.
>  
>  Defining Services
> @@ -9018,6 +9019,7 @@ declaration.
>  * Network File System::         NFS related services.
>  * Continuous Integration::      The Cuirass service.
>  * Power management Services::   The TLP tool.
> +* Virtualization Services::     Virtualization services.
>  * Miscellaneous Services::      Other services.
>  @end menu
>  
> @@ -15388,6 +15390,713 @@ Package object of thermald.
>  @end deftp
>  
>  
> address@hidden Virtualization Services
> address@hidden Virtualization services
> +The @code{(gnu services virtualization)} module provides services for
> +the libvirt and virtlog daemons.
> +
> address@hidden Libvirt daemon
> address@hidden is the server side daemon component of the libvirt
> +virtualization management system. This daemon runs on host servers
> +and performs required management tasks for virtualized guests.
> +
> address@hidden {Scheme Variable} libvirt-service-type
> +This is the type of the @uref{https://libvirt.org, libvirt daemon}.
> +Its value must be a @code{libvirt-configuration}.
> +
> address@hidden
> +(service libvirt-service-type
> +         (libvirt-configuration
> +          (unix-sock-group "libvirt")
> +          (tls-port "16555")))
> address@hidden example
> address@hidden deffn
> +
> address@hidden Auto-generated with (generate-libvirt-documentation)
> +Available @code{libvirt-configuration} fields are:
> +
> address@hidden address@hidden parameter} package libvirt
> +Libvirt package.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} boolean
> listen-tls? +Flag listening for secure TLS connections on the public
> TCP/IP port. +must set @code{listen} for this to have any effect.
> +
> +It is necessary to setup a CA and issue server certificates before
> using +this capability.
> +
> +Defaults to @samp{#t}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} boolean
> listen-tcp? +Listen for unencrypted TCP connections on the public
> TCP/IP port.  must +set @code{listen} for this to have any effect.
> +
> +Using the TCP socket requires SASL authentication by default.  Only
> SASL +mechanisms which support data encryption are allowed.  This is
> +DIGEST_MD5 and GSSAPI (Kerberos5)
> +
> +Defaults to @samp{#f}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string tls-port
> +Port for accepting secure TLS connections This can be a port number,
> or +service name
> +
> +Defaults to @samp{"16514"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string tcp-port
> +Port for accepting insecure TCP connections This can be a port
> number, +or service name
> +
> +Defaults to @samp{"16509"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> listen-addr +IP address or hostname used for client connections.
> +
> +Defaults to @samp{"0.0.0.0"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} boolean mdns-adv?
> +Flag toggling mDNS advertisement of the libvirt service.
> +
> +Alternatively can disable for all services on a host by stopping the
> +Avahi daemon.
> +
> +Defaults to @samp{#f}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string mdns-name
> +Default mDNS advertisement name.  This must be unique on the
> immediate +broadcast network.
> +
> +Defaults to @samp{"Virtualization Host <hostname>"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> unix-sock-group +UNIX domain socket group ownership.  This can be
> used to allow a +'trusted' set of users access to management
> capabilities without +becoming root.
> +
> +Defaults to @samp{"root"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> unix-sock-ro-perms +UNIX socket permissions for the R/O socket.  This
> is used for monitoring +VM status only.
> +
> +Defaults to @samp{"0777"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> unix-sock-rw-perms +UNIX socket permissions for the R/W socket.
> Default allows only root. +If PolicyKit is enabled on the socket, the
> default will change to allow +everyone (eg, 0777)
> +
> +Defaults to @samp{"0770"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> unix-sock-admin-perms +UNIX socket permissions for the admin socket.
> Default allows only owner +(root), do not change it unless you are
> sure to whom you are exposing +the access to.
> +
> +Defaults to @samp{"0777"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> unix-sock-dir +The directory in which sockets will be found/created.
> +
> +Defaults to @samp{"/var/run/libvirt"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> auth-unix-ro +Authentication scheme for UNIX read-only sockets.  By
> default socket +permissions allow anyone to connect
> +
> +Defaults to @samp{"polkit"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> auth-unix-rw +Authentication scheme for UNIX read-write sockets.  By
> default socket +permissions only allow root.  If PolicyKit support
> was compiled into +libvirt, the default will be to use 'polkit' auth.
> +
> +Defaults to @samp{"polkit"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string auth-tcp
> +Authentication scheme for TCP sockets.  If you don't enable SASL,
> then +all TCP traffic is cleartext.  Don't do this outside of a
> dev/test +scenario.
> +
> +Defaults to @samp{"sasl"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string auth-tls
> +Authentication scheme for TLS sockets.  TLS sockets already have
> +encryption provided by the TLS layer, and limited authentication is
> done +by certificates.
> +
> +It is possible to make use of any SASL authentication mechanism as
> well, +by using 'sasl' for this option
> +
> +Defaults to @samp{"none"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} optional-list
> access-drivers +API access control scheme.
> +
> +By default an authenticated user is allowed access to all APIs.
> Access +drivers can place restrictions on this.
> +
> +Defaults to @samp{()}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string key-file
> +Server key file path.  If set to an empty string, then no private
> key is +loaded.
> +
> +Defaults to @samp{""}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string cert-file
> +Server key file path.  If set to an empty string, then no
> certificate is +loaded.
> +
> +Defaults to @samp{""}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string ca-file
> +Server key file path.  If set to an empty string, then no CA
> certificate +is loaded.
> +
> +Defaults to @samp{""}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string crl-file
> +Certificate revocation list path.  If set to an empty string, then no
> +CRL is loaded.
> +
> +Defaults to @samp{""}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} boolean
> tls-no-sanity-cert +Disable verification of our own server
> certificates. +
> +When libvirtd starts it performs some sanity checks against its own
> +certificates.
> +
> +Defaults to @samp{#f}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} boolean
> tls-no-verify-cert +Disable verification of client certificates.
> +
> +Client certificate verification is the primary authentication
> mechanism. +Any client which does not present a certificate signed by
> the CA will be +rejected.
> +
> +Defaults to @samp{#f}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} optional-list
> tls-allowed-dn-list +Whitelist of allowed x509 Distinguished Name.
> +
> +Defaults to @samp{()}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} optional-list
> sasl-allowed-usernames +Whitelist of allowed SASL usernames.  The
> format for username depends on +the SASL authentication mechanism.
> +
> +Defaults to @samp{()}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> tls-priority +Override the compile time default TLS priority string.
> The default is +usually "NORMAL" unless overridden at build time.
> Only set this is it +is desired for libvirt to deviate from the
> global default settings. +
> +Defaults to @samp{"NORMAL"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-clients +Maximum number of concurrent client connections to allow
> over all +sockets combined.
> +
> +Defaults to @samp{5000}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-queued-clients +Maximum length of queue of connections waiting to
> be accepted by the +daemon.  Note, that some protocols supporting
> retransmission may obey +this so that a later reattempt at connection
> succeeds. +
> +Defaults to @samp{1000}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-anonymous-clients +Maximum length of queue of accepted but not
> yet authenticated clients. +Set this to zero to turn this feature off
> +
> +Defaults to @samp{20}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> min-workers +Number of workers to start up initially.
> +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-workers +Maximum number of worker threads.
> +
> +If the number of active clients exceeds @code{min-workers}, then more
> +threads are spawned, up to max_workers limit.  Typically you'd want
> +max_workers to equal maximum number of clients allowed.
> +
> +Defaults to @samp{20}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> prio-workers +Number of priority workers.  If all workers from above
> pool are stuck, +some calls marked as high priority (notably
> domainDestroy) can be +executed in this pool.
> +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-requests +Total global limit on concurrent RPC calls.
> +
> +Defaults to @samp{20}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-client-requests +Limit on concurrent requests from a single
> client connection.  To avoid +one client monopolizing the server this
> should be a small fraction of +the global max_requests and
> max_workers parameter. +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> admin-min-workers +Same as @code{min-workers} but for the admin
> interface. +
> +Defaults to @samp{1}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> admin-max-workers +Same as @code{max-workers} but for the admin
> interface. +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> admin-max-clients +Same as @code{max-clients} but for the admin
> interface. +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> admin-max-queued-clients +Same as @code{max-queued-clients} but for
> the admin interface. +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> admin-max-client-requests +Same as @code{max-client-requests} but for
> the admin interface. +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer log-level
> +Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
> +
> +Defaults to @samp{3}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> log-filters +Logging filters.
> +
> +A filter allows to select a different logging level for a given
> category +of logs The format for a filter is one of:
> +
> address@hidden @bullet
> address@hidden
> +x:name
> +
> address@hidden
> +x:+name
> +
> address@hidden itemize
> +
> +where @code{name} is a string which is matched against the category
> +given in the @code{VIR_LOG_INIT()} at the top of each libvirt source
> +file, e.g., "remote", "qemu", or "util.json" (the name in the filter
> can +be a substring of the full category name, in order to match
> multiple +similar categories), the optional "+" prefix tells libvirt
> to log stack +trace for each message matching name, and @code{x} is
> the minimal level +where matching messages should be logged:
> +
> address@hidden @bullet
> address@hidden
> +1: DEBUG
> +
> address@hidden
> +2: INFO
> +
> address@hidden
> +3: WARNING
> +
> address@hidden
> +4: ERROR
> +
> address@hidden itemize
> +
> +Multiple filters can be defined in a single filters statement, they
> just +need to be separated by spaces.
> +
> +Defaults to @samp{"3:remote 4:event"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> log-outputs +Logging outputs.
> +
> +An output is one of the places to save logging information The format
> +for an output can be:
> +
> address@hidden @code
> address@hidden x:stderr
> +output goes to stderr
> +
> address@hidden x:syslog:name
> +use syslog for the output and use the given name as the ident
> +
> address@hidden x:file:file_path
> +output to a file, with the given filepath
> +
> address@hidden x:journald
> +output to journald logging system
> +
> address@hidden table
> +
> +In all case the x prefix is the minimal level, acting as a filter
> +
> address@hidden @bullet
> address@hidden
> +1: DEBUG
> +
> address@hidden
> +2: INFO
> +
> address@hidden
> +3: WARNING
> +
> address@hidden
> +4: ERROR
> +
> address@hidden itemize
> +
> +Multiple outputs can be defined, they just need to be separated by
> +spaces.
> +
> +Defaults to @samp{"3:stderr"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> audit-level +Allows usage of the auditing subsystem to be altered
> +
> address@hidden @bullet
> address@hidden
> +0: disable all auditing
> +
> address@hidden
> +1: enable auditing, only if enabled on host
> +
> address@hidden
> +2: enable auditing, and exit if disabled on host.
> +
> address@hidden itemize
> +
> +Defaults to @samp{1}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} boolean
> audit-logging +Send audit messages via libvirt logging infrastructure.
> +
> +Defaults to @samp{#f}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} optional-string
> host-uuid +Host UUID.  UUID must not have all digits be the same.
> +
> +Defaults to @samp{""}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> host-uuid-source +Source to read host UUID.
> +
> address@hidden @bullet
> address@hidden
> address@hidden: fetch the UUID from @code{dmidecode -s system-uuid}
> +
> address@hidden
> address@hidden: fetch the UUID from @code{/etc/machine-id}
> +
> address@hidden itemize
> +
> +If @code{dmidecode} does not provide a valid UUID a temporary UUID
> will +be generated.
> +
> +Defaults to @samp{"smbios"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> keepalive-interval +A keepalive message is sent to a client after
> @code{keepalive_interval} +seconds of inactivity to check if the
> client is still responding.  If +set to -1, libvirtd will never send
> keepalive requests; however clients +can still send them and the
> daemon will send responses. +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> keepalive-count +Maximum number of keepalive messages that are
> allowed to be sent to the +client without getting any response before
> the connection is considered +broken.
> +
> +In other words, the connection is automatically closed approximately
> +after @code{keepalive_interval * (keepalive_count + 1)} seconds since
> +the last message received from the client.  When
> @code{keepalive-count} +is set to 0, connections will be
> automatically closed after address@hidden seconds of
> inactivity without sending any +keepalive messages.
> +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> admin-keepalive-interval +Same as above but for admin interface.
> +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> admin-keepalive-count +Same as above but for admin interface.
> +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> ovs-timeout +Timeout for Open vSwitch calls.
> +
> +The @code{ovs-vsctl} utility is used for the configuration and its
> +timeout option is set by default to 5 seconds to avoid potential
> +infinite waits blocking libvirt.
> +
> +Defaults to @samp{5}.
> +
> address@hidden deftypevr
> +
> address@hidden %end of autogenerated docs
> +
> address@hidden Virtlog daemon
> +The virtlogd service is a server side daemon component of libvirt
> that is +used to manage logs from virtual machine consoles.
> +
> +This daemon is not used directly by libvirt client applications,
> rather it +is called on their behalf by @code{libvirtd}. By
> maintaining the logs in a +standalone daemon, the main
> @code{libvirtd} daemon can be restarted without +risk of losing logs.
> The @code{virtlogd} daemon has the ability to re-exec() +itself upon
> receiving @code{SIGUSR1}, to allow live upgrades without downtime. +
> address@hidden {Scheme Variable} virtlog-service-type
> +This is the type of the virtlog daemon.
> +Its value must be a @code{virtlog-configuration}.
> +
> address@hidden
> +(service virtlog-service-type
> +         (virtlog-configuration
> +          (max-clients 1000)))
> address@hidden example
> address@hidden deffn
> +
> address@hidden address@hidden parameter} integer log-level
> +Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
> +
> +Defaults to @samp{3}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> log-filters +Logging filters.
> +
> +A filter allows to select a different logging level for a given
> category +of logs The format for a filter is one of:
> +
> address@hidden @bullet
> address@hidden
> +x:name
> +
> address@hidden
> +x:+name
> +
> address@hidden itemize
> +
> +where @code{name} is a string which is matched against the category
> +given in the @code{VIR_LOG_INIT()} at the top of each libvirt source
> +file, e.g., "remote", "qemu", or "util.json" (the name in the filter
> can +be a substring of the full category name, in order to match
> multiple +similar categories), the optional "+" prefix tells libvirt
> to log stack +trace for each message matching name, and @code{x} is
> the minimal level +where matching messages should be logged:
> +
> address@hidden @bullet
> address@hidden
> +1: DEBUG
> +
> address@hidden
> +2: INFO
> +
> address@hidden
> +3: WARNING
> +
> address@hidden
> +4: ERROR
> +
> address@hidden itemize
> +
> +Multiple filters can be defined in a single filters statement, they
> just +need to be separated by spaces.
> +
> +Defaults to @samp{"3:remote 4:event"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} string
> log-outputs +Logging outputs.
> +
> +An output is one of the places to save logging information The format
> +for an output can be:
> +
> address@hidden @code
> address@hidden x:stderr
> +output goes to stderr
> +
> address@hidden x:syslog:name
> +use syslog for the output and use the given name as the ident
> +
> address@hidden x:file:file_path
> +output to a file, with the given filepath
> +
> address@hidden x:journald
> +output to journald logging system
> +
> address@hidden table
> +
> +In all case the x prefix is the minimal level, acting as a filter
> +
> address@hidden @bullet
> address@hidden
> +1: DEBUG
> +
> address@hidden
> +2: INFO
> +
> address@hidden
> +3: WARNING
> +
> address@hidden
> +4: ERROR
> +
> address@hidden itemize
> +
> +Multiple outputs can be defined, they just need to be separated by
> +spaces.
> +
> +Defaults to @samp{"3:stderr"}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-clients +Maximum number of concurrent client connections to allow
> over all +sockets combined.
> +
> +Defaults to @samp{1024}.
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer max-size
> +Maximum file size before rolling over.
> +
> +Defaults to @samp{2MB}
> +
> address@hidden deftypevr
> +
> address@hidden address@hidden parameter} integer
> max-backups +Maximum number of backup files to keep.
> +
> +Defaults to @samp{3}
> +
> address@hidden deftypevr
> +
> +
>  @node Miscellaneous Services
>  @subsubsection Miscellaneous Services
>  
> diff --git a/gnu/local.mk b/gnu/local.mk
> index f5255feff..95c4a8b1d 100644
> --- a/gnu/local.mk
> +++ b/gnu/local.mk
> @@ -437,6 +437,7 @@ GNU_SYSTEM_MODULES
> =                             \
> %D%/services/dns.scm                          \
> %D%/services/kerberos.scm                     \
> %D%/services/lirc.scm                         \
> +  %D%/services/virtualization.scm            \
>    %D%/services/mail.scm                              \
>    %D%/services/mcron.scm                     \
>    %D%/services/messaging.scm                 \
> diff --git a/gnu/services/virtualization.scm
> b/gnu/services/virtualization.scm new file mode 100644
> index 000000000..58d04edcf
> --- /dev/null
> +++ b/gnu/services/virtualization.scm
> @@ -0,0 +1,495 @@
> +;;; GNU Guix --- Functional package management for GNU
> +;;; Copyright © 2017 Ryan Moe <address@hidden>
> +;;;
> +;;; This file is part of GNU Guix.
> +;;;
> +;;; GNU Guix is free software; you can redistribute it and/or modify
> it +;;; under the terms of the GNU General Public License as
> published by +;;; the Free Software Foundation; either version 3 of
> the License, or (at +;;; your option) any later version.
> +;;;
> +;;; GNU Guix is distributed in the hope that it will be useful, but
> +;;; WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; 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 services base)
> +  #:use-module (gnu services dbus)
> +  #:use-module (gnu services shepherd)
> +  #:use-module (gnu system shadow)
> +  #:use-module (gnu packages admin)
> +  #:use-module (gnu packages virtualization)
> +  #:use-module (guix records)
> +  #:use-module (guix gexp)
> +  #:use-module (guix packages)
> +  #:use-module (ice-9 match)
> +
> +  #:export (libvirt-configuration
> +            libvirt-service-type
> +            virtlog-service-type))
> +
> +(define (uglify-field-name field-name)
> +  (let ((str (symbol->string field-name)))
> +    (string-join
> +     (string-split (string-delete #\? str) #\-)
> +     "_")))
> +
> +(define (quote-val val)
> +  (string-append "\"" val "\""))
> +
> +(define (serialize-field field-name val)
> +  (format #t "~a = ~a\n" (uglify-field-name field-name) val))
> +
> +(define (serialize-string field-name val)
> +  (serialize-field field-name (quote-val val)))
> +
> +(define (serialize-boolean field-name val)
> +  (serialize-field field-name (if val 1 0)))
> +
> +(define (serialize-integer field-name val)
> +  (serialize-field field-name val))
> +
> +(define (build-opt-list val)
> +  (string-append
> +   "["
> +   (string-join (map quote-val val) ",")
> +   "]"))
> +
> +(define optional-list? list?)
> +(define optional-string? string?)
> +
> +(define (serialize-list field-name val)
> +  (serialize-field field-name (build-opt-list val)))
> +
> +(define (serialize-optional-list field-name val)
> +  (if (null? val)
> +      (format #t "# ~a = []\n" (uglify-field-name field-name))
> +      (serialize-list field-name val)))
> +
> +(define (serialize-optional-string field-name val)
> +  (if (string-null? val)
> +      (format #t "# ~a = \"\"\n" (uglify-field-name field-name))
> +      (serialize-string field-name val)))
> +
> +(define-configuration libvirt-configuration
> +  (libvirt
> +   (package libvirt)
> +   "Libvirt package.")
> +  (listen-tls?
> +   (boolean #t)
> +   "Flag listening for secure TLS connections on the public TCP/IP
> port. +must set @code{listen} for this to have any effect.
> +
> +It is necessary to setup a CA and issue server certificates before
> +using this capability.")
> +  (listen-tcp?
> +   (boolean #f)
> +   "Listen for unencrypted TCP connections on the public TCP/IP port.
> +must set @code{listen} for this to have any effect.
> +
> +Using the TCP socket requires SASL authentication by default. Only
> +SASL mechanisms which support data encryption are allowed. This is
> +DIGEST_MD5 and GSSAPI (Kerberos5)")
> +  (tls-port
> +   (string "16514")
> +   "Port for accepting secure TLS connections This can be a port
> number, +or service name")
> +  (tcp-port
> +   (string "16509")
> +   "Port for accepting insecure TCP connections This can be a port
> number, +or service name")
> +  (listen-addr
> +   (string "0.0.0.0")
> +   "IP address or hostname used for client connections.")
> +  (mdns-adv?
> +   (boolean #f)
> +   "Flag toggling mDNS advertisement of the libvirt service.
> +
> +Alternatively can disable for all services on a host by
> +stopping the Avahi daemon.")
> +  (mdns-name
> +   (string (string-append "Virtualization Host " (gethostname)))
> +   "Default mDNS advertisement name. This must be unique on the
> +immediate broadcast network.")
> +  (unix-sock-group
> +   (string "root")
> +   "UNIX domain socket group ownership. This can be used to
> +allow a 'trusted' set of users access to management capabilities
> +without becoming root.")
> +  (unix-sock-ro-perms
> +   (string "0777")
> +   "UNIX socket permissions for the R/O socket. This is used
> +for monitoring VM status only.")
> +  (unix-sock-rw-perms
> +   (string "0770")
> +   "UNIX socket permissions for the R/W socket. Default allows
> +only root. If PolicyKit is enabled on the socket, the default
> +will change to allow everyone (eg, 0777)")
> +  (unix-sock-admin-perms
> +   (string "0777")
> +   "UNIX socket permissions for the admin socket. Default allows
> +only owner (root), do not change it unless you are sure to whom
> +you are exposing the access to.")
> +  (unix-sock-dir
> +   (string "/var/run/libvirt")
> +   "The directory in which sockets will be found/created.")
> +  (auth-unix-ro
> +   (string "polkit")
> +   "Authentication scheme for UNIX read-only sockets. By default
> +socket permissions allow anyone to connect")
> +  (auth-unix-rw
> +   (string "polkit")
> +   "Authentication scheme for UNIX read-write sockets. By default
> +socket permissions only allow root. If PolicyKit support was compiled
> +into libvirt, the default will be to use 'polkit' auth.")
> +  (auth-tcp
> +   (string "sasl")
> +   "Authentication scheme for TCP sockets. If you don't enable SASL,
> +then all TCP traffic is cleartext. Don't do this outside of a
> dev/test +scenario.")
> +  (auth-tls
> +   (string "none")
> +   "Authentication scheme for TLS sockets. TLS sockets already have
> +encryption provided by the TLS layer, and limited authentication is
> +done by certificates.
> +
> +It is possible to make use of any SASL authentication mechanism as
> +well, by using 'sasl' for this option")
> +  (access-drivers
> +   (optional-list '())
> +   "API access control scheme.
> +
> +By default an authenticated user is allowed access to all APIs.
> Access +drivers can place restrictions on this.")
> +  (key-file
> +   (string "")
> +   "Server key file path. If set to an empty string, then no private
> key +is loaded.")
> +  (cert-file
> +   (string "")
> +   "Server key file path. If set to an empty string, then no
> certificate +is loaded.")
> +  (ca-file
> +   (string "")
> +   "Server key file path. If set to an empty string, then no CA
> certificate +is loaded.")
> +  (crl-file
> +   (string "")
> +   "Certificate revocation list path. If set to an empty string,
> then no +CRL is loaded.")
> +  (tls-no-sanity-cert
> +   (boolean #f)
> +   "Disable verification of our own server certificates.
> +
> +When libvirtd starts it performs some sanity checks against its own
> +certificates.")
> +  (tls-no-verify-cert
> +   (boolean #f)
> +   "Disable verification of client certificates.
> +
> +Client certificate verification is the primary authentication
> mechanism. +Any client which does not present a certificate signed by
> the CA +will be rejected.")
> +  (tls-allowed-dn-list
> +   (optional-list '())
> +   "Whitelist of allowed x509 Distinguished Name.")
> +  (sasl-allowed-usernames
> +   (optional-list '())
> +   "Whitelist of allowed SASL usernames. The format for username
> +depends on the SASL authentication mechanism.")
> +  (tls-priority
> +   (string "NORMAL")
> +   "Override the compile time default TLS priority string. The
> +default is usually \"NORMAL\" unless overridden at build time.
> +Only set this is it is desired for libvirt to deviate from
> +the global default settings.")
> +  (max-clients
> +   (integer 5000)
> +   "Maximum number of concurrent client connections to allow
> +over all sockets combined.")
> +  (max-queued-clients
> +   (integer 1000)
> +   "Maximum length of queue of connections waiting to be
> +accepted by the daemon. Note, that some protocols supporting
> +retransmission may obey this so that a later reattempt at
> +connection succeeds.")
> +  (max-anonymous-clients
> +   (integer 20)
> +   "Maximum length of queue of accepted but not yet authenticated
> +clients. Set this to zero to turn this feature off")
> +  (min-workers
> +   (integer 5)
> +   "Number of workers to start up initially.")
> +  (max-workers
> +   (integer 20)
> +   "Maximum number of worker threads.
> +
> +If the number of active clients exceeds @code{min-workers},
> +then more threads are spawned, up to max_workers limit.
> +Typically you'd want max_workers to equal maximum number
> +of clients allowed.")
> +  (prio-workers
> +   (integer 5)
> +   "Number of priority workers. If all workers from above
> +pool are stuck, some calls marked as high priority
> +(notably domainDestroy) can be executed in this pool.")
> +  (max-requests
> +    (integer 20)
> +    "Total global limit on concurrent RPC calls.")
> +  (max-client-requests
> +    (integer 5)
> +    "Limit on concurrent requests from a single client
> +connection. To avoid one client monopolizing the server
> +this should be a small fraction of the global max_requests
> +and max_workers parameter.")
> +  (admin-min-workers
> +    (integer 1)
> +    "Same as @code{min-workers} but for the admin interface.")
> +  (admin-max-workers
> +     (integer 5)
> +    "Same as @code{max-workers} but for the admin interface.")
> +  (admin-max-clients
> +    (integer 5)
> +    "Same as @code{max-clients} but for the admin interface.")
> +  (admin-max-queued-clients
> +    (integer 5)
> +    "Same as @code{max-queued-clients} but for the admin interface.")
> +  (admin-max-client-requests
> +    (integer 5)
> +    "Same as @code{max-client-requests} but for the admin
> interface.")
> +  (log-level
> +    (integer 3)
> +    "Logging level. 4 errors, 3 warnings, 2 information, 1 debug.")
> +  (log-filters
> +    (string "3:remote 4:event")
> +    "Logging filters.
> +
> +A filter allows to select a different logging level for a given
> category +of logs
> +The format for a filter is one of:
> address@hidden
> address@hidden x:name
> +
> address@hidden x:+name
> address@hidden itemize
> +
> +where @code{name} is a string which is matched against the category
> +given in the @code{VIR_LOG_INIT()} at the top of each libvirt source
> +file, e.g., \"remote\", \"qemu\", or \"util.json\" (the name in the
> +filter can be a substring of the full category name, in order
> +to match multiple similar categories), the optional \"+\" prefix
> +tells libvirt to log stack trace for each message matching
> +name, and @code{x} is the minimal level where matching messages
> should +be logged:
> +
> address@hidden
> address@hidden 1: DEBUG
> address@hidden 2: INFO
> address@hidden 3: WARNING
> address@hidden 4: ERROR
> address@hidden itemize
> +
> +Multiple filters can be defined in a single filters statement, they
> just +need to be separated by spaces.")
> +  (log-outputs
> +    (string "3:stderr")
> +    "Logging outputs.
> +
> +An output is one of the places to save logging information
> +The format for an output can be:
> +
> address@hidden @code
> address@hidden x:stderr
> +output goes to stderr
> +
> address@hidden x:syslog:name
> +use syslog for the output and use the given name as the ident
> +
> address@hidden x:file:file_path
> +output to a file, with the given filepath
> +
> address@hidden x:journald
> +output to journald logging system
> address@hidden table
> +
> +In all case the x prefix is the minimal level, acting as a filter
> +
> address@hidden
> address@hidden 1: DEBUG
> address@hidden 2: INFO
> address@hidden 3: WARNING
> address@hidden 4: ERROR
> address@hidden itemize
> +
> +Multiple outputs can be defined, they just need to be separated by
> spaces.")
> +  (audit-level
> +    (integer 1)
> +    "Allows usage of the auditing subsystem to be altered
> +
> address@hidden
> address@hidden 0: disable all auditing
> address@hidden 1: enable auditing, only if enabled on host
> address@hidden 2: enable auditing, and exit if disabled on host.
> address@hidden itemize
> +")
> +  (audit-logging
> +    (boolean #f)
> +    "Send audit messages via libvirt logging infrastructure.")
> +  (host-uuid
> +    (optional-string "")
> +    "Host UUID. UUID must not have all digits be the same.")
> +  (host-uuid-source
> +    (string "smbios")
> +    "Source to read host UUID.
> +
> address@hidden
> +
> address@hidden @code{smbios}: fetch the UUID from @code{dmidecode -s
> system-uuid} +
> address@hidden @code{machine-id}: fetch the UUID from @code{/etc/machine-id}
> +
> address@hidden itemize
> +
> +If @code{dmidecode} does not provide a valid UUID a temporary UUID
> +will be generated.")
> +  (keepalive-interval
> +    (integer 5)
> +    "A keepalive message is sent to a client after
> address@hidden seconds of inactivity to check if
> +the client is still responding. If set to -1, libvirtd will
> +never send keepalive requests; however clients can still send
> +them and the daemon will send responses.")
> +  (keepalive-count
> +    (integer 5)
> +    "Maximum number of keepalive messages that are allowed to be sent
> +to the client without getting any response before the connection is
> +considered broken.
> +
> +In other words, the connection is automatically
> +closed approximately after
> address@hidden * (keepalive_count + 1)} seconds since the
> last +message received from the client. When @code{keepalive-count} is
> +set to 0, connections will be automatically closed after
> address@hidden seconds of inactivity without sending any
> +keepalive messages.")
> +  (admin-keepalive-interval
> +    (integer 5)
> +    "Same as above but for admin interface.")
> +  (admin-keepalive-count
> +    (integer 5)
> +    "Same as above but for admin interface.")
> +  (ovs-timeout
> +    (integer 5)
> +    "Timeout for Open vSwitch calls.
> +
> +The @code{ovs-vsctl} utility is used for the configuration and
> +its timeout option is set by default to 5 seconds to avoid
> +potential infinite waits blocking libvirt."))
> +
> +(define* (libvirt-conf-file config)
> +  "Return a libvirtd config file."
> +  (plain-file "libvirtd.conf"
> +              (with-output-to-string
> +                (lambda ()
> +                  (serialize-configuration config 
> libvirt-configuration-fields)))))
> +
> +(define %libvirt-accounts
> +  (list (user-group (name "libvirt") (system? #t))))
> +
> +(define (%libvirt-activation config)
> +  (let ((sock-dir (libvirt-configuration-unix-sock-dir config)))
> +    #~(begin
> +        (use-modules (guix build utils))
> +        (mkdir-p #$sock-dir))))
> +
> +
> +(define (libvirt-shepherd-service config)
> +  (let* ((config-file (libvirt-conf-file config))
> +         (libvirt (libvirt-configuration-libvirt config)))
> +    (list (shepherd-service
> +           (documentation "Run the libvirt daemon.")
> +           (provision '(libvirtd))
> +           (start #~(make-forkexec-constructor
> +                     (list (string-append #$libvirt "/sbin/libvirtd")
> +                           "-f" #$config-file)))
> +           (stop #~(make-kill-destructor))))))
> +
> +(define libvirt-service-type
> +  (service-type (name 'libvirt)
> +             (extensions
> +                 (list
> +                  (service-extension polkit-service-type (compose list 
> libvirt-configuration-libvirt))

Line length could be better here, just by putting the (compose ... )
bit on the line after the polkit-service-type.

> +                  (service-extension profile-service-type
> +                                     (compose list
> +                                           (lambda (package) qemu)
> +                                     libvirt-configuration-libvirt))

This confused me for a bit, until I realised that a simpler way of
expressing this would be (const (list qemu)) if I'm correct? Also, it
would be good to explain why this needs to happen in a comment.

> +                  (service-extension activation-service-type
> +                                     %libvirt-activation)
> +                  (service-extension shepherd-root-service-type
> +                                     libvirt-shepherd-service)
> +                  (service-extension account-service-type
> +                                     (const %libvirt-accounts))))
> +                (default-value (libvirt-configuration))))
> +
> +
> +(define-record-type* <virtlog-configuration>
> +  virtlog-configuration make-virtlog-configuration
> +  virtlog-configuration?
> +  (libvirt      virtlog-configuration-libvirt
> +                (default libvirt))
> +  (log-level    virtlog-configuration-log-level
> +                (default 3))
> +  (log-filters  virtlog-configuration-log-filters
> +                (default "3:remote 4:event"))
> +  (log-outputs  virtlog-configuration-log-outputs
> +                (default "3:syslog:virtlogd"))
> +  (max-clients  virtlog-configuration-max-clients
> +                (default 1024))
> +  (max-size     virtlog-configuration-max-size
> +                (default 2097152)) ;; 2MB
> +  (max-backups  virtlog-configuration-max-backups
> +                (default 3)))
> +
> +(define* (virtlogd-conf-file config)
> +  "Return a virtlogd config file."
> +  (plain-file "virtlogd.conf"
> +              (string-append
> +               "log_level = " (number->string
> (virtlog-configuration-log-level config)) "\n"
> +               "log_filters = \"" (virtlog-configuration-log-filters
> config) "\"\n"
> +               "log_outputs = \"" (virtlog-configuration-log-outputs
> config) "\"\n"
> +               "max_clients = " (number->string
> (virtlog-configuration-max-clients config)) "\n"
> +               "max_size = " (number->string
> (virtlog-configuration-max-size config)) "\n"
> +               "max_backups = " (number->string
> (virtlog-configuration-max-backups config)) "\n"))) +
> +(define (virtlogd-shepherd-service config)
> +  (let* ((config-file (virtlogd-conf-file config))
> +         (libvirt (virtlog-configuration-libvirt config)))
> +    (list (shepherd-service
> +           (documentation "Run the virtlog daemon.")
> +           (provision '(virtlogd))
> +           (start #~(make-forkexec-constructor
> +                     (list (string-append #$libvirt "/sbin/virtlogd")
> +                           "-f" #$config-file)))
> +           (stop #~(make-kill-destructor))))))
> +
> +(define virtlog-service-type
> +  (service-type (name 'virtlogd)
> +             (extensions
> +                 (list
> +                  (service-extension profile-service-type
> +                                     (compose list
> +
> virtlog-configuration-libvirt))

What function does this extension have? As far as I understood from the
documentation you wrote, this is used from the libvirt service.

> +                  (service-extension shepherd-root-service-type
> +                                     virtlogd-shepherd-service)))
> +                (default-value (virtlog-configuration))))
> +
> +(define (generate-libvirt-documentation)
> +  (generate-documentation
> +   `((libvirt-configuration ,libvirt-configuration-fields))
> +   'libvirt-configuration))

This looks pretty much ready to be merged to me. Later, I'll try
running this on my machine, just to check that it starts successfully.

pgpJKis3XdgDk.pgp
Description: OpenPGP digital signature