diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/base.scm | 233 | ||||
| -rw-r--r-- | gnu/services/cuirass.scm | 3 | ||||
| -rw-r--r-- | gnu/services/dbus.scm | 4 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 376 | ||||
| -rw-r--r-- | gnu/services/monitoring.scm | 2 | ||||
| -rw-r--r-- | gnu/services/pm.scm | 5 | ||||
| -rw-r--r-- | gnu/services/sound.scm | 87 | ||||
| -rw-r--r-- | gnu/services/ssh.scm | 22 | ||||
| -rw-r--r-- | gnu/services/virtualization.scm | 56 | ||||
| -rw-r--r-- | gnu/services/vpn.scm | 4 | ||||
| -rw-r--r-- | gnu/services/web.scm | 22 |
11 files changed, 645 insertions, 169 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index fbd01e84d6..f278cb76de 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -15,7 +15,7 @@ ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re> ;;; Copyright © 2021 qblade <qblade@protonmail.com> ;;; Copyright © 2021 Hui Lu <luhuins@163.com> -;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net> ;;; ;;; This file is part of GNU Guix. @@ -183,6 +183,7 @@ guix-configuration-authorized-keys guix-configuration-use-substitutes? guix-configuration-substitute-urls + guix-configuration-generate-substitute-key? guix-configuration-extra-options guix-configuration-log-file @@ -876,6 +877,8 @@ the message of the day, among other things." ;; "Escape hatch" for passing arbitrary command-line arguments. (extra-options agetty-extra-options ;list of strings (default '())) + (shepherd-requirement agetty-shepherd-requirement ;list of SHEPHERD requirements + (default '())) ;;; XXX Unimplemented for now! ;;; (issue-file agetty-issue-file ;file-like ;;; (default #f)) @@ -924,17 +927,19 @@ to use as the tty. This is primarily useful for headless systems." host no-issue? init-string no-clear? local-line extract-baud? skip-login? no-newline? login-options chroot hangup? keep-baud? timeout detect-case? wait-cr? no-hints? no-hostname? long-hostname? - erase-characters kill-characters chdir delay nice extra-options) + erase-characters kill-characters chdir delay nice extra-options + shepherd-requirement) (list (shepherd-service (documentation "Run agetty on a tty.") - (provision (list (symbol-append 'term- (string->symbol (or tty "auto"))))) + (provision (list (symbol-append 'term- (string->symbol (or tty "console"))))) ;; Since the login prompt shows the host name, wait for the 'host-name' ;; service to be done. Also wait for udev essentially so that the tty ;; text is not lost in the middle of kernel messages (see also ;; mingetty-shepherd-service). - (requirement '(user-processes host-name udev)) + (requirement (cons* 'user-processes 'host-name 'udev + shepherd-requirement)) (modules '((ice-9 match) (gnu build linux-boot))) (start @@ -1561,6 +1566,8 @@ archive' public keys, with GUIX." (default #t)) (substitute-urls guix-configuration-substitute-urls ;list of strings (default %default-substitute-urls)) + (generate-substitute-key? guix-configuration-generate-substitute-key? + (default #t)) ;Boolean (chroot-directories guix-configuration-chroot-directories ;list of file-like/strings (default '())) (max-silent-time guix-configuration-max-silent-time ;integer @@ -1745,14 +1752,15 @@ proxy of 'guix-daemon'...~%") (define (guix-activation config) "Return the activation gexp for CONFIG." (match-record config <guix-configuration> - (guix authorize-key? authorized-keys) + (guix generate-substitute-key? authorize-key? authorized-keys) #~(begin ;; Assume that the store has BUILD-GROUP as its group. We could ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs, ;; chown leads to an entire copy of the tree, which is a bad idea. ;; Generate a key pair and optionally authorize substitute server keys. - (unless (file-exists? "/etc/guix/signing-key.pub") + (unless (or #$(not generate-substitute-key?) + (file-exists? "/etc/guix/signing-key.pub")) (system* #$(file-append guix "/bin/guix") "archive" "--generate-key")) @@ -1995,8 +2003,7 @@ item of @var{packages}." (find directory-exists? (map (cut string-append directory <>) %standard-locations))) - (mkdir-p (string-append #$output "/lib/udev")) - (union-build (string-append #$output "/lib/udev/rules.d") + (union-build #$output (filter-map rules-sub-directory '#$packages))))) (computed-file "udev-rules" build)) @@ -2046,115 +2053,114 @@ item of @var{packages}." (define udev-shepherd-service ;; Return a <shepherd-service> for UDEV with RULES. (match-lambda + (($ <udev-configuration> udev) + (list + (shepherd-service + (provision '(udev)) + + ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can + ;; be added: see + ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>. + (requirement '(root-file-system)) + + (documentation "Populate the /dev directory, dynamically.") + (start + (with-imported-modules (source-module-closure + '((gnu build linux-boot))) + #~(lambda () + (define udevd + ;; 'udevd' from eudev. + #$(file-append udev "/sbin/udevd")) + + (define (wait-for-udevd) + ;; Wait until someone's listening on udevd's control + ;; socket. + (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) + (let try () + (catch 'system-error + (lambda () + (connect sock PF_UNIX "/run/udev/control") + (close-port sock)) + (lambda args + (format #t "waiting for udevd...~%") + (usleep 500000) + (try)))))) + + ;; Allow udev to find the modules. + (setenv "LINUX_MODULE_DIRECTORY" + "/run/booted-system/kernel/lib/modules") + + (let* ((kernel-release + (utsname:release (uname))) + (linux-module-directory + (getenv "LINUX_MODULE_DIRECTORY")) + (directory + (string-append linux-module-directory "/" + kernel-release)) + (old-umask (umask #o022))) + ;; If we're in a container, DIRECTORY might not exist, + ;; for instance because the host runs a different + ;; kernel. In that case, skip it; we'll just miss a few + ;; nodes like /dev/fuse. + (when (file-exists? directory) + (make-static-device-nodes directory)) + (umask old-umask)) + + (let ((pid (fork+exec-command + (list udevd) + #:environment-variables + (cons* + ;; The first one is for udev, the second one for + ;; eudev. + "UDEV_CONFIG_FILE=/etc/udev/udev.conf" + "EUDEV_RULES_DIRECTORY=/etc/udev/rules.d" + (string-append "LINUX_MODULE_DIRECTORY=" + (getenv "LINUX_MODULE_DIRECTORY")) + (default-environment-variables))))) + ;; Wait until udevd is up and running. This appears to + ;; be needed so that the events triggered below are + ;; actually handled. + (wait-for-udevd) + + ;; Trigger device node creation. + (system* #$(file-append udev "/bin/udevadm") + "trigger" "--action=add") + + ;; Wait for things to settle down. + (system* #$(file-append udev "/bin/udevadm") + "settle") + pid)))) + (stop #~(make-kill-destructor)) + + ;; When halting the system, 'udev' is actually killed by + ;; 'user-processes', i.e., before its own 'stop' method was called. + ;; Thus, make sure it is not respawned. + (respawn? #f) + ;; We need additional modules. + (modules `((gnu build linux-boot) ;'make-static-device-nodes' + ,@%default-modules))))))) + +(define udev.conf + (computed-file "udev.conf" + #~(call-with-output-file #$output + (lambda (port) + (format port "udev_rules=\"/etc/udev/rules.d\"~%"))))) + +(define udev-etc + (match-lambda (($ <udev-configuration> udev rules) - (let* ((rules (udev-rules-union (cons* udev kvm-udev-rule rules))) - (udev.conf (computed-file "udev.conf" - #~(call-with-output-file #$output - (lambda (port) - (format port - "udev_rules=\"~a/lib/udev/rules.d\"\n" - #$rules)))))) - (list - (shepherd-service - (provision '(udev)) - - ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can - ;; be added: see - ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>. - (requirement '(root-file-system)) - - (documentation "Populate the /dev directory, dynamically.") - (start - (with-imported-modules (source-module-closure - '((gnu build linux-boot))) - #~(lambda () - (define udevd - ;; 'udevd' from eudev. - #$(file-append udev "/sbin/udevd")) - - (define (wait-for-udevd) - ;; Wait until someone's listening on udevd's control - ;; socket. - (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) - (let try () - (catch 'system-error - (lambda () - (connect sock PF_UNIX "/run/udev/control") - (close-port sock)) - (lambda args - (format #t "waiting for udevd...~%") - (usleep 500000) - (try)))))) - - ;; Allow udev to find the modules. - (setenv "LINUX_MODULE_DIRECTORY" - "/run/booted-system/kernel/lib/modules") - - (let* ((kernel-release - (utsname:release (uname))) - (linux-module-directory - (getenv "LINUX_MODULE_DIRECTORY")) - (directory - (string-append linux-module-directory "/" - kernel-release)) - (old-umask (umask #o022))) - ;; If we're in a container, DIRECTORY might not exist, - ;; for instance because the host runs a different - ;; kernel. In that case, skip it; we'll just miss a few - ;; nodes like /dev/fuse. - (when (file-exists? directory) - (make-static-device-nodes directory)) - (umask old-umask)) - - (let ((pid (fork+exec-command (list udevd) - #:environment-variables - (cons* - ;; The first one is for udev, the second one for - ;; eudev. - (string-append "UDEV_CONFIG_FILE=" #$udev.conf) - (string-append "EUDEV_RULES_DIRECTORY=" - #$(file-append - rules "/lib/udev/rules.d")) - (string-append "LINUX_MODULE_DIRECTORY=" - (getenv "LINUX_MODULE_DIRECTORY")) - (default-environment-variables))))) - ;; Wait until udevd is up and running. This appears to - ;; be needed so that the events triggered below are - ;; actually handled. - (wait-for-udevd) - - ;; Trigger device node creation. - (system* #$(file-append udev "/bin/udevadm") - "trigger" "--action=add") - - ;; Wait for things to settle down. - (system* #$(file-append udev "/bin/udevadm") - "settle") - pid)))) - (stop #~(make-kill-destructor)) - - ;; When halting the system, 'udev' is actually killed by - ;; 'user-processes', i.e., before its own 'stop' method was called. - ;; Thus, make sure it is not respawned. - (respawn? #f) - ;; We need additional modules. - (modules `((gnu build linux-boot) ;'make-static-device-nodes' - ,@%default-modules)) - - (actions (list (shepherd-action - (name 'rules) - (documentation "Display the directory containing -the udev rules in use.") - (procedure #~(lambda (_) - (display #$rules) - (newline)))))))))))) + `(("udev" + ,(file-union + "udev" `(("udev.conf" ,udev.conf) + ("rules.d" ,(udev-rules-union (cons* udev kvm-udev-rule + rules)))))))))) (define udev-service-type (service-type (name 'udev) (extensions (list (service-extension shepherd-root-service-type - udev-shepherd-service))) - + udev-shepherd-service) + (service-extension etc-service-type udev-etc))) (compose concatenate) ;concatenate the list of rules (extend (lambda (config rules) (match config @@ -2783,10 +2789,12 @@ to handle." (cons tty %default-console-font)) '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6"))) + (syslog-service) (service agetty-service-type (agetty-configuration (extra-options '("-L")) ; no carrier detect (term "vt100") - (tty #f))) ; automatic + (tty #f) ; automatic + (shepherd-requirement '(syslogd)))) (service mingetty-service-type (mingetty-configuration (tty "tty1"))) @@ -2803,7 +2811,6 @@ to handle." (service static-networking-service-type (list %loopback-static-networking)) - (syslog-service) (service urandom-seed-service-type) (service guix-service-type) (service nscd-service-type) diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 96f28a9670..d666d6243b 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -302,7 +302,8 @@ (define (cuirass-log-rotations config) "Return the list of log rotations that corresponds to CONFIG." (list (log-rotation - (files (list (cuirass-configuration-log-file config))) + (files (list (cuirass-configuration-log-file config) + (cuirass-configuration-web-log-file config))) (frequency 'weekly) (options '("rotate 40"))))) ;worth keeping diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index d2daf60497..ef6b82c572 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -106,10 +106,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (define (services->sxml services) ;; Return the SXML 'includedir' clauses for DIRS. `(busconfig - ;; Increase this timeout to 60 seconds to work around race-y + ;; Increase this timeout to 300 seconds to work around race-y ;; failures such as <https://issues.guix.gnu.org/52051> on slow ;; computers with slow I/O. - (limit (@ (name "auth_timeout")) "60000") + (limit (@ (name "auth_timeout")) "300000") (servicehelper "/run/setuid-programs/dbus-daemon-launch-helper") ;; First, the '.service' files of services subject to activation. diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index c2ee3a3d80..ecadb16b2f 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -44,6 +44,7 @@ #:use-module (gnu system) #:use-module (gnu system setuid) #:use-module (gnu system shadow) + #:use-module (gnu system uuid) #:use-module (gnu system pam) #:use-module (gnu packages glib) #:use-module (gnu packages admin) @@ -68,6 +69,7 @@ #:use-module (guix utils) #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (<upower-configuration> upower-configuration @@ -403,14 +405,380 @@ site} for more information." bluetooth-configuration make-bluetooth-configuration bluetooth-configuration? (bluez bluetooth-configuration-bluez (default bluez)) - (auto-enable? bluetooth-configuration-auto-enable? (default #f))) + + ;;; [General] + (name bluetooth-configuration-name (default "BlueZ")) + (class bluetooth-configuration-class (default #x000000)) + (discoverable-timeout + bluetooth-configuration-discoverable-timeout (default 180)) + (always-pairable? bluetooth-configuration-always-pairable? (default #f)) + (pairable-timeout bluetooth-configuration-pairable-timeout (default 0)) + + ;;; MAYBE: Exclude into separate <device-id> record-type? + (device-id bluetooth-configuration-device-id (default #f)) + (reverse-service-discovery? + bluetooth-configuration-reverse-service-discovery (default #t)) + (name-resolving? bluetooth-configuration-name-resolving? (default #t)) + (debug-keys? bluetooth-configuration-debug-keys? (default #f)) + + ;;; Possible values: + ;;; 'dual, 'bredr, 'le + (controller-mode bluetooth-configuration-controller-mode (default 'dual)) + + ;;; Possible values: + ;;; 'off, 'single, 'multiple + (multi-profile bluetooth-configuration-multi-profile (default 'off)) + (fast-connectable? bluetooth-configuration-fast-connectable? (default #f)) + + ;;; Possible values: + ;;; for LE mode: 'off, 'network/on, 'device + ;;; for Dual mode: 'off, 'network/on', 'device, 'limited-network, 'limited-device + ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n68 + (privacy bluetooth-configuration-privacy (default 'off)) + + ;;; Possible values: + ;;; 'never, 'confirm, 'always + (just-works-repairing + bluetooth-configuration-just-works-repairing (default 'never)) + (temporary-timeout bluetooth-configuration-temporary-timeout (default 30)) + (refresh-discovery? bluetooth-configuration-refresh-discovery (default #t)) + + ;;; Possible values: #t, #f, (uuid <uuid>) + ;;; Possible UUIDs: + ;;; d4992530-b9ec-469f-ab01-6c481c47da1c (BlueZ Experimental Debug) + ;;; 671b10b5-42c0-4696-9227-eb28d1b049d6 (BlueZ Experimental Simultaneous Central and Peripheral) + ;;; 15c0a148-c273-11ea-b3de-0242ac130004 (BlueZ Experimental LL privacy) + ;;; 330859bc-7506-492d-9370-9a6f0614037f (BlueZ Experimental Bluetooth Quality Report) + ;;; a6695ace-ee7f-4fb9-881a-5fac66c629af (BlueZ Experimental Offload Codecs) + ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n110 + (experimental bluetooth-configuration-experimental (default #f)) + (remote-name-request-retry-delay + bluetooth-configuration-remote-name-request-retry-delay (default 300)) + + ;;; [BR] + (page-scan-type bluetooth-configuration-page-scan-type (default #f)) + (page-scan-interval bluetooth-configuration-page-scan-interval (default #f)) + (page-scan-window bluetooth-configuration-page-scan-window (default #f)) + (inquiry-scan-type bluetooth-configuration-inquiry-scan-type (default #f)) + (inquiry-scan-interval bluetooth-configuration-inquiry-scan-interval (default #f)) + (inquiry-scan-window bluetooth-configuration-inquiry-scan-window (default #f)) + (link-supervision-timeout bluetooth-configuration-link-supervision-timeout (default #f)) + (page-timeout bluetooth-configuration-page-timeout (default #f)) + (min-sniff-interval bluetooth-configuration-min-sniff-interval (default #f)) + (max-sniff-interval bluetooth-configuration-max-sniff-interval (default #f)) + + ;;; [LE] + (min-advertisement-interval + bluetooth-configuration-min-advertisement-interval (default #f)) + (max-advertisement-interval + bluetooth-configuration-max-advertisement-interval (default #f)) + (multi-advertisement-rotation-interval + bluetooth-configuration-multi-advertisement-rotation-interval (default #f)) + (scan-interval-auto-connect + bluetooth-configuration-scan-interval-auto-connect (default #f)) + (scan-window-auto-connect + bluetooth-configuration-scan-window-auto-connect (default #f)) + (scan-interval-suspend + bluetooth-configuration-scan-interval-suspend (default #f)) + (scan-window-suspend + bluetooth-configuration-scan-window-suspend (default #f)) + (scan-interval-discovery + bluetooth-configuration-scan-interval-discovery (default #f)) + (scan-window-discovery + bluetooth-configuration-scan-window-discovery (default #f)) + (scan-interval-adv-monitor + bluetooth-configuration-scan-interval-adv-monitor (default #f)) + (scan-window-adv-monitor + bluetooth-configuration-scan-window-adv-monitor (default #f)) + (scan-interval-connect + bluetooth-configuration-scan-interval-connect (default #f)) + (scan-window-connect + bluetooth-configuration-scan-window-connect (default #f)) + (min-connection-interval + bluetooth-configuration-min-connection-interval (default #f)) + (max-connection-interval + bluetooth-configuration-max-connection-interval (default #f)) + (connection-latency + bluetooth-configuration-connection-latency (default #f)) + (connection-supervision-timeout + bluetooth-configuration-connection-supervision-timeout (default #f)) + (autoconnect-timeout + bluetooth-configuration-autoconnect-timeout (default #f)) + (adv-mon-allowlist-scan-duration + bluetooth-configuration-adv-mon-allowlist-scan-duration (default 300)) + (adv-mon-no-filter-scan-duration + bluetooth-configuration-adv-mon-no-filter-scan-duration (default 500)) + (enable-adv-mon-interleave-scan? + bluetooth-configuration-enable-adv-mon-interleave-scan (default #t)) + + ;;; [GATT] + ;;; Possible values: 'yes, 'no, 'always + (cache bluetooth-configuration-cache (default 'always)) + + ;;; Possible values: 7 ... 16, 0 (don't care) + (key-size bluetooth-configuration-key-size (default 0)) + + ;;; Possible values: 23 ... 517 + (exchange-mtu bluetooth-configuration-exchange-mtu (default 517)) + + ;;; Possible values: 1 ... 5 + (att-channels bluetooth-configuration-att-channels (default 3)) + + ;;; [AVDTP] + ;;; Possible values: 'basic, 'ertm + (session-mode bluetooth-configuration-session-mode (default 'basic)) + + ;;; Possible values: 'basic, 'streaming + (stream-mode bluetooth-configuration-stream-mode (default 'basic)) + + ;;; [Policy] + (reconnect-uuids bluetooth-configuration-reconnect-uuids (default '())) + (reconnect-attempts bluetooth-configuration-reconnect-attempts (default 7)) + (reconnect-intervals bluetooth-configuration-reconnect-intervals + (default (list 1 2 4 8 16 32 64))) + (auto-enable? bluetooth-configuration-auto-enable? (default #f)) + (resume-delay bluetooth-configuration-resume-delay (default 2)) + + ;;; [AdvMon] + ;;; Possible values: + ;;; "0x00", "0xFF", + ;;; "N = 0x00" ... "N = 0xFF" + ;;; Source: https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/src/main.conf#n286 + (rssi-sampling-period bluetooth-configuration-rssi-sampling-period + (default #xFF))) (define (bluetooth-configuration-file config) "Return a configuration file for the systemd bluetooth service, as a string." (string-append - "[Policy]\n" - "AutoEnable=" (bool (bluetooth-configuration-auto-enable? - config)))) + "[General]" + "\nName = " (bluetooth-configuration-name config) + "\nClass = " (string-append + "0x" + (format #f "~6,'0x" (bluetooth-configuration-class config))) + "\nDiscoverableTimeout = " (number->string + (bluetooth-configuration-discoverable-timeout + config)) + "\nAlwaysPairable = " (bool (bluetooth-configuration-always-pairable? + config)) + "\nPairableTimeout = " (number->string + (bluetooth-configuration-pairable-timeout + config)) + (if (bluetooth-configuration-device-id config) + (string-append "\nDeviceID = " (bluetooth-configuration-device-id config)) + "") + "\nReverseServiceDiscovery = " (bool + (bluetooth-configuration-reverse-service-discovery + config)) + "\nNameResolving = " (bool (bluetooth-configuration-name-resolving? config)) + "\nDebugKeys = " (bool (bluetooth-configuration-debug-keys? config)) + "\nControllerMode = " (symbol->string + (bluetooth-configuration-controller-mode config)) + "\nMultiProfile = " (symbol->string (bluetooth-configuration-multi-profile + config)) + "\nFastConnectable = " (bool (bluetooth-configuration-fast-connectable? config)) + "\nPrivacy = " (symbol->string (bluetooth-configuration-privacy config)) + "\nJustWorksRepairing = " (symbol->string + (bluetooth-configuration-just-works-repairing config)) + "\nTemporaryTimeout = " (number->string + (bluetooth-configuration-temporary-timeout config)) + "\nRefreshDiscovery = " (bool (bluetooth-configuration-refresh-discovery config)) + "\nExperimental = " (let ((experimental (bluetooth-configuration-experimental config))) + (cond ((or (eq? experimental #t) + (eq? experimental #f)) (bool experimental)) + ((list? experimental) + (string-join (map uuid->string experimental) ",")))) + "\nRemoteNameRequestRetryDelay = " (number->string + (bluetooth-configuration-remote-name-request-retry-delay + config)) + "\n[BR]" + (if (bluetooth-configuration-page-scan-type config) + (string-append + "\nPageScanType = " + (number->string (bluetooth-configuration-page-scan-type config))) + "") + (if (bluetooth-configuration-page-scan-interval config) + (string-append + "\nPageScanInterval = " + (number->string (bluetooth-configuration-page-scan-interval config))) + "") + (if (bluetooth-configuration-page-scan-window config) + (string-append + "\nPageScanWindow = " + (number->string (bluetooth-configuration-page-scan-window config))) + "") + (if (bluetooth-configuration-inquiry-scan-type config) + (string-append + "\nInquiryScanType = " + (number->string (bluetooth-configuration-inquiry-scan-type config))) + "") + (if (bluetooth-configuration-inquiry-scan-interval config) + (string-append + "\nInquiryScanInterval = " + (number->string (bluetooth-configuration-inquiry-scan-interval config))) + "") + (if (bluetooth-configuration-inquiry-scan-window config) + (string-append + "\nInquiryScanWindow = " + (number->string (bluetooth-configuration-inquiry-scan-window config))) + "") + (if (bluetooth-configuration-link-supervision-timeout config) + (string-append + "\nLinkSupervisionTimeout = " + (number->string (bluetooth-configuration-link-supervision-timeout config))) + "") + (if (bluetooth-configuration-page-timeout config) + (string-append + "\nPageTimeout = " + (number->string (bluetooth-configuration-page-timeout config))) + "") + (if (bluetooth-configuration-min-sniff-interval config) + (string-append + "\nMinSniffInterval = " + (number->string (bluetooth-configuration-min-sniff-interval config))) + "") + (if (bluetooth-configuration-max-sniff-interval config) + (string-append + "\nMaxSniffInterval = " + (number->string (bluetooth-configuration-max-sniff-interval config))) + "") + + "\n[LE]" + (if (bluetooth-configuration-min-advertisement-interval config) + (string-append + "\nMinAdvertisementInterval = " + (number->string (bluetooth-configuration-min-advertisement-interval config))) + "") + (if (bluetooth-configuration-max-advertisement-interval config) + (string-append + "\nMaxAdvertisementInterval = " + (number->string (bluetooth-configuration-max-advertisement-interval config))) + "") + (if (bluetooth-configuration-multi-advertisement-rotation-interval config) + (string-append + "\nMultiAdvertisementRotationInterval = " + (number->string + (bluetooth-configuration-multi-advertisement-rotation-interval config))) + "") + (if (bluetooth-configuration-scan-interval-auto-connect config) + (string-append + "\nScanIntervalAutoConnect = " + (number->string (bluetooth-configuration-scan-interval-auto-connect config))) + "") + (if (bluetooth-configuration-scan-window-auto-connect config) + (string-append + "\nScanWindowAutoConnect = " + (number->string (bluetooth-configuration-scan-window-auto-connect config))) + "") + (if (bluetooth-configuration-scan-interval-suspend config) + (string-append + "\nScanIntervalSuspend = " + (number->string (bluetooth-configuration-scan-interval-suspend config))) + "") + (if (bluetooth-configuration-scan-window-suspend config) + (string-append + "\nScanWindowSuspend = " + (number->string (bluetooth-configuration-scan-window-suspend config))) + "") + (if (bluetooth-configuration-scan-interval-discovery config) + (string-append + "\nScanIntervalDiscovery = " + (number->string (bluetooth-configuration-scan-interval-discovery config))) + "") + (if (bluetooth-configuration-scan-window-discovery config) + (string-append + "\nScanWindowDiscovery = " + (number->string (bluetooth-configuration-scan-window-discovery config))) + "") + (if (bluetooth-configuration-scan-interval-adv-monitor config) + (string-append + "\nScanIntervalAdvMonitor = " + (number->string (bluetooth-configuration-scan-interval-adv-monitor config))) + "") + (if (bluetooth-configuration-scan-window-adv-monitor config) + (string-append + "\nScanWindowAdvMonitor = " + (number->string (bluetooth-configuration-scan-window-adv-monitor config))) + "") + (if (bluetooth-configuration-scan-interval-connect config) + (string-append + "\nScanIntervalConnect = " + (number->string (bluetooth-configuration-scan-interval-connect config))) + "") + (if (bluetooth-configuration-scan-window-connect config) + (string-append + "\nScanWindowConnect = " + (number->string (bluetooth-configuration-scan-window-connect config))) + "") + (if (bluetooth-configuration-min-connection-interval config) + (string-append + "\nMinConnectionInterval = " + (number->string (bluetooth-configuration-min-connection-interval config))) + "") + (if (bluetooth-configuration-max-connection-interval config) + (string-append + "\nMaxConnectionInterval = " + (number->string (bluetooth-configuration-max-connection-interval config))) + "") + (if (bluetooth-configuration-connection-latency config) + (string-append + "\nConnectionLatency = " + (number->string (bluetooth-configuration-connection-latency config))) + "") + (if (bluetooth-configuration-connection-supervision-timeout config) + (string-append + "\nConnectionSupervisionTimeout = " + (number->string (bluetooth-configuration-connection-supervision-timeout config))) + "") + (if (bluetooth-configuration-autoconnect-timeout config) + (string-append + "\nAutoconnecttimeout = " + (number->string (bluetooth-configuration-autoconnect-timeout config))) + "") + "\nAdvMonAllowlistScanDuration = " (number->string + (bluetooth-configuration-adv-mon-allowlist-scan-duration + config)) + "\nAdvMonNoFilterScanDuration = " (number->string + (bluetooth-configuration-adv-mon-no-filter-scan-duration + config)) + "\nEnableAdvMonInterleaveScan = " (number->string + (if (eq? #t + (bluetooth-configuration-enable-adv-mon-interleave-scan + config)) + 1 0)) + + "\n[GATT]" + "\nCache = " (symbol->string (bluetooth-configuration-cache config)) + "\nKeySize = " (number->string (bluetooth-configuration-key-size config)) + "\nExchangeMTU = " (number->string (bluetooth-configuration-exchange-mtu config)) + "\nChannels = " (number->string (bluetooth-configuration-att-channels config)) + + "\n[AVDTP]" + "\nSessionMode = " (symbol->string (bluetooth-configuration-session-mode config)) + "\nStreamMode = " (symbol->string (bluetooth-configuration-stream-mode config)) + + "\n[Policy]" + (let ((uuids (bluetooth-configuration-reconnect-uuids config))) + (if (not (eq? '() uuids)) + (string-append + "\nReconnectUUIDs = " + (string-join (map uuid->string uuids) ",")) + "")) + "\nReconnectAttempts = " (number->string + (bluetooth-configuration-reconnect-attempts config)) + "\nReconnectIntervals = " (string-join + (map number->string + (bluetooth-configuration-reconnect-intervals + config)) + ",") + "\nAutoEnable = " (bool (bluetooth-configuration-auto-enable? + config)) + "\nResumeDelay = " (number->string (bluetooth-configuration-resume-delay config)) + + "\n[AdvMon]" + "\nRSSISamplingPeriod = " (string-append + "0x" + (format #f "~2,'0x" + (bluetooth-configuration-rssi-sampling-period config))))) (define (bluetooth-directory config) (computed-file "etc-bluetooth" diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm index 92c49c513b..0e6aed2cac 100644 --- a/gnu/services/monitoring.scm +++ b/gnu/services/monitoring.scm @@ -392,6 +392,7 @@ configuration file.")) (config-file (zabbix-server-config-file config))) (list (shepherd-service (provision '(zabbix-server)) + (requirement '(user-processes)) (documentation "Run the Zabbix server daemon.") (actions (zabbix-server-actions zabbix-server config-file)) (start #~(make-forkexec-constructor @@ -516,6 +517,7 @@ configuration file.")) "Return a <shepherd-service> for Zabbix agent with CONFIG." (list (shepherd-service (provision '(zabbix-agent)) + (requirement '(user-processes)) (documentation "Run Zabbix agent daemon.") (start #~(make-forkexec-constructor (list #$(file-append (zabbix-agent-configuration-zabbix-agent config) diff --git a/gnu/services/pm.scm b/gnu/services/pm.scm index 3da3c0b961..e48236dbca 100644 --- a/gnu/services/pm.scm +++ b/gnu/services/pm.scm @@ -435,6 +435,8 @@ shutdown on system startup.")) (define-record-type* <thermald-configuration> thermald-configuration make-thermald-configuration thermald-configuration? + (adaptive? thermald-adaptive? ;boolean + (default #f)) (ignore-cpuid-check? thermald-ignore-cpuid-check? ;boolean (default #f)) (thermald thermald-thermald ;file-like @@ -448,6 +450,9 @@ shutdown on system startup.")) (start #~(make-forkexec-constructor '(#$(file-append (thermald-thermald config) "/sbin/thermald") "--no-daemon" + #$@(if (thermald-adaptive? config) + '("--adaptive") + '()) #$@(if (thermald-ignore-cpuid-check? config) '("--ignore-cpuid-check") '())))) diff --git a/gnu/services/sound.scm b/gnu/services/sound.scm index 03e62a1e36..8410ba2418 100644 --- a/gnu/services/sound.scm +++ b/gnu/services/sound.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2018, 2020 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Liliana Marie Prikler <liliana.prikler@gmail.com> ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com> +;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,14 +26,17 @@ #:use-module (gnu services) #:use-module (gnu system pam) #:use-module (gnu system shadow) + #:use-module (guix diagnostics) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix store) + #:use-module (guix ui) #:use-module (gnu packages audio) #:use-module (gnu packages linux) #:use-module (gnu packages pulseaudio) #:use-module (ice-9 match) + #:use-module (srfi srfi-1) #:export (alsa-configuration alsa-service-type @@ -115,16 +119,18 @@ ctl.!default { (define-record-type* <pulseaudio-configuration> pulseaudio-configuration make-pulseaudio-configuration pulseaudio-configuration? - (client-conf pulseaudio-client-conf + (client-conf pulseaudio-configuration-client-conf (default '())) - (daemon-conf pulseaudio-daemon-conf + (daemon-conf pulseaudio-configuration-daemon-conf ;; Flat volumes may cause unpleasant experiences to users ;; when applications inadvertently max out the system volume ;; (see e.g. <https://bugs.gnu.org/38172>). (default '((flat-volumes . no)))) - (script-file pulseaudio-script-file + (script-file pulseaudio-configuration-script-file (default (file-append pulseaudio "/etc/pulse/default.pa"))) - (system-script-file pulseaudio-system-script-file + (extra-script-files pulseaudio-configuration-extra-script-files + (default '())) + (system-script-file pulseaudio-configuration-system-script-file (default (file-append pulseaudio "/etc/pulse/system.pa")))) @@ -138,20 +144,77 @@ ctl.!default { (define pulseaudio-environment (match-lambda (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file) - `(("PULSE_CONFIG" . ,(apply mixed-text-file "daemon.conf" - "default-script-file = " default-script-file "\n" - (map pulseaudio-conf-entry daemon-conf))) - ("PULSE_CLIENTCONFIG" . ,(apply mixed-text-file "client.conf" - (map pulseaudio-conf-entry client-conf))))))) + ;; These config files kept at a fixed location, so that the following + ;; environment values are stable and do not require the user to reboot to + ;; effect their PulseAudio configuration changes. + '(("PULSE_CONFIG" . "/etc/pulse/daemon.conf") + ("PULSE_CLIENTCONFIG" . "/etc/pulse/client.conf"))))) + +(define (extra-script-files->file-union extra-script-files) + "Return a G-exp obtained by processing EXTRA-SCRIPT-FILES with FILE-UNION." + + (define (file-like->name file) + (match file + ((? local-file?) + (local-file-name file)) + ((? plain-file?) + (plain-file-name file)) + ((? computed-file?) + (computed-file-name file)) + (_ (leave (G_ "~a is not a local-file, plain-file or \ +computed-file object~%") file)))) + + (define (assert-pulseaudio-script-file-name name) + (unless (string-suffix? ".pa" name) + (leave (G_ "`~a' lacks the required `.pa' file name extension~%") name)) + name) + + (let ((labels (map (compose assert-pulseaudio-script-file-name + file-like->name) + extra-script-files))) + (file-union "default.pa.d" (zip labels extra-script-files)))) + +(define (append-include-directive script-file) + "Append an include directive to source scripts under /etc/pulse/default.pa.d." + (computed-file "default.pa" + #~(begin + (use-modules (ice-9 textual-ports)) + (define script-text + (call-with-input-file #$script-file get-string-all)) + (call-with-output-file #$output + (lambda (port) + (format port (string-append script-text " +### Added by Guix to include scripts specified in extra-script-files. +.nofail +.include /etc/pulse/default.pa.d~%"))))))) (define pulseaudio-etc (match-lambda - (($ <pulseaudio-configuration> _ _ default-script-file system-script-file) + (($ <pulseaudio-configuration> client-conf daemon-conf default-script-file + extra-script-files system-script-file) `(("pulse" ,(file-union "pulse" - `(("default.pa" ,default-script-file) - ("system.pa" ,system-script-file)))))))) + `(("default.pa" + ,(if (null? extra-script-files) + default-script-file + (append-include-directive default-script-file))) + ("system.pa" ,system-script-file) + ,@(if (null? extra-script-files) + '() + `(("default.pa.d" ,(extra-script-files->file-union + extra-script-files)))) + ,@(if (null? daemon-conf) + '() + `(("daemon.conf" + ,(apply mixed-text-file "daemon.conf" + "default-script-file = " default-script-file "\n" + (map pulseaudio-conf-entry daemon-conf))))) + ,@(if (null? client-conf) + '() + `(("client.conf" + ,(apply mixed-text-file "client.conf" + (map pulseaudio-conf-entry client-conf)))))))))))) (define pulseaudio-service-type (service-type diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 97f74a00f7..5c8fe4eef4 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2019, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> @@ -348,10 +348,14 @@ The other options should be self-descriptive." (default "")) ;; list of user-name/file-like tuples - (authorized-keys openssh-authorized-keys + (authorized-keys openssh-configuration-authorized-keys (default '())) ;; Boolean + (generate-host-keys? openssh-configuration-generate-host-keys? + (default #t)) + + ;; Boolean ;; XXX: This should really be handled in an orthogonal way, for instance as ;; proposed in <https://bugs.gnu.org/27155>. Keep it internal/undocumented ;; for now. @@ -392,7 +396,7 @@ The other options should be self-descriptive." (unless (= ENOENT (system-error-errno args)) (apply throw args)))) (copy-recursively #$(authorized-key-directory - (openssh-authorized-keys config)) + (openssh-configuration-authorized-keys config)) "/etc/ssh/authorized_keys.d") (chmod "/etc/ssh/authorized_keys.d" #o555) @@ -402,9 +406,10 @@ The other options should be self-descriptive." (unless (file-exists? lastlog) (touch lastlog)))) - ;; Generate missing host keys. - (system* (string-append #$(openssh-configuration-openssh config) - "/bin/ssh-keygen") "-A")))) + (when #$(openssh-configuration-generate-host-keys? config) + ;; Generate missing host keys. + (system* (string-append #$(openssh-configuration-openssh config) + "/bin/ssh-keygen") "-A"))))) (define (authorized-key-directory keys) "Return a directory containing the authorized keys specified in KEYS, a list @@ -536,10 +541,11 @@ of user-name/file-like tuples." (openssh-configuration (inherit config) (authorized-keys - (match (openssh-authorized-keys config) + (match (openssh-configuration-authorized-keys config) (((users _ ...) ...) ;; Build a user/key-list mapping. - (let ((user-keys (alist->vhash (openssh-authorized-keys config)))) + (let ((user-keys (alist->vhash + (openssh-configuration-authorized-keys config)))) ;; Coalesce the key lists associated with each user. (map (lambda (user) `(,user diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index 66ae1a1565..70d4d6c34c 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com> -;;; Copyright © 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2020-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si> ;;; @@ -866,23 +866,23 @@ functionality of the kernel Linux."))) "Path to device or socket used to communicate with the host. If not specified, the QEMU default path is used.")) -(define qemu-guest-agent-shepherd-service - (match-lambda - (($ <qemu-guest-agent-configuration> qemu device) - (list - (shepherd-service - (provision '(qemu-guest-agent)) - (documentation "Run the QEMU guest agent.") - (start #~(make-forkexec-constructor - `(,(string-append #$qemu "/bin/qemu-ga") "--daemon" - "--pidfile=/var/run/qemu-ga.pid" - "--statedir=/var/run" - ,@(if #$device - (list (string-append "--path=" #$device)) - '())) - #:pid-file "/var/run/qemu-ga.pid" - #:log-file "/var/log/qemu-ga.log")) - (stop #~(make-kill-destructor))))))) +(define (qemu-guest-agent-shepherd-service config) + (let ((qemu (qemu-guest-agent-configuration-qemu config)) + (device (qemu-guest-agent-configuration-device config))) + (list + (shepherd-service + (provision '(qemu-guest-agent)) + (documentation "Run the QEMU guest agent.") + (start #~(make-forkexec-constructor + `(,(string-append #$qemu "/bin/qemu-ga") "--daemon" + "--pidfile=/var/run/qemu-ga.pid" + "--statedir=/var/run" + ,@(if #$device + (list (string-append "--path=" #$device)) + '())) + #:pid-file "/var/run/qemu-ga.pid" + #:log-file "/var/log/qemu-ga.log")) + (stop #~(make-kill-destructor)))))) (define qemu-guest-agent-service-type (service-type @@ -946,12 +946,20 @@ can only be accessed by their host."))) that will be listening to receive secret keys on port 1004, TCP." (operating-system (inherit os) - ;; Arrange so that the secret service activation snippet shows up before - ;; the OpenSSH and Guix activation snippets. That way, we receive OpenSSH - ;; and Guix keys before the activation snippets try to generate fresh keys - ;; for nothing. - (services (append (operating-system-user-services os) - (list (service secret-service-type 1004)))))) + (services + ;; Turn off SSH and Guix key generation that normally happens during + ;; activation: that requires entropy and thus takes time during boot, and + ;; those keys are going to be overwritten by secrets received from the + ;; host anyway. + (cons (service secret-service-type 1004) + (modify-services (operating-system-user-services os) + (openssh-service-type + config => (openssh-configuration + (inherit config) + (generate-host-keys? #f))) + (guix-service-type + config => (guix-configuration + (generate-substitute-key? #f)))))))) ;;; diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm index 3e370ba4be..b24e9cffb3 100644 --- a/gnu/services/vpn.scm +++ b/gnu/services/vpn.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2021 Raghav Gururajan <rg@raghavgururajan.name> ;;; Copyright © 2021 jgart <jgart@dismail.de> ;;; Copyright © 2021 Nathan Dehnel <ncdehnel@gmail.com> +;;; Copyright © 2022 Cameron V Chaparro <cameron@cameronchaparro.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -494,7 +495,8 @@ is truncated and rewritten every minute.") (list (string-append #$openvpn "/sbin/openvpn") "--writepid" #$pid-file "--config" #$config-file "--daemon") - #:pid-file #$pid-file)) + #:pid-file #$pid-file + #:log-file #$log-file)) (stop #~(make-kill-destructor))))))) (define %openvpn-accounts diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 3fe58d98e6..2c7df19222 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -1782,6 +1782,12 @@ WSGIPassAuthorization On (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) +(define %mumi-log "/var/log/mumi.log") + +(define %mumi-mailer-log "/var/log/mumi.mailer.log") + +(define %mumi-worker-log "/var/log/mumi.worker.log") + (define (mumi-shepherd-services config) (define environment #~(list "LC_ALL=en_US.utf8" @@ -1799,7 +1805,7 @@ WSGIPassAuthorization On ,@(if #$mailer? '() '("--disable-mailer"))) #:environment-variables #$environment #:user "mumi" #:group "mumi" - #:log-file "/var/log/mumi.log")) + #:log-file #$%mumi-log)) (stop #~(make-kill-destructor))) (shepherd-service (provision '(mumi-worker)) @@ -1809,7 +1815,7 @@ WSGIPassAuthorization On '(#$(file-append mumi "/bin/mumi") "worker") #:environment-variables #$environment #:user "mumi" #:group "mumi" - #:log-file "/var/log/mumi.worker.log")) + #:log-file #$%mumi-worker-log)) (stop #~(make-kill-destructor))) (shepherd-service (provision '(mumi-mailer)) @@ -1825,9 +1831,15 @@ WSGIPassAuthorization On '())) #:environment-variables #$environment #:user "mumi" #:group "mumi" - #:log-file "/var/log/mumi.mailer.log")) + #:log-file #$%mumi-mailer-log)) (stop #~(make-kill-destructor))))))) +(define %mumi-log-rotations + (list (log-rotation + (files (list %mumi-log + %mumi-mailer-log + %mumi-worker-log))))) + (define mumi-service-type (service-type (name 'mumi) @@ -1837,7 +1849,9 @@ WSGIPassAuthorization On (service-extension account-service-type (const %mumi-accounts)) (service-extension shepherd-root-service-type - mumi-shepherd-services))) + mumi-shepherd-services) + (service-extension rottlog-service-type + (const %mumi-log-rotations)))) (description "Run Mumi, a Web interface to the Debbugs bug-tracking server.") (default-value |