Commit | Line | Data |
---|---|---|
e6051057 RM |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (gnu services virtualization) | |
20 | #:use-module (gnu services) | |
21 | #:use-module (gnu services configuration) | |
22 | #:use-module (gnu services base) | |
23 | #:use-module (gnu services dbus) | |
24 | #:use-module (gnu services shepherd) | |
25 | #:use-module (gnu system shadow) | |
26 | #:use-module (gnu packages admin) | |
27 | #:use-module (gnu packages virtualization) | |
28 | #:use-module (guix records) | |
29 | #:use-module (guix gexp) | |
30 | #:use-module (guix packages) | |
31 | #:use-module (ice-9 match) | |
32 | ||
33 | #:export (libvirt-configuration | |
34 | libvirt-service-type | |
35 | virtlog-service-type)) | |
36 | ||
37 | (define (uglify-field-name field-name) | |
38 | (let ((str (symbol->string field-name))) | |
39 | (string-join | |
40 | (string-split (string-delete #\? str) #\-) | |
41 | "_"))) | |
42 | ||
43 | (define (quote-val val) | |
44 | (string-append "\"" val "\"")) | |
45 | ||
46 | (define (serialize-field field-name val) | |
47 | (format #t "~a = ~a\n" (uglify-field-name field-name) val)) | |
48 | ||
49 | (define (serialize-string field-name val) | |
50 | (serialize-field field-name (quote-val val))) | |
51 | ||
52 | (define (serialize-boolean field-name val) | |
53 | (serialize-field field-name (if val 1 0))) | |
54 | ||
55 | (define (serialize-integer field-name val) | |
56 | (serialize-field field-name val)) | |
57 | ||
58 | (define (build-opt-list val) | |
59 | (string-append | |
60 | "[" | |
61 | (string-join (map quote-val val) ",") | |
62 | "]")) | |
63 | ||
64 | (define optional-list? list?) | |
65 | (define optional-string? string?) | |
66 | ||
67 | (define (serialize-list field-name val) | |
68 | (serialize-field field-name (build-opt-list val))) | |
69 | ||
70 | (define (serialize-optional-list field-name val) | |
71 | (if (null? val) | |
72 | (format #t "# ~a = []\n" (uglify-field-name field-name)) | |
73 | (serialize-list field-name val))) | |
74 | ||
75 | (define (serialize-optional-string field-name val) | |
76 | (if (string-null? val) | |
77 | (format #t "# ~a = \"\"\n" (uglify-field-name field-name)) | |
78 | (serialize-string field-name val))) | |
79 | ||
80 | (define-configuration libvirt-configuration | |
81 | (libvirt | |
82 | (package libvirt) | |
83 | "Libvirt package.") | |
84 | (listen-tls? | |
85 | (boolean #t) | |
86 | "Flag listening for secure TLS connections on the public TCP/IP port. | |
87 | must set @code{listen} for this to have any effect. | |
88 | ||
89 | It is necessary to setup a CA and issue server certificates before | |
90 | using this capability.") | |
91 | (listen-tcp? | |
92 | (boolean #f) | |
93 | "Listen for unencrypted TCP connections on the public TCP/IP port. | |
94 | must set @code{listen} for this to have any effect. | |
95 | ||
96 | Using the TCP socket requires SASL authentication by default. Only | |
97 | SASL mechanisms which support data encryption are allowed. This is | |
98 | DIGEST_MD5 and GSSAPI (Kerberos5)") | |
99 | (tls-port | |
100 | (string "16514") | |
101 | "Port for accepting secure TLS connections This can be a port number, | |
102 | or service name") | |
103 | (tcp-port | |
104 | (string "16509") | |
105 | "Port for accepting insecure TCP connections This can be a port number, | |
106 | or service name") | |
107 | (listen-addr | |
108 | (string "0.0.0.0") | |
109 | "IP address or hostname used for client connections.") | |
110 | (mdns-adv? | |
111 | (boolean #f) | |
112 | "Flag toggling mDNS advertisement of the libvirt service. | |
113 | ||
114 | Alternatively can disable for all services on a host by | |
115 | stopping the Avahi daemon.") | |
116 | (mdns-name | |
117 | (string (string-append "Virtualization Host " (gethostname))) | |
118 | "Default mDNS advertisement name. This must be unique on the | |
119 | immediate broadcast network.") | |
120 | (unix-sock-group | |
121 | (string "root") | |
122 | "UNIX domain socket group ownership. This can be used to | |
123 | allow a 'trusted' set of users access to management capabilities | |
124 | without becoming root.") | |
125 | (unix-sock-ro-perms | |
126 | (string "0777") | |
127 | "UNIX socket permissions for the R/O socket. This is used | |
128 | for monitoring VM status only.") | |
129 | (unix-sock-rw-perms | |
130 | (string "0770") | |
131 | "UNIX socket permissions for the R/W socket. Default allows | |
132 | only root. If PolicyKit is enabled on the socket, the default | |
133 | will change to allow everyone (eg, 0777)") | |
134 | (unix-sock-admin-perms | |
135 | (string "0777") | |
136 | "UNIX socket permissions for the admin socket. Default allows | |
137 | only owner (root), do not change it unless you are sure to whom | |
138 | you are exposing the access to.") | |
139 | (unix-sock-dir | |
140 | (string "/var/run/libvirt") | |
141 | "The directory in which sockets will be found/created.") | |
142 | (auth-unix-ro | |
143 | (string "polkit") | |
144 | "Authentication scheme for UNIX read-only sockets. By default | |
145 | socket permissions allow anyone to connect") | |
146 | (auth-unix-rw | |
147 | (string "polkit") | |
148 | "Authentication scheme for UNIX read-write sockets. By default | |
149 | socket permissions only allow root. If PolicyKit support was compiled | |
150 | into libvirt, the default will be to use 'polkit' auth.") | |
151 | (auth-tcp | |
152 | (string "sasl") | |
153 | "Authentication scheme for TCP sockets. If you don't enable SASL, | |
154 | then all TCP traffic is cleartext. Don't do this outside of a dev/test | |
155 | scenario.") | |
156 | (auth-tls | |
157 | (string "none") | |
158 | "Authentication scheme for TLS sockets. TLS sockets already have | |
159 | encryption provided by the TLS layer, and limited authentication is | |
160 | done by certificates. | |
161 | ||
162 | It is possible to make use of any SASL authentication mechanism as | |
163 | well, by using 'sasl' for this option") | |
164 | (access-drivers | |
165 | (optional-list '()) | |
166 | "API access control scheme. | |
167 | ||
168 | By default an authenticated user is allowed access to all APIs. Access | |
169 | drivers can place restrictions on this.") | |
170 | (key-file | |
171 | (string "") | |
172 | "Server key file path. If set to an empty string, then no private key | |
173 | is loaded.") | |
174 | (cert-file | |
175 | (string "") | |
176 | "Server key file path. If set to an empty string, then no certificate | |
177 | is loaded.") | |
178 | (ca-file | |
179 | (string "") | |
180 | "Server key file path. If set to an empty string, then no CA certificate | |
181 | is loaded.") | |
182 | (crl-file | |
183 | (string "") | |
184 | "Certificate revocation list path. If set to an empty string, then no | |
185 | CRL is loaded.") | |
186 | (tls-no-sanity-cert | |
187 | (boolean #f) | |
188 | "Disable verification of our own server certificates. | |
189 | ||
190 | When libvirtd starts it performs some sanity checks against its own | |
191 | certificates.") | |
192 | (tls-no-verify-cert | |
193 | (boolean #f) | |
194 | "Disable verification of client certificates. | |
195 | ||
196 | Client certificate verification is the primary authentication mechanism. | |
197 | Any client which does not present a certificate signed by the CA | |
198 | will be rejected.") | |
199 | (tls-allowed-dn-list | |
200 | (optional-list '()) | |
201 | "Whitelist of allowed x509 Distinguished Name.") | |
202 | (sasl-allowed-usernames | |
203 | (optional-list '()) | |
204 | "Whitelist of allowed SASL usernames. The format for username | |
205 | depends on the SASL authentication mechanism.") | |
206 | (tls-priority | |
207 | (string "NORMAL") | |
208 | "Override the compile time default TLS priority string. The | |
209 | default is usually \"NORMAL\" unless overridden at build time. | |
210 | Only set this is it is desired for libvirt to deviate from | |
211 | the global default settings.") | |
212 | (max-clients | |
213 | (integer 5000) | |
214 | "Maximum number of concurrent client connections to allow | |
215 | over all sockets combined.") | |
216 | (max-queued-clients | |
217 | (integer 1000) | |
218 | "Maximum length of queue of connections waiting to be | |
219 | accepted by the daemon. Note, that some protocols supporting | |
220 | retransmission may obey this so that a later reattempt at | |
221 | connection succeeds.") | |
222 | (max-anonymous-clients | |
223 | (integer 20) | |
224 | "Maximum length of queue of accepted but not yet authenticated | |
225 | clients. Set this to zero to turn this feature off") | |
226 | (min-workers | |
227 | (integer 5) | |
228 | "Number of workers to start up initially.") | |
229 | (max-workers | |
230 | (integer 20) | |
231 | "Maximum number of worker threads. | |
232 | ||
233 | If the number of active clients exceeds @code{min-workers}, | |
234 | then more threads are spawned, up to max_workers limit. | |
235 | Typically you'd want max_workers to equal maximum number | |
236 | of clients allowed.") | |
237 | (prio-workers | |
238 | (integer 5) | |
239 | "Number of priority workers. If all workers from above | |
240 | pool are stuck, some calls marked as high priority | |
241 | (notably domainDestroy) can be executed in this pool.") | |
242 | (max-requests | |
243 | (integer 20) | |
244 | "Total global limit on concurrent RPC calls.") | |
245 | (max-client-requests | |
246 | (integer 5) | |
247 | "Limit on concurrent requests from a single client | |
248 | connection. To avoid one client monopolizing the server | |
249 | this should be a small fraction of the global max_requests | |
250 | and max_workers parameter.") | |
251 | (admin-min-workers | |
252 | (integer 1) | |
253 | "Same as @code{min-workers} but for the admin interface.") | |
254 | (admin-max-workers | |
255 | (integer 5) | |
256 | "Same as @code{max-workers} but for the admin interface.") | |
257 | (admin-max-clients | |
258 | (integer 5) | |
259 | "Same as @code{max-clients} but for the admin interface.") | |
260 | (admin-max-queued-clients | |
261 | (integer 5) | |
262 | "Same as @code{max-queued-clients} but for the admin interface.") | |
263 | (admin-max-client-requests | |
264 | (integer 5) | |
265 | "Same as @code{max-client-requests} but for the admin interface.") | |
266 | (log-level | |
267 | (integer 3) | |
268 | "Logging level. 4 errors, 3 warnings, 2 information, 1 debug.") | |
269 | (log-filters | |
270 | (string "3:remote 4:event") | |
271 | "Logging filters. | |
272 | ||
273 | A filter allows to select a different logging level for a given category | |
274 | of logs | |
275 | The format for a filter is one of: | |
276 | @itemize | |
277 | @item x:name | |
278 | ||
279 | @item x:+name | |
280 | @end itemize | |
281 | ||
282 | where @code{name} is a string which is matched against the category | |
283 | given in the @code{VIR_LOG_INIT()} at the top of each libvirt source | |
284 | file, e.g., \"remote\", \"qemu\", or \"util.json\" (the name in the | |
285 | filter can be a substring of the full category name, in order | |
286 | to match multiple similar categories), the optional \"+\" prefix | |
287 | tells libvirt to log stack trace for each message matching | |
288 | name, and @code{x} is the minimal level where matching messages should | |
289 | be logged: | |
290 | ||
291 | @itemize | |
292 | @item 1: DEBUG | |
293 | @item 2: INFO | |
294 | @item 3: WARNING | |
295 | @item 4: ERROR | |
296 | @end itemize | |
297 | ||
298 | Multiple filters can be defined in a single filters statement, they just | |
299 | need to be separated by spaces.") | |
300 | (log-outputs | |
301 | (string "3:stderr") | |
302 | "Logging outputs. | |
303 | ||
304 | An output is one of the places to save logging information | |
305 | The format for an output can be: | |
306 | ||
307 | @table @code | |
308 | @item x:stderr | |
309 | output goes to stderr | |
310 | ||
311 | @item x:syslog:name | |
312 | use syslog for the output and use the given name as the ident | |
313 | ||
314 | @item x:file:file_path | |
315 | output to a file, with the given filepath | |
316 | ||
317 | @item x:journald | |
318 | output to journald logging system | |
319 | @end table | |
320 | ||
321 | In all case the x prefix is the minimal level, acting as a filter | |
322 | ||
323 | @itemize | |
324 | @item 1: DEBUG | |
325 | @item 2: INFO | |
326 | @item 3: WARNING | |
327 | @item 4: ERROR | |
328 | @end itemize | |
329 | ||
330 | Multiple outputs can be defined, they just need to be separated by spaces.") | |
331 | (audit-level | |
332 | (integer 1) | |
333 | "Allows usage of the auditing subsystem to be altered | |
334 | ||
335 | @itemize | |
336 | @item 0: disable all auditing | |
337 | @item 1: enable auditing, only if enabled on host | |
338 | @item 2: enable auditing, and exit if disabled on host. | |
339 | @end itemize | |
340 | ") | |
341 | (audit-logging | |
342 | (boolean #f) | |
343 | "Send audit messages via libvirt logging infrastructure.") | |
344 | (host-uuid | |
345 | (optional-string "") | |
346 | "Host UUID. UUID must not have all digits be the same.") | |
347 | (host-uuid-source | |
348 | (string "smbios") | |
349 | "Source to read host UUID. | |
350 | ||
351 | @itemize | |
352 | ||
353 | @item @code{smbios}: fetch the UUID from @code{dmidecode -s system-uuid} | |
354 | ||
355 | @item @code{machine-id}: fetch the UUID from @code{/etc/machine-id} | |
356 | ||
357 | @end itemize | |
358 | ||
359 | If @code{dmidecode} does not provide a valid UUID a temporary UUID | |
360 | will be generated.") | |
361 | (keepalive-interval | |
362 | (integer 5) | |
363 | "A keepalive message is sent to a client after | |
364 | @code{keepalive_interval} seconds of inactivity to check if | |
365 | the client is still responding. If set to -1, libvirtd will | |
366 | never send keepalive requests; however clients can still send | |
367 | them and the daemon will send responses.") | |
368 | (keepalive-count | |
369 | (integer 5) | |
370 | "Maximum number of keepalive messages that are allowed to be sent | |
371 | to the client without getting any response before the connection is | |
372 | considered broken. | |
373 | ||
374 | In other words, the connection is automatically | |
375 | closed approximately after | |
376 | @code{keepalive_interval * (keepalive_count + 1)} seconds since the last | |
377 | message received from the client. When @code{keepalive-count} is | |
378 | set to 0, connections will be automatically closed after | |
379 | @code{keepalive-interval} seconds of inactivity without sending any | |
380 | keepalive messages.") | |
381 | (admin-keepalive-interval | |
382 | (integer 5) | |
383 | "Same as above but for admin interface.") | |
384 | (admin-keepalive-count | |
385 | (integer 5) | |
386 | "Same as above but for admin interface.") | |
387 | (ovs-timeout | |
388 | (integer 5) | |
389 | "Timeout for Open vSwitch calls. | |
390 | ||
391 | The @code{ovs-vsctl} utility is used for the configuration and | |
392 | its timeout option is set by default to 5 seconds to avoid | |
393 | potential infinite waits blocking libvirt.")) | |
394 | ||
395 | (define* (libvirt-conf-file config) | |
396 | "Return a libvirtd config file." | |
397 | (plain-file "libvirtd.conf" | |
398 | (with-output-to-string | |
399 | (lambda () | |
400 | (serialize-configuration config libvirt-configuration-fields))))) | |
401 | ||
402 | (define %libvirt-accounts | |
403 | (list (user-group (name "libvirt") (system? #t)))) | |
404 | ||
405 | (define (%libvirt-activation config) | |
406 | (let ((sock-dir (libvirt-configuration-unix-sock-dir config))) | |
407 | #~(begin | |
408 | (use-modules (guix build utils)) | |
409 | (mkdir-p #$sock-dir)))) | |
410 | ||
411 | ||
412 | (define (libvirt-shepherd-service config) | |
413 | (let* ((config-file (libvirt-conf-file config)) | |
414 | (libvirt (libvirt-configuration-libvirt config))) | |
415 | (list (shepherd-service | |
416 | (documentation "Run the libvirt daemon.") | |
417 | (provision '(libvirtd)) | |
418 | (start #~(make-forkexec-constructor | |
419 | (list (string-append #$libvirt "/sbin/libvirtd") | |
420 | "-f" #$config-file))) | |
421 | (stop #~(make-kill-destructor)))))) | |
422 | ||
423 | (define libvirt-service-type | |
424 | (service-type (name 'libvirt) | |
425 | (extensions | |
426 | (list | |
427 | (service-extension polkit-service-type | |
428 | (compose list libvirt-configuration-libvirt)) | |
429 | (service-extension profile-service-type | |
430 | (compose list | |
431 | libvirt-configuration-libvirt)) | |
432 | (service-extension activation-service-type | |
433 | %libvirt-activation) | |
434 | (service-extension shepherd-root-service-type | |
435 | libvirt-shepherd-service) | |
436 | (service-extension account-service-type | |
437 | (const %libvirt-accounts)))) | |
438 | (default-value (libvirt-configuration)))) | |
439 | ||
440 | ||
441 | (define-record-type* <virtlog-configuration> | |
442 | virtlog-configuration make-virtlog-configuration | |
443 | virtlog-configuration? | |
444 | (libvirt virtlog-configuration-libvirt | |
445 | (default libvirt)) | |
446 | (log-level virtlog-configuration-log-level | |
447 | (default 3)) | |
448 | (log-filters virtlog-configuration-log-filters | |
449 | (default "3:remote 4:event")) | |
450 | (log-outputs virtlog-configuration-log-outputs | |
451 | (default "3:syslog:virtlogd")) | |
452 | (max-clients virtlog-configuration-max-clients | |
453 | (default 1024)) | |
454 | (max-size virtlog-configuration-max-size | |
455 | (default 2097152)) ;; 2MB | |
456 | (max-backups virtlog-configuration-max-backups | |
457 | (default 3))) | |
458 | ||
459 | (define* (virtlogd-conf-file config) | |
460 | "Return a virtlogd config file." | |
461 | (plain-file "virtlogd.conf" | |
462 | (string-append | |
463 | "log_level = " (number->string (virtlog-configuration-log-level config)) "\n" | |
464 | "log_filters = \"" (virtlog-configuration-log-filters config) "\"\n" | |
465 | "log_outputs = \"" (virtlog-configuration-log-outputs config) "\"\n" | |
466 | "max_clients = " (number->string (virtlog-configuration-max-clients config)) "\n" | |
467 | "max_size = " (number->string (virtlog-configuration-max-size config)) "\n" | |
468 | "max_backups = " (number->string (virtlog-configuration-max-backups config)) "\n"))) | |
469 | ||
470 | (define (virtlogd-shepherd-service config) | |
471 | (let* ((config-file (virtlogd-conf-file config)) | |
472 | (libvirt (virtlog-configuration-libvirt config))) | |
473 | (list (shepherd-service | |
474 | (documentation "Run the virtlog daemon.") | |
475 | (provision '(virtlogd)) | |
476 | (start #~(make-forkexec-constructor | |
477 | (list (string-append #$libvirt "/sbin/virtlogd") | |
478 | "-f" #$config-file))) | |
479 | (stop #~(make-kill-destructor)))))) | |
480 | ||
481 | (define virtlog-service-type | |
482 | (service-type (name 'virtlogd) | |
483 | (extensions | |
484 | (list | |
485 | (service-extension shepherd-root-service-type | |
486 | virtlogd-shepherd-service))) | |
487 | (default-value (virtlog-configuration)))) | |
488 | ||
489 | (define (generate-libvirt-documentation) | |
490 | (generate-documentation | |
491 | `((libvirt-configuration ,libvirt-configuration-fields)) | |
492 | 'libvirt-configuration)) |