summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/virtualization.scm492
1 files changed, 492 insertions, 0 deletions
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
new file mode 100644
index 0000000000..845cdb07ba
--- /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))
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-12 17:31:41 +0000