unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#27887] [PATCH] services: Add libvirt services
@ 2017-07-31 18:13 Ryan Moe
  2017-08-18  7:48 ` Christopher Baines
  0 siblings, 1 reply; 11+ messages in thread
From: Ryan Moe @ 2017-07-31 18:13 UTC (permalink / raw)
  To: 27887

* 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

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
 
 
+@node Virtualization Services
+@subsubsection Virtualization services
+The @code{(gnu services virtualization)} module provides services for
+the libvirt and virtlog daemons.
+
+@subsubheading Libvirt daemon
+@code{libvirtd} 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.
+
+@deffn {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}.
+
+@example
+(service libvirt-service-type
+         (libvirt-configuration
+          (unix-sock-group "libvirt")
+          (tls-port "16555")))
+@end example
+@end deffn
+
+@c Auto-generated with (generate-libvirt-documentation)
+Available @code{libvirt-configuration} fields are:
+
+@deftypevr {@code{libvirt-configuration} parameter} package libvirt
+Libvirt package.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string tls-port
+Port for accepting secure TLS connections This can be a port number, or
+service name
+
+Defaults to @samp{"16514"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string tcp-port
+Port for accepting insecure TCP connections This can be a port number,
+or service name
+
+Defaults to @samp{"16509"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string listen-addr
+IP address or hostname used for client connections.
+
+Defaults to @samp{"0.0.0.0"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string mdns-name
+Default mDNS advertisement name.  This must be unique on the immediate
+broadcast network.
+
+Defaults to @samp{"Virtualization Host <hostname>"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string unix-sock-dir
+The directory in which sockets will be found/created.
+
+Defaults to @samp{"/var/run/libvirt"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string auth-unix-ro
+Authentication scheme for UNIX read-only sockets.  By default socket
+permissions allow anyone to connect
+
+Defaults to @samp{"polkit"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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{()}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string key-file
+Server key file path.  If set to an empty string, then no private key is
+loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string cert-file
+Server key file path.  If set to an empty string, then no certificate is
+loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string ca-file
+Server key file path.  If set to an empty string, then no CA certificate
+is loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string crl-file
+Certificate revocation list path.  If set to an empty string, then no
+CRL is loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} optional-list tls-allowed-dn-list
+Whitelist of allowed x509 Distinguished Name.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} optional-list sasl-allowed-usernames
+Whitelist of allowed SASL usernames.  The format for username depends on
+the SASL authentication mechanism.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer max-clients
+Maximum number of concurrent client connections to allow over all
+sockets combined.
+
+Defaults to @samp{5000}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer min-workers
+Number of workers to start up initially.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer max-requests
+Total global limit on concurrent RPC calls.
+
+Defaults to @samp{20}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-min-workers
+Same as @code{min-workers} but for the admin interface.
+
+Defaults to @samp{1}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-workers
+Same as @code{max-workers} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-clients
+Same as @code{max-clients} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-queued-clients
+Same as @code{max-queued-clients} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-client-requests
+Same as @code{max-client-requests} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer log-level
+Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
+
+Defaults to @samp{3}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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:
+
+@itemize @bullet
+@item
+x:name
+
+@item
+x:+name
+
+@end 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:
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string log-outputs
+Logging outputs.
+
+An output is one of the places to save logging information The format
+for an output can be:
+
+@table @code
+@item x:stderr
+output goes to stderr
+
+@item x:syslog:name
+use syslog for the output and use the given name as the ident
+
+@item x:file:file_path
+output to a file, with the given filepath
+
+@item x:journald
+output to journald logging system
+
+@end table
+
+In all case the x prefix is the minimal level, acting as a filter
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end itemize
+
+Multiple outputs can be defined, they just need to be separated by
+spaces.
+
+Defaults to @samp{"3:stderr"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer audit-level
+Allows usage of the auditing subsystem to be altered
+
+@itemize @bullet
+@item
+0: disable all auditing
+
+@item
+1: enable auditing, only if enabled on host
+
+@item
+2: enable auditing, and exit if disabled on host.
+
+@end itemize
+
+Defaults to @samp{1}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} boolean audit-logging
+Send audit messages via libvirt logging infrastructure.
+
+Defaults to @samp{#f}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} optional-string host-uuid
+Host UUID.  UUID must not have all digits be the same.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string host-uuid-source
+Source to read host UUID.
+
+@itemize @bullet
+@item
+@code{smbios}: fetch the UUID from @code{dmidecode -s system-uuid}
+
+@item
+@code{machine-id}: fetch the UUID from @code{/etc/machine-id}
+
+@end itemize
+
+If @code{dmidecode} does not provide a valid UUID a temporary UUID will
+be generated.
+
+Defaults to @samp{"smbios"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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
+@code{keepalive-interval} seconds of inactivity without sending any
+keepalive messages.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-keepalive-interval
+Same as above but for admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-keepalive-count
+Same as above but for admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@c %end of autogenerated docs
+
+@subsubheading 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.
+
+@deffn {Scheme Variable} virtlog-service-type
+This is the type of the virtlog daemon.
+Its value must be a @code{virtlog-configuration}.
+
+@example
+(service virtlog-service-type
+         (virtlog-configuration
+          (max-clients 1000)))
+@end example
+@end deffn
+
+@deftypevr {@code{virtlog-configuration} parameter} integer log-level
+Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
+
+Defaults to @samp{3}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} 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:
+
+@itemize @bullet
+@item
+x:name
+
+@item
+x:+name
+
+@end 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:
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} string log-outputs
+Logging outputs.
+
+An output is one of the places to save logging information The format
+for an output can be:
+
+@table @code
+@item x:stderr
+output goes to stderr
+
+@item x:syslog:name
+use syslog for the output and use the given name as the ident
+
+@item x:file:file_path
+output to a file, with the given filepath
+
+@item x:journald
+output to journald logging system
+
+@end table
+
+In all case the x prefix is the minimal level, acting as a filter
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end itemize
+
+Multiple outputs can be defined, they just need to be separated by
+spaces.
+
+Defaults to @samp{"3:stderr"}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} integer max-clients
+Maximum number of concurrent client connections to allow over all
+sockets combined.
+
+Defaults to @samp{1024}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} integer max-size
+Maximum file size before rolling over.
+
+Defaults to @samp{2MB}
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} integer max-backups
+Maximum number of backup files to keep.
+
+Defaults to @samp{3}
+
+@end 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 <ryan.moe@gmail.com>
+;;;
+;;; 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:
+@itemize
+@item x:name
+
+@item x:+name
+@end 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:
+
+@itemize
+@item 1: DEBUG
+@item 2: INFO
+@item 3: WARNING
+@item 4: ERROR
+@end 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:
+
+@table @code
+@item x:stderr
+output goes to stderr
+
+@item x:syslog:name
+use syslog for the output and use the given name as the ident
+
+@item x:file:file_path
+output to a file, with the given filepath
+
+@item x:journald
+output to journald logging system
+@end table
+
+In all case the x prefix is the minimal level, acting as a filter
+
+@itemize
+@item 1: DEBUG
+@item 2: INFO
+@item 3: WARNING
+@item 4: ERROR
+@end 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
+
+@itemize
+@item 0: disable all auditing
+@item 1: enable auditing, only if enabled on host
+@item 2: enable auditing, and exit if disabled on host.
+@end 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.
+
+@itemize
+
+@item @code{smbios}: fetch the UUID from @code{dmidecode -s system-uuid}
+
+@item @code{machine-id}: fetch the UUID from @code{/etc/machine-id}
+
+@end 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
+@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.")
+  (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
+@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
+@code{keepalive-interval} 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))
+                  (service-extension profile-service-type
+                                     (compose list
+					      (lambda (package) qemu)
+                                              libvirt-configuration-libvirt))
+                  (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))
+                  (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))
-- 
2.13.3

^ permalink raw reply related	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-07-31 18:13 [bug#27887] [PATCH] services: Add libvirt services Ryan Moe
@ 2017-08-18  7:48 ` Christopher Baines
  2017-08-19  0:12   ` Christopher Baines
  0 siblings, 1 reply; 11+ messages in thread
From: Christopher Baines @ 2017-08-18  7:48 UTC (permalink / raw)
  To: Ryan Moe; +Cc: 27887

[-- Attachment #1: Type: text/plain, Size: 43045 bytes --]

On Mon, 31 Jul 2017 11:13:08 -0700
Ryan Moe <ryan.moe@gmail.com> 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
>  
>  
> +@node Virtualization Services
> +@subsubsection Virtualization services
> +The @code{(gnu services virtualization)} module provides services for
> +the libvirt and virtlog daemons.
> +
> +@subsubheading Libvirt daemon
> +@code{libvirtd} 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.
> +
> +@deffn {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}.
> +
> +@example
> +(service libvirt-service-type
> +         (libvirt-configuration
> +          (unix-sock-group "libvirt")
> +          (tls-port "16555")))
> +@end example
> +@end deffn
> +
> +@c Auto-generated with (generate-libvirt-documentation)
> +Available @code{libvirt-configuration} fields are:
> +
> +@deftypevr {@code{libvirt-configuration} parameter} package libvirt
> +Libvirt package.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string tls-port
> +Port for accepting secure TLS connections This can be a port number,
> or +service name
> +
> +Defaults to @samp{"16514"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string tcp-port
> +Port for accepting insecure TCP connections This can be a port
> number, +or service name
> +
> +Defaults to @samp{"16509"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string
> listen-addr +IP address or hostname used for client connections.
> +
> +Defaults to @samp{"0.0.0.0"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string mdns-name
> +Default mDNS advertisement name.  This must be unique on the
> immediate +broadcast network.
> +
> +Defaults to @samp{"Virtualization Host <hostname>"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string
> unix-sock-dir +The directory in which sockets will be found/created.
> +
> +Defaults to @samp{"/var/run/libvirt"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string
> auth-unix-ro +Authentication scheme for UNIX read-only sockets.  By
> default socket +permissions allow anyone to connect
> +
> +Defaults to @samp{"polkit"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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{()}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string key-file
> +Server key file path.  If set to an empty string, then no private
> key is +loaded.
> +
> +Defaults to @samp{""}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string cert-file
> +Server key file path.  If set to an empty string, then no
> certificate is +loaded.
> +
> +Defaults to @samp{""}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string ca-file
> +Server key file path.  If set to an empty string, then no CA
> certificate +is loaded.
> +
> +Defaults to @samp{""}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string crl-file
> +Certificate revocation list path.  If set to an empty string, then no
> +CRL is loaded.
> +
> +Defaults to @samp{""}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} optional-list
> tls-allowed-dn-list +Whitelist of allowed x509 Distinguished Name.
> +
> +Defaults to @samp{()}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} optional-list
> sasl-allowed-usernames +Whitelist of allowed SASL usernames.  The
> format for username depends on +the SASL authentication mechanism.
> +
> +Defaults to @samp{()}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> max-clients +Maximum number of concurrent client connections to allow
> over all +sockets combined.
> +
> +Defaults to @samp{5000}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> min-workers +Number of workers to start up initially.
> +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> max-requests +Total global limit on concurrent RPC calls.
> +
> +Defaults to @samp{20}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> admin-min-workers +Same as @code{min-workers} but for the admin
> interface. +
> +Defaults to @samp{1}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> admin-max-workers +Same as @code{max-workers} but for the admin
> interface. +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> admin-max-clients +Same as @code{max-clients} but for the admin
> interface. +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> admin-max-queued-clients +Same as @code{max-queued-clients} but for
> the admin interface. +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> admin-max-client-requests +Same as @code{max-client-requests} but for
> the admin interface. +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer log-level
> +Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
> +
> +Defaults to @samp{3}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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:
> +
> +@itemize @bullet
> +@item
> +x:name
> +
> +@item
> +x:+name
> +
> +@end 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:
> +
> +@itemize @bullet
> +@item
> +1: DEBUG
> +
> +@item
> +2: INFO
> +
> +@item
> +3: WARNING
> +
> +@item
> +4: ERROR
> +
> +@end 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string
> log-outputs +Logging outputs.
> +
> +An output is one of the places to save logging information The format
> +for an output can be:
> +
> +@table @code
> +@item x:stderr
> +output goes to stderr
> +
> +@item x:syslog:name
> +use syslog for the output and use the given name as the ident
> +
> +@item x:file:file_path
> +output to a file, with the given filepath
> +
> +@item x:journald
> +output to journald logging system
> +
> +@end table
> +
> +In all case the x prefix is the minimal level, acting as a filter
> +
> +@itemize @bullet
> +@item
> +1: DEBUG
> +
> +@item
> +2: INFO
> +
> +@item
> +3: WARNING
> +
> +@item
> +4: ERROR
> +
> +@end itemize
> +
> +Multiple outputs can be defined, they just need to be separated by
> +spaces.
> +
> +Defaults to @samp{"3:stderr"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> audit-level +Allows usage of the auditing subsystem to be altered
> +
> +@itemize @bullet
> +@item
> +0: disable all auditing
> +
> +@item
> +1: enable auditing, only if enabled on host
> +
> +@item
> +2: enable auditing, and exit if disabled on host.
> +
> +@end itemize
> +
> +Defaults to @samp{1}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} boolean
> audit-logging +Send audit messages via libvirt logging infrastructure.
> +
> +Defaults to @samp{#f}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} optional-string
> host-uuid +Host UUID.  UUID must not have all digits be the same.
> +
> +Defaults to @samp{""}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} string
> host-uuid-source +Source to read host UUID.
> +
> +@itemize @bullet
> +@item
> +@code{smbios}: fetch the UUID from @code{dmidecode -s system-uuid}
> +
> +@item
> +@code{machine-id}: fetch the UUID from @code{/etc/machine-id}
> +
> +@end itemize
> +
> +If @code{dmidecode} does not provide a valid UUID a temporary UUID
> will +be generated.
> +
> +Defaults to @samp{"smbios"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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 +@code{keepalive-interval} seconds of
> inactivity without sending any +keepalive messages.
> +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> admin-keepalive-interval +Same as above but for admin interface.
> +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} parameter} integer
> admin-keepalive-count +Same as above but for admin interface.
> +
> +Defaults to @samp{5}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{libvirt-configuration} 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}.
> +
> +@end deftypevr
> +
> +@c %end of autogenerated docs
> +
> +@subsubheading 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. +
> +@deffn {Scheme Variable} virtlog-service-type
> +This is the type of the virtlog daemon.
> +Its value must be a @code{virtlog-configuration}.
> +
> +@example
> +(service virtlog-service-type
> +         (virtlog-configuration
> +          (max-clients 1000)))
> +@end example
> +@end deffn
> +
> +@deftypevr {@code{virtlog-configuration} parameter} integer log-level
> +Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
> +
> +Defaults to @samp{3}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{virtlog-configuration} 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:
> +
> +@itemize @bullet
> +@item
> +x:name
> +
> +@item
> +x:+name
> +
> +@end 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:
> +
> +@itemize @bullet
> +@item
> +1: DEBUG
> +
> +@item
> +2: INFO
> +
> +@item
> +3: WARNING
> +
> +@item
> +4: ERROR
> +
> +@end 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"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{virtlog-configuration} parameter} string
> log-outputs +Logging outputs.
> +
> +An output is one of the places to save logging information The format
> +for an output can be:
> +
> +@table @code
> +@item x:stderr
> +output goes to stderr
> +
> +@item x:syslog:name
> +use syslog for the output and use the given name as the ident
> +
> +@item x:file:file_path
> +output to a file, with the given filepath
> +
> +@item x:journald
> +output to journald logging system
> +
> +@end table
> +
> +In all case the x prefix is the minimal level, acting as a filter
> +
> +@itemize @bullet
> +@item
> +1: DEBUG
> +
> +@item
> +2: INFO
> +
> +@item
> +3: WARNING
> +
> +@item
> +4: ERROR
> +
> +@end itemize
> +
> +Multiple outputs can be defined, they just need to be separated by
> +spaces.
> +
> +Defaults to @samp{"3:stderr"}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{virtlog-configuration} parameter} integer
> max-clients +Maximum number of concurrent client connections to allow
> over all +sockets combined.
> +
> +Defaults to @samp{1024}.
> +
> +@end deftypevr
> +
> +@deftypevr {@code{virtlog-configuration} parameter} integer max-size
> +Maximum file size before rolling over.
> +
> +Defaults to @samp{2MB}
> +
> +@end deftypevr
> +
> +@deftypevr {@code{virtlog-configuration} parameter} integer
> max-backups +Maximum number of backup files to keep.
> +
> +Defaults to @samp{3}
> +
> +@end 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 <ryan.moe@gmail.com>
> +;;;
> +;;; 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:
> +@itemize
> +@item x:name
> +
> +@item x:+name
> +@end 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:
> +
> +@itemize
> +@item 1: DEBUG
> +@item 2: INFO
> +@item 3: WARNING
> +@item 4: ERROR
> +@end 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:
> +
> +@table @code
> +@item x:stderr
> +output goes to stderr
> +
> +@item x:syslog:name
> +use syslog for the output and use the given name as the ident
> +
> +@item x:file:file_path
> +output to a file, with the given filepath
> +
> +@item x:journald
> +output to journald logging system
> +@end table
> +
> +In all case the x prefix is the minimal level, acting as a filter
> +
> +@itemize
> +@item 1: DEBUG
> +@item 2: INFO
> +@item 3: WARNING
> +@item 4: ERROR
> +@end 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
> +
> +@itemize
> +@item 0: disable all auditing
> +@item 1: enable auditing, only if enabled on host
> +@item 2: enable auditing, and exit if disabled on host.
> +@end 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.
> +
> +@itemize
> +
> +@item @code{smbios}: fetch the UUID from @code{dmidecode -s
> system-uuid} +
> +@item @code{machine-id}: fetch the UUID from @code{/etc/machine-id}
> +
> +@end 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
> +@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.")
> +  (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
> +@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
> +@code{keepalive-interval} 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.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

^ permalink raw reply	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-18  7:48 ` Christopher Baines
@ 2017-08-19  0:12   ` Christopher Baines
  2017-08-19  0:49     ` Ryan Moe
  0 siblings, 1 reply; 11+ messages in thread
From: Christopher Baines @ 2017-08-19  0:12 UTC (permalink / raw)
  To: Ryan Moe; +Cc: 27887

[-- Attachment #1: Type: text/plain, Size: 1600 bytes --]

On Fri, 18 Aug 2017 08:48:12 +0100
Christopher Baines <mail@cbaines.net> wrote:

> 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.

So, I've reconfigured my machine to run both services, and also
configured libvirt to use libvirt for the socket group, so that I could
add libvirt as a supplemental group for my user. I think this has all
worked fine.

I tried using the virt-manager to connect, but I'm getting the
following error at the moment:


Unable to connect to libvirt.

internal error: Cannot find suitable emulator for x86_64

Libvirt URI is: qemu:///system

Traceback (most recent call last):
  File
"/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtManager/connection.py",
line 1108, in _open_thread self._populate_initial_state() File
"/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtManager/connection.py",
line 1062, in _populate_initial_state logging.debug("conn version=%s",
self._backend.conn_version()) File
"/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtinst/connection.py",
line 322, in conn_version self._conn_version =
self._libvirtconn.getVersion() File
"/gnu/store/a9g2s8404v8v5pm7m7w8yzr56ba1k331-python2-libvirt-3.4.0/lib/python2.7/site-packages/libvirt.py",
line 3863, in getVersion if ret == -1: raise libvirtError
('virConnectGetVersion() failed', conn=self) libvirtError: internal
error: Cannot find suitable emulator for x86_64

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

^ permalink raw reply	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-19  0:12   ` Christopher Baines
@ 2017-08-19  0:49     ` Ryan Moe
  2017-08-19 11:59       ` Christopher Baines
  0 siblings, 1 reply; 11+ messages in thread
From: Ryan Moe @ 2017-08-19  0:49 UTC (permalink / raw)
  To: Christopher Baines; +Cc: 27887

>> 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.
>
> So, I've reconfigured my machine to run both services, and also
> configured libvirt to use libvirt for the socket group, so that I could
> add libvirt as a supplemental group for my user. I think this has all
> worked fine.
>
> I tried using the virt-manager to connect, but I'm getting the
> following error at the moment:
>
>
> Unable to connect to libvirt.
>
> internal error: Cannot find suitable emulator for x86_64
>
> Libvirt URI is: qemu:///system
>
> Traceback (most recent call last):
>   File
> "/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtManager/connection.py",
> line 1108, in _open_thread self._populate_initial_state() File
> "/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtManager/connection.py",
> line 1062, in _populate_initial_state logging.debug("conn version=%s",
> self._backend.conn_version()) File
> "/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtinst/connection.py",
> line 322, in conn_version self._conn_version =
> self._libvirtconn.getVersion() File
> "/gnu/store/a9g2s8404v8v5pm7m7w8yzr56ba1k331-python2-libvirt-3.4.0/lib/python2.7/site-packages/libvirt.py",
> line 3863, in getVersion if ret == -1: raise libvirtError
> ('virConnectGetVersion() failed', conn=self) libvirtError: internal
> error: Cannot find suitable emulator for x86_64


Hi Christopher,

Thank you for taking a look at this. I have been trying to track down
this issue for about a week now (I use virt-manager and libvirt daily
so I'm kind of bummed this stopped working). When I originally
submitted the patch it worked, I swear I wouldn't have submitted it
otherwise :)

At some point I ran a guix pull and a guix system reconfigure and it
stopped working. The only difference I see is that when I submitted
the patch libvirt 3.5.0 was the current version and now it's 3.6.0.
I'm not sure why that would have broken it though.

The error you see is what happens if you install libvirt without qemu.
As far as I can tell though qemu is installed. It's also weird because
it works if I execute the exact same command that shepherd does. You
can try it yourself:

1. Start shepherd service
2. ps aux | grep libvirtd
3. herd stop libvirtd
4. As root, run the complete command from 2 and test with virt-manager.

My initial thought was that it had something to do with how I was
installing two packages into the system profile. qemu and libvirt both
end up there so I don't see why it doesn't work though.

Thanks,
Ryan

^ permalink raw reply	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-19  0:49     ` Ryan Moe
@ 2017-08-19 11:59       ` Christopher Baines
  2017-08-19 17:57         ` Ryan Moe
  0 siblings, 1 reply; 11+ messages in thread
From: Christopher Baines @ 2017-08-19 11:59 UTC (permalink / raw)
  To: Ryan Moe; +Cc: 27887


[-- Attachment #1.1: Type: text/plain, Size: 4307 bytes --]

On Fri, 18 Aug 2017 17:49:01 -0700
Ryan Moe <ryan.moe@gmail.com> wrote:

> >> 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.  
> >
> > So, I've reconfigured my machine to run both services, and also
> > configured libvirt to use libvirt for the socket group, so that I
> > could add libvirt as a supplemental group for my user. I think this
> > has all worked fine.
> >
> > I tried using the virt-manager to connect, but I'm getting the
> > following error at the moment:
> >
> >
> > Unable to connect to libvirt.
> >
> > internal error: Cannot find suitable emulator for x86_64
> >
> > Libvirt URI is: qemu:///system
> >
> > Traceback (most recent call last):
> >   File
> > "/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtManager/connection.py",
> > line 1108, in _open_thread self._populate_initial_state() File
> > "/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtManager/connection.py",
> > line 1062, in _populate_initial_state logging.debug("conn
> > version=%s", self._backend.conn_version()) File
> > "/gnu/store/h61dc28cck9lmp25d1r11d3hzzhz5qnj-virt-manager-1.4.2/share/virt-manager/virtinst/connection.py",
> > line 322, in conn_version self._conn_version =
> > self._libvirtconn.getVersion() File
> > "/gnu/store/a9g2s8404v8v5pm7m7w8yzr56ba1k331-python2-libvirt-3.4.0/lib/python2.7/site-packages/libvirt.py",
> > line 3863, in getVersion if ret == -1: raise libvirtError
> > ('virConnectGetVersion() failed', conn=self) libvirtError: internal
> > error: Cannot find suitable emulator for x86_64  
> 
> 
> Hi Christopher,
> 
> Thank you for taking a look at this. I have been trying to track down
> this issue for about a week now (I use virt-manager and libvirt daily
> so I'm kind of bummed this stopped working). When I originally
> submitted the patch it worked, I swear I wouldn't have submitted it
> otherwise :)
> 
> At some point I ran a guix pull and a guix system reconfigure and it
> stopped working. The only difference I see is that when I submitted
> the patch libvirt 3.5.0 was the current version and now it's 3.6.0.
> I'm not sure why that would have broken it though.
> 
> The error you see is what happens if you install libvirt without qemu.
> As far as I can tell though qemu is installed. It's also weird because
> it works if I execute the exact same command that shepherd does. You
> can try it yourself:
> 
> 1. Start shepherd service
> 2. ps aux | grep libvirtd
> 3. herd stop libvirtd
> 4. As root, run the complete command from 2 and test with
> virt-manager.

I think running outside of the shepherd works, as the environment will
be different. I think you can look at the environment for the running
process with:

  sudo cat /proc/$(pgrep -f libvirtd | head -n1)/environ

What I see when running the service through the shepherd is very
minimal, and doesn't have a value for PATH.

As I understand it, often in Guix, having a minimal runtime environment
might not be a problem, as packages retain references to their
dependencies from when they were built. If you look at the libvirt
package though, qemu is an input, but the output doesn't reference it.

> My initial thought was that it had something to do with how I was
> installing two packages into the system profile. qemu and libvirt both
> end up there so I don't see why it doesn't work though.

My guess is that the system profile isn't relevant here, as the bin
directory of the system profile isn't on the PATH.

I've written a basic system test for the libvirt service (a patch is
attached), and with that I tested what happens if set the PATH for the
service to explicitly include the QEMU package bin directory, and the
test passes for me with this change.

Back to getting this working though. Either wrapping libvirtd during
the package build to have a PATH including qemu, or including qemu in
the service will work, and I guess the deciding factor might be how
many things libvirt may need to access? Are there lots of other bits of
software that libvirt needs at runtime, where the package doesn't
currently reference them?

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-tests-Add-libvirt-service-type-test.patch --]
[-- Type: text/x-patch, Size: 4324 bytes --]

From f7889f53c29db2a31634052476f4e3e18ec8911e Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 19 Aug 2017 12:56:07 +0100
Subject: [PATCH] tests: Add 'libvirt-service-type' test.

* gnu/tests/virtualization.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 gnu/local.mk                 |  1 +
 gnu/tests/virtualization.scm | 96 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 97 insertions(+)
 create mode 100644 gnu/tests/virtualization.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index d60c93453..9ed2cf634 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -494,6 +494,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/messaging.scm			\
   %D%/tests/networking.scm			\
   %D%/tests/ssh.scm				\
+  %D%/tests/virtualization.scm			\
   %D%/tests/web.scm
 
 # Modules that do not need to be compiled.
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
new file mode 100644
index 000000000..f0cd9e56c
--- /dev/null
+++ b/gnu/tests/virtualization.scm
@@ -0,0 +1,96 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; 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 tests virtualization)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services dbus)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services virtualization)
+  #:use-module (gnu packages virtualization)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:export (%test-libvirt))
+
+(define %libvirt-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (dbus-service)
+   (polkit-service)
+   (service libvirt-service-type)))
+
+(define (run-libvirt-test)
+  "Run tests in %LIBVIRT-OS."
+  (define os
+    (marionette-operating-system
+     %libvirt-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "libvirt")
+
+          ;; Wait for memcached to be up and running.
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'libvirtd)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          (test-eq "fetch version"
+            0
+            (marionette-eval
+             `(begin
+                (system* ,(string-append #$libvirt "/bin/virsh")
+                         "-c" "qemu:///system" "version"))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "libvirt-test" test))
+
+(define %test-libvirt
+  (system-test
+   (name "libvirt")
+   (description "Connect to the running LIBVIRT service.")
+   (value (run-libvirt-test))))
-- 
2.14.1


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

^ permalink raw reply related	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-19 11:59       ` Christopher Baines
@ 2017-08-19 17:57         ` Ryan Moe
  2017-08-19 19:11           ` Christopher Baines
  0 siblings, 1 reply; 11+ messages in thread
From: Ryan Moe @ 2017-08-19 17:57 UTC (permalink / raw)
  To: Christopher Baines; +Cc: 27887

> I think running outside of the shepherd works, as the environment will
> be different. I think you can look at the environment for the running
> process with:
>
>   sudo cat /proc/$(pgrep -f libvirtd | head -n1)/environ
>
> What I see when running the service through the shepherd is very
> minimal, and doesn't have a value for PATH.
>
> As I understand it, often in Guix, having a minimal runtime environment
> might not be a problem, as packages retain references to their
> dependencies from when they were built. If you look at the libvirt
> package though, qemu is an input, but the output doesn't reference it.
>

This is because qemu isn't listed in propagated-inputs?

>> My initial thought was that it had something to do with how I was
>> installing two packages into the system profile. qemu and libvirt both
>> end up there so I don't see why it doesn't work though.
>
> My guess is that the system profile isn't relevant here, as the bin
> directory of the system profile isn't on the PATH.
>
> I've written a basic system test for the libvirt service (a patch is
> attached), and with that I tested what happens if set the PATH for the
> service to explicitly include the QEMU package bin directory, and the
> test passes for me with this change.
>

Setting the PATH does indeed work, thank you for figuring that out.

> Back to getting this working though. Either wrapping libvirtd during
> the package build to have a PATH including qemu, or including qemu in
> the service will work, and I guess the deciding factor might be how
> many things libvirt may need to access? Are there lots of other bits of
> software that libvirt needs at runtime, where the package doesn't
> currently reference them?

Libvirt can work with other hypervisors like lxc, openvz, and xen and
it supports lots of storage backends like NFS, LVM, and RBD.

^ permalink raw reply	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-19 17:57         ` Ryan Moe
@ 2017-08-19 19:11           ` Christopher Baines
  2017-08-21 15:25             ` Ryan Moe
  0 siblings, 1 reply; 11+ messages in thread
From: Christopher Baines @ 2017-08-19 19:11 UTC (permalink / raw)
  To: Ryan Moe; +Cc: 27887


[-- Attachment #1.1: Type: text/plain, Size: 2456 bytes --]

On Sat, 19 Aug 2017 10:57:59 -0700
Ryan Moe <ryan.moe@gmail.com> wrote:

> > I think running outside of the shepherd works, as the environment
> > will be different. I think you can look at the environment for the
> > running process with:
> >
> >   sudo cat /proc/$(pgrep -f libvirtd | head -n1)/environ
> >
> > What I see when running the service through the shepherd is very
> > minimal, and doesn't have a value for PATH.
> >
> > As I understand it, often in Guix, having a minimal runtime
> > environment might not be a problem, as packages retain references
> > to their dependencies from when they were built. If you look at the
> > libvirt package though, qemu is an input, but the output doesn't
> > reference it. 
> 
> This is because qemu isn't listed in propagated-inputs?

My understanding of propagated-inputs isn't great, and as far as I
know, it doesn't affect the environment in which the service runs, so I
don't think changing qemu to a propagated input would fix this.

> >> My initial thought was that it had something to do with how I was
> >> installing two packages into the system profile. qemu and libvirt
> >> both end up there so I don't see why it doesn't work though.  
> >
> > My guess is that the system profile isn't relevant here, as the bin
> > directory of the system profile isn't on the PATH.
> >
> > I've written a basic system test for the libvirt service (a patch is
> > attached), and with that I tested what happens if set the PATH for
> > the service to explicitly include the QEMU package bin directory,
> > and the test passes for me with this change.
> >  
> 
> Setting the PATH does indeed work, thank you for figuring that out.
> 
> > Back to getting this working though. Either wrapping libvirtd during
> > the package build to have a PATH including qemu, or including qemu
> > in the service will work, and I guess the deciding factor might be
> > how many things libvirt may need to access? Are there lots of other
> > bits of software that libvirt needs at runtime, where the package
> > doesn't currently reference them?  
> 
> Libvirt can work with other hypervisors like lxc, openvz, and xen and
> it supports lots of storage backends like NFS, LVM, and RBD.

Hmm, ok. If you don't have any strong opinions on how to fix this,
wrapping the libvirtd binary in the libvirt package is straightforward
and common. I've attached a patch that does this.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-packages-virtualization-Wrap-libvirtd-with-iproute-a.patch --]
[-- Type: text/x-patch, Size: 1628 bytes --]

From 559c259fc641ab0e944e439816e95370e6878854 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 19 Aug 2017 20:07:47 +0100
Subject: [PATCH] packages: virtualization: Wrap libvirtd with iproute and
 qemu.

libvirtd runs qemu if its configured to use it, and also uses the ip command.

* gnu/packages/virtualization.scm (libvirt)[arguments]: Add wrap-libvirtd
  phase.
---
 gnu/packages/virtualization.scm | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm
index ab364cd1f..d76a6dfd8 100644
--- a/gnu/packages/virtualization.scm
+++ b/gnu/packages/virtualization.scm
@@ -361,7 +361,16 @@ manage system or application containers.")
            (lambda _
              (zero? (system* "make" "install"
                              "sysconfdir=/tmp/etc"
-                             "localstatedir=/tmp/var")))))))
+                             "localstatedir=/tmp/var"))))
+         (add-after 'install 'wrap-libvirtd
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (wrap-program (string-append out "/sbin/libvirtd")
+                 `("PATH" = (,(string-append (assoc-ref inputs "iproute")
+                                             "/sbin")
+                             ,(string-append (assoc-ref inputs "qemu")
+                                             "/bin"))))
+               #t))))))
     (inputs
      `(("libxml2" ,libxml2)
        ("gnutls" ,gnutls)
-- 
2.14.1


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

^ permalink raw reply related	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-19 19:11           ` Christopher Baines
@ 2017-08-21 15:25             ` Ryan Moe
  2017-08-22  2:38               ` Ryan Moe
  0 siblings, 1 reply; 11+ messages in thread
From: Ryan Moe @ 2017-08-21 15:25 UTC (permalink / raw)
  To: Christopher Baines; +Cc: 27887

> Hmm, ok. If you don't have any strong opinions on how to fix this,
> wrapping the libvirtd binary in the libvirt package is straightforward
> and common. I've attached a patch that does this.

I don't know enough about Guix yet to suggest a better way to fix
this, but your patch looks like a reasonable way to handle this to me.
I'll do some more testing and send an updated patch.

^ permalink raw reply	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-21 15:25             ` Ryan Moe
@ 2017-08-22  2:38               ` Ryan Moe
  2017-08-22  9:56                 ` Christopher Baines
  0 siblings, 1 reply; 11+ messages in thread
From: Ryan Moe @ 2017-08-22  2:38 UTC (permalink / raw)
  To: Christopher Baines; +Cc: 27887

[-- Attachment #1: Type: text/plain, Size: 1830 bytes --]

I did some more testing and everything looks good to me. I've
addressed your previous comments as well (see below). I wasn't sure if
I needed to squash the commits so I just included all three patches. I
did reorder them to place your wrap patch before mine since the
libvirt service depends on that change.

>> +(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.
>

Agreed. This is fixed in the attached patch.

>> +                  (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.
>

That didn't work. qemu doesn't need to be installed in the system
profile anyway so I've removed this.

>> +(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.

Now that I have a better understanding of how this works I realize
this was unnecessary and it's been removed too.

[-- Attachment #2: 0001-packages-virtualization-Wrap-libvirtd-with-iproute-a.patch --]
[-- Type: text/x-patch, Size: 1593 bytes --]

From 7ff72e29e7c5397ac7dc56344f077b35285f81e1 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 19 Aug 2017 20:07:47 +0100
Subject: [PATCH 1/3] packages: virtualization: Wrap libvirtd with iproute and
 qemu.

libvirtd runs qemu if its configured to use it, and also uses the ip command.

* gnu/packages/virtualization.scm (libvirt)[arguments]: Add wrap-libvirtd
  phase.
---
 gnu/packages/virtualization.scm | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm
index ab364cd1f..d76a6dfd8 100644
--- a/gnu/packages/virtualization.scm
+++ b/gnu/packages/virtualization.scm
@@ -361,7 +361,16 @@ manage system or application containers.")
            (lambda _
              (zero? (system* "make" "install"
                              "sysconfdir=/tmp/etc"
-                             "localstatedir=/tmp/var")))))))
+                             "localstatedir=/tmp/var"))))
+         (add-after 'install 'wrap-libvirtd
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (wrap-program (string-append out "/sbin/libvirtd")
+                 `("PATH" = (,(string-append (assoc-ref inputs "iproute")
+                                             "/sbin")
+                             ,(string-append (assoc-ref inputs "qemu")
+                                             "/bin"))))
+               #t))))))
     (inputs
      `(("libxml2" ,libxml2)
        ("gnutls" ,gnutls)
-- 
2.14.1


[-- Attachment #3: 0002-services-Add-libvirt-services.patch --]
[-- Type: text/x-patch, Size: 38538 bytes --]

From 9597f7dbd0bf611d0355bd53fc7264dc4aee9a76 Mon Sep 17 00:00:00 2001
From: Ryan Moe <ryan.moe@gmail.com>
Date: Fri, 28 Jul 2017 16:50:37 -0700
Subject: [PATCH 2/3] services: Add libvirt services

* 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 | 492 ++++++++++++++++++++++++++++
 3 files changed, 1202 insertions(+)
 create mode 100644 gnu/services/virtualization.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index bff0788b2..67864f174 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -228,6 +228,7 @@ Services
 * Continuous Integration::      The Cuirass service.
 * Power management Services::   The TLP tool.
 * Audio Services::              The MPD.
+* Virtualization Services::     Virtualization services.
 * Miscellaneous Services::      Other services.
 
 Defining Services
@@ -9104,6 +9105,7 @@ declaration.
 * Continuous Integration::      The Cuirass service.
 * Power management Services::   The TLP tool.
 * Audio Services::              The MPD.
+* Virtualization Services::     Virtualization services.
 * Miscellaneous Services::      Other services.
 @end menu
 
@@ -15757,6 +15759,713 @@ an absolute path can be specified here.
 @end table
 @end deftp
 
+@node Virtualization Services
+@subsubsection Virtualization services
+The @code{(gnu services virtualization)} module provides services for
+the libvirt and virtlog daemons.
+
+@subsubheading Libvirt daemon
+@code{libvirtd} 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.
+
+@deffn {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}.
+
+@example
+(service libvirt-service-type
+         (libvirt-configuration
+          (unix-sock-group "libvirt")
+          (tls-port "16555")))
+@end example
+@end deffn
+
+@c Auto-generated with (generate-libvirt-documentation)
+Available @code{libvirt-configuration} fields are:
+
+@deftypevr {@code{libvirt-configuration} parameter} package libvirt
+Libvirt package.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string tls-port
+Port for accepting secure TLS connections This can be a port number, or
+service name
+
+Defaults to @samp{"16514"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string tcp-port
+Port for accepting insecure TCP connections This can be a port number,
+or service name
+
+Defaults to @samp{"16509"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string listen-addr
+IP address or hostname used for client connections.
+
+Defaults to @samp{"0.0.0.0"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string mdns-name
+Default mDNS advertisement name.  This must be unique on the immediate
+broadcast network.
+
+Defaults to @samp{"Virtualization Host <hostname>"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string unix-sock-dir
+The directory in which sockets will be found/created.
+
+Defaults to @samp{"/var/run/libvirt"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string auth-unix-ro
+Authentication scheme for UNIX read-only sockets.  By default socket
+permissions allow anyone to connect
+
+Defaults to @samp{"polkit"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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{()}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string key-file
+Server key file path.  If set to an empty string, then no private key is
+loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string cert-file
+Server key file path.  If set to an empty string, then no certificate is
+loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string ca-file
+Server key file path.  If set to an empty string, then no CA certificate
+is loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string crl-file
+Certificate revocation list path.  If set to an empty string, then no
+CRL is loaded.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} optional-list tls-allowed-dn-list
+Whitelist of allowed x509 Distinguished Name.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} optional-list sasl-allowed-usernames
+Whitelist of allowed SASL usernames.  The format for username depends on
+the SASL authentication mechanism.
+
+Defaults to @samp{()}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer max-clients
+Maximum number of concurrent client connections to allow over all
+sockets combined.
+
+Defaults to @samp{5000}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer min-workers
+Number of workers to start up initially.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer max-requests
+Total global limit on concurrent RPC calls.
+
+Defaults to @samp{20}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-min-workers
+Same as @code{min-workers} but for the admin interface.
+
+Defaults to @samp{1}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-workers
+Same as @code{max-workers} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-clients
+Same as @code{max-clients} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-queued-clients
+Same as @code{max-queued-clients} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-max-client-requests
+Same as @code{max-client-requests} but for the admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer log-level
+Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
+
+Defaults to @samp{3}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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:
+
+@itemize @bullet
+@item
+x:name
+
+@item
+x:+name
+
+@end 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:
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string log-outputs
+Logging outputs.
+
+An output is one of the places to save logging information The format
+for an output can be:
+
+@table @code
+@item x:stderr
+output goes to stderr
+
+@item x:syslog:name
+use syslog for the output and use the given name as the ident
+
+@item x:file:file_path
+output to a file, with the given filepath
+
+@item x:journald
+output to journald logging system
+
+@end table
+
+In all case the x prefix is the minimal level, acting as a filter
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end itemize
+
+Multiple outputs can be defined, they just need to be separated by
+spaces.
+
+Defaults to @samp{"3:stderr"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer audit-level
+Allows usage of the auditing subsystem to be altered
+
+@itemize @bullet
+@item
+0: disable all auditing
+
+@item
+1: enable auditing, only if enabled on host
+
+@item
+2: enable auditing, and exit if disabled on host.
+
+@end itemize
+
+Defaults to @samp{1}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} boolean audit-logging
+Send audit messages via libvirt logging infrastructure.
+
+Defaults to @samp{#f}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} optional-string host-uuid
+Host UUID.  UUID must not have all digits be the same.
+
+Defaults to @samp{""}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} string host-uuid-source
+Source to read host UUID.
+
+@itemize @bullet
+@item
+@code{smbios}: fetch the UUID from @code{dmidecode -s system-uuid}
+
+@item
+@code{machine-id}: fetch the UUID from @code{/etc/machine-id}
+
+@end itemize
+
+If @code{dmidecode} does not provide a valid UUID a temporary UUID will
+be generated.
+
+Defaults to @samp{"smbios"}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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
+@code{keepalive-interval} seconds of inactivity without sending any
+keepalive messages.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-keepalive-interval
+Same as above but for admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} parameter} integer admin-keepalive-count
+Same as above but for admin interface.
+
+Defaults to @samp{5}.
+
+@end deftypevr
+
+@deftypevr {@code{libvirt-configuration} 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}.
+
+@end deftypevr
+
+@c %end of autogenerated docs
+
+@subsubheading 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.
+
+@deffn {Scheme Variable} virtlog-service-type
+This is the type of the virtlog daemon.
+Its value must be a @code{virtlog-configuration}.
+
+@example
+(service virtlog-service-type
+         (virtlog-configuration
+          (max-clients 1000)))
+@end example
+@end deffn
+
+@deftypevr {@code{virtlog-configuration} parameter} integer log-level
+Logging level.  4 errors, 3 warnings, 2 information, 1 debug.
+
+Defaults to @samp{3}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} 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:
+
+@itemize @bullet
+@item
+x:name
+
+@item
+x:+name
+
+@end 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:
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end 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"}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} string log-outputs
+Logging outputs.
+
+An output is one of the places to save logging information The format
+for an output can be:
+
+@table @code
+@item x:stderr
+output goes to stderr
+
+@item x:syslog:name
+use syslog for the output and use the given name as the ident
+
+@item x:file:file_path
+output to a file, with the given filepath
+
+@item x:journald
+output to journald logging system
+
+@end table
+
+In all case the x prefix is the minimal level, acting as a filter
+
+@itemize @bullet
+@item
+1: DEBUG
+
+@item
+2: INFO
+
+@item
+3: WARNING
+
+@item
+4: ERROR
+
+@end itemize
+
+Multiple outputs can be defined, they just need to be separated by
+spaces.
+
+Defaults to @samp{"3:stderr"}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} integer max-clients
+Maximum number of concurrent client connections to allow over all
+sockets combined.
+
+Defaults to @samp{1024}.
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} integer max-size
+Maximum file size before rolling over.
+
+Defaults to @samp{2MB}
+
+@end deftypevr
+
+@deftypevr {@code{virtlog-configuration} parameter} integer max-backups
+Maximum number of backup files to keep.
+
+Defaults to @samp{3}
+
+@end deftypevr
+
+
 @node Miscellaneous Services
 @subsubsection Miscellaneous Services
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 1c6158cbf..1bec2227e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -440,6 +440,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..845cdb07b
--- /dev/null
+++ b/gnu/services/virtualization.scm
@@ -0,0 +1,492 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
+;;;
+;;; 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:
+@itemize
+@item x:name
+
+@item x:+name
+@end 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:
+
+@itemize
+@item 1: DEBUG
+@item 2: INFO
+@item 3: WARNING
+@item 4: ERROR
+@end 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:
+
+@table @code
+@item x:stderr
+output goes to stderr
+
+@item x:syslog:name
+use syslog for the output and use the given name as the ident
+
+@item x:file:file_path
+output to a file, with the given filepath
+
+@item x:journald
+output to journald logging system
+@end table
+
+In all case the x prefix is the minimal level, acting as a filter
+
+@itemize
+@item 1: DEBUG
+@item 2: INFO
+@item 3: WARNING
+@item 4: ERROR
+@end 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
+
+@itemize
+@item 0: disable all auditing
+@item 1: enable auditing, only if enabled on host
+@item 2: enable auditing, and exit if disabled on host.
+@end 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.
+
+@itemize
+
+@item @code{smbios}: fetch the UUID from @code{dmidecode -s system-uuid}
+
+@item @code{machine-id}: fetch the UUID from @code{/etc/machine-id}
+
+@end 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
+@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.")
+  (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
+@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
+@code{keepalive-interval} 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))
+                  (service-extension profile-service-type
+                                     (compose list
+                                              libvirt-configuration-libvirt))
+                  (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 shepherd-root-service-type
+                                     virtlogd-shepherd-service)))
+                (default-value (virtlog-configuration))))
+
+(define (generate-libvirt-documentation)
+  (generate-documentation
+   `((libvirt-configuration ,libvirt-configuration-fields))
+   'libvirt-configuration))
-- 
2.14.1


[-- Attachment #4: 0003-tests-Add-libvirt-service-type-test.patch --]
[-- Type: text/x-patch, Size: 4143 bytes --]

From fad26cde1ab5cf9f4092de0d8da475a3fc9f9846 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 19 Aug 2017 12:56:07 +0100
Subject: [PATCH 3/3] tests: Add 'libvirt-service-type' test.

* gnu/tests/virtualization.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 gnu/local.mk                 |  1 +
 gnu/tests/virtualization.scm | 95 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 96 insertions(+)
 create mode 100644 gnu/tests/virtualization.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index 1bec2227e..253e0c8db 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -494,6 +494,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/messaging.scm			\
   %D%/tests/networking.scm			\
   %D%/tests/ssh.scm				\
+  %D%/tests/virtualization.scm			\
   %D%/tests/web.scm
 
 # Modules that do not need to be compiled.
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
new file mode 100644
index 000000000..c2939355b
--- /dev/null
+++ b/gnu/tests/virtualization.scm
@@ -0,0 +1,95 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
+;;;
+;;; 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 tests virtualization)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services dbus)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services virtualization)
+  #:use-module (gnu packages virtualization)
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:export (%test-libvirt))
+
+(define %libvirt-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (dbus-service)
+   (polkit-service)
+   (service libvirt-service-type)))
+
+(define (run-libvirt-test)
+  "Run tests in %LIBVIRT-OS."
+  (define os
+    (marionette-operating-system
+     %libvirt-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "libvirt")
+
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'libvirtd)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          (test-eq "fetch version"
+            0
+            (marionette-eval
+             `(begin
+                (system* ,(string-append #$libvirt "/bin/virsh")
+                         "-c" "qemu:///system" "version"))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "libvirt-test" test))
+
+(define %test-libvirt
+  (system-test
+   (name "libvirt")
+   (description "Connect to the running LIBVIRT service.")
+   (value (run-libvirt-test))))
-- 
2.14.1


^ permalink raw reply related	[flat|nested] 11+ messages in thread

* [bug#27887] [PATCH] services: Add libvirt services
  2017-08-22  2:38               ` Ryan Moe
@ 2017-08-22  9:56                 ` Christopher Baines
  2017-08-23 12:22                   ` bug#27887: " Christopher Baines
  0 siblings, 1 reply; 11+ messages in thread
From: Christopher Baines @ 2017-08-22  9:56 UTC (permalink / raw)
  To: Ryan Moe; +Cc: 27887

[-- Attachment #1: Type: text/plain, Size: 2208 bytes --]

On Mon, 21 Aug 2017 19:38:25 -0700
Ryan Moe <ryan.moe@gmail.com> wrote:

> I did some more testing and everything looks good to me. I've
> addressed your previous comments as well (see below). I wasn't sure if
> I needed to squash the commits so I just included all three patches. I
> did reorder them to place your wrap patch before mine since the
> libvirt service depends on that change.

Awesome, that all sounds perfect.

> >> +(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.
> >  
> 
> Agreed. This is fixed in the attached patch.
> 
> >> +                  (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.
> >  
> 
> That didn't work. qemu doesn't need to be installed in the system
> profile anyway so I've removed this.
> 
> >> +(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.  
> 
> Now that I have a better understanding of how this works I realize
> this was unnecessary and it's been removed too.

I'll plan on merging this tomorrow then, leaving a little bit of time
for anyone else to review this if they want to. Great work Ryan!

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

^ permalink raw reply	[flat|nested] 11+ messages in thread

* bug#27887: [PATCH] services: Add libvirt services
  2017-08-22  9:56                 ` Christopher Baines
@ 2017-08-23 12:22                   ` Christopher Baines
  0 siblings, 0 replies; 11+ messages in thread
From: Christopher Baines @ 2017-08-23 12:22 UTC (permalink / raw)
  To: Ryan Moe; +Cc: 27887-done

[-- Attachment #1: Type: text/plain, Size: 2470 bytes --]

On Tue, 22 Aug 2017 10:56:31 +0100
Christopher Baines <mail@cbaines.net> wrote:

> On Mon, 21 Aug 2017 19:38:25 -0700
> Ryan Moe <ryan.moe@gmail.com> wrote:
> 
> > I did some more testing and everything looks good to me. I've
> > addressed your previous comments as well (see below). I wasn't sure
> > if I needed to squash the commits so I just included all three
> > patches. I did reorder them to place your wrap patch before mine
> > since the libvirt service depends on that change.  
> 
> Awesome, that all sounds perfect.
> 
> > >> +(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.
> > >    
> > 
> > Agreed. This is fixed in the attached patch.
> >   
> > >> +                  (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.
> > >    
> > 
> > That didn't work. qemu doesn't need to be installed in the system
> > profile anyway so I've removed this.
> >   
> > >> +(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.    
> > 
> > Now that I have a better understanding of how this works I realize
> > this was unnecessary and it's been removed too.  
> 
> I'll plan on merging this tomorrow then, leaving a little bit of time
> for anyone else to review this if they want to. Great work Ryan!

I've now pushed the 3 patches to master :)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

^ permalink raw reply	[flat|nested] 11+ messages in thread

end of thread, other threads:[~2017-08-23 12:23 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-07-31 18:13 [bug#27887] [PATCH] services: Add libvirt services Ryan Moe
2017-08-18  7:48 ` Christopher Baines
2017-08-19  0:12   ` Christopher Baines
2017-08-19  0:49     ` Ryan Moe
2017-08-19 11:59       ` Christopher Baines
2017-08-19 17:57         ` Ryan Moe
2017-08-19 19:11           ` Christopher Baines
2017-08-21 15:25             ` Ryan Moe
2017-08-22  2:38               ` Ryan Moe
2017-08-22  9:56                 ` Christopher Baines
2017-08-23 12:22                   ` bug#27887: " Christopher Baines

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).