diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/authentication.scm | 82 | ||||
| -rw-r--r-- | gnu/services/base.scm | 266 | ||||
| -rw-r--r-- | gnu/services/cgit.scm | 12 | ||||
| -rw-r--r-- | gnu/services/configuration.scm | 172 | ||||
| -rw-r--r-- | gnu/services/dbus.scm | 22 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 62 | ||||
| -rw-r--r-- | gnu/services/file-sharing.scm | 24 | ||||
| -rw-r--r-- | gnu/services/linux.scm | 29 | ||||
| -rw-r--r-- | gnu/services/messaging.scm | 37 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 12 | ||||
| -rw-r--r-- | gnu/services/pam-mount.scm | 2 | ||||
| -rw-r--r-- | gnu/services/pm.scm | 54 | ||||
| -rw-r--r-- | gnu/services/telephony.scm | 534 | ||||
| -rw-r--r-- | gnu/services/vpn.scm | 2 |
14 files changed, 815 insertions, 495 deletions
diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm index cb0ef6d85a..f7becdfafb 100644 --- a/gnu/services/authentication.scm +++ b/gnu/services/authentication.scm @@ -218,7 +218,7 @@ ;; Runtime options (threads - (maybe-number 'disabled) + maybe-number "The number of threads to start that can handle requests and perform LDAP queries. Each thread opens a separate connection to the LDAP server. The default is to start 5 threads.") @@ -243,45 +243,45 @@ messages with the specified log level or higher are logged.") "The list of LDAP server URIs. Normally, only the first server will be used with the following servers as fall-back.") (ldap-version - (maybe-string 'disabled) + maybe-string "The version of the LDAP protocol to use. The default is to use the maximum version supported by the LDAP library.") (binddn - (maybe-string 'disabled) + maybe-string "Specifies the distinguished name with which to bind to the directory server for lookups. The default is to bind anonymously.") (bindpw - (maybe-string 'disabled) + maybe-string "Specifies the credentials with which to bind. This option is only applicable when used with binddn.") (rootpwmoddn - (maybe-string 'disabled) + maybe-string "Specifies the distinguished name to use when the root user tries to modify a user's password using the PAM module.") (rootpwmodpw - (maybe-string 'disabled) + maybe-string "Specifies the credentials with which to bind if the root user tries to change a user's password. This option is only applicable when used with rootpwmoddn") ;; SASL authentication options (sasl-mech - (maybe-string 'disabled) + maybe-string "Specifies the SASL mechanism to be used when performing SASL authentication.") (sasl-realm - (maybe-string 'disabled) + maybe-string "Specifies the SASL realm to be used when performing SASL authentication.") (sasl-authcid - (maybe-string 'disabled) + maybe-string "Specifies the authentication identity to be used when performing SASL authentication.") (sasl-authzid - (maybe-string 'disabled) + maybe-string "Specifies the authorization identity to be used when performing SASL authentication.") (sasl-canonicalize? - (maybe-boolean 'disabled) + maybe-boolean "Determines whether the LDAP server host name should be canonicalised. If this is enabled the LDAP library will do a reverse host name lookup. By default, it is left up to the LDAP library whether this check is performed or @@ -289,7 +289,7 @@ not.") ;; Kerberos authentication options (krb5-ccname - (maybe-string 'disabled) + maybe-string "Set the name for the GSS-API Kerberos credentials cache.") ;; Search / mapping options @@ -302,11 +302,11 @@ not.") default scope is subtree; base scope is almost never useful for name service lookups; children scope is not supported on all servers.") (deref - (maybe-deref-option 'disabled) + maybe-deref-option "Specifies the policy for dereferencing aliases. The default policy is to never dereference aliases.") (referrals - (maybe-boolean 'disabled) + maybe-boolean "Specifies whether automatic referral chasing should be enabled. The default behaviour is to chase referrals.") (maps @@ -322,132 +322,132 @@ applies and an LDAP search filter expression.") ;; Timing / reconnect options (bind-timelimit - (maybe-number 'disabled) + maybe-number "Specifies the time limit in seconds to use when connecting to the directory server. The default value is 10 seconds.") (timelimit - (maybe-number 'disabled) + maybe-number "Specifies the time limit (in seconds) to wait for a response from the LDAP server. A value of zero, which is the default, is to wait indefinitely for searches to be completed.") (idle-timelimit - (maybe-number 'disabled) + maybe-number "Specifies the period if inactivity (in seconds) after which the con‐ nection to the LDAP server will be closed. The default is not to time out connections.") (reconnect-sleeptime - (maybe-number 'disabled) + maybe-number "Specifies the number of seconds to sleep when connecting to all LDAP servers fails. By default one second is waited between the first failure and the first retry.") (reconnect-retrytime - (maybe-number 'disabled) + maybe-number "Specifies the time after which the LDAP server is considered to be permanently unavailable. Once this time is reached retries will be done only once per this time period. The default value is 10 seconds.") ;; TLS options (ssl - (maybe-ssl-option 'disabled) + maybe-ssl-option "Specifies whether to use SSL/TLS or not (the default is not to). If 'start-tls is specified then StartTLS is used rather than raw LDAP over SSL.") (tls-reqcert - (maybe-tls-reqcert-option 'disabled) + maybe-tls-reqcert-option "Specifies what checks to perform on a server-supplied certificate. The meaning of the values is described in the ldap.conf(5) manual page.") (tls-cacertdir - (maybe-string 'disabled) + maybe-string "Specifies the directory containing X.509 certificates for peer authen‐ tication. This parameter is ignored when using GnuTLS.") (tls-cacertfile - (maybe-string 'disabled) + maybe-string "Specifies the path to the X.509 certificate for peer authentication.") (tls-randfile - (maybe-string 'disabled) + maybe-string "Specifies the path to an entropy source. This parameter is ignored when using GnuTLS.") (tls-ciphers - (maybe-string 'disabled) + maybe-string "Specifies the ciphers to use for TLS as a string.") (tls-cert - (maybe-string 'disabled) + maybe-string "Specifies the path to the file containing the local certificate for client TLS authentication.") (tls-key - (maybe-string 'disabled) + maybe-string "Specifies the path to the file containing the private key for client TLS authentication.") ;; Other options (pagesize - (maybe-number 'disabled) + maybe-number "Set this to a number greater than 0 to request paged results from the LDAP server in accordance with RFC2696. The default (0) is to not request paged results.") (nss-initgroups-ignoreusers - (maybe-ignore-users-option 'disabled) + maybe-ignore-users-option "This option prevents group membership lookups through LDAP for the specified users. Alternatively, the value 'all-local may be used. With that value nslcd builds a full list of non-LDAP users on startup.") (nss-min-uid - (maybe-number 'disabled) + maybe-number "This option ensures that LDAP users with a numeric user id lower than the specified value are ignored.") (nss-uid-offset - (maybe-number 'disabled) + maybe-number "This option specifies an offset that is added to all LDAP numeric user ids. This can be used to avoid user id collisions with local users.") (nss-gid-offset - (maybe-number 'disabled) + maybe-number "This option specifies an offset that is added to all LDAP numeric group ids. This can be used to avoid user id collisions with local groups.") (nss-nested-groups - (maybe-boolean 'disabled) + maybe-boolean "If this option is set, the member attribute of a group may point to another group. Members of nested groups are also returned in the higher level group and parent groups are returned when finding groups for a specific user. The default is not to perform extra searches for nested groups.") (nss-getgrent-skipmembers - (maybe-boolean 'disabled) + maybe-boolean "If this option is set, the group member list is not retrieved when looking up groups. Lookups for finding which groups a user belongs to will remain functional so the user will likely still get the correct groups assigned on login.") (nss-disable-enumeration - (maybe-boolean 'disabled) + maybe-boolean "If this option is set, functions which cause all user/group entries to be loaded from the directory will not succeed in doing so. This can dramatically reduce LDAP server load in situations where there are a great number of users and/or groups. This option is not recommended for most configurations.") (validnames - (maybe-string 'disabled) + maybe-string "This option can be used to specify how user and group names are verified within the system. This pattern is used to check all user and group names that are requested and returned from LDAP.") (ignorecase - (maybe-boolean 'disabled) + maybe-boolean "This specifies whether or not to perform searches using case-insensitive matching. Enabling this could open up the system to authorization bypass vulnerabilities and introduce nscd cache poisoning vulnerabilities which allow denial of service.") (pam-authc-ppolicy - (maybe-boolean 'disabled) + maybe-boolean "This option specifies whether password policy controls are requested and handled from the LDAP server when performing user authentication.") (pam-authc-search - (maybe-string 'disabled) + maybe-string "By default nslcd performs an LDAP search with the user's credentials after BIND (authentication) to ensure that the BIND operation was successful. The default search is a simple check to see if the user's DN exists. A search filter can be specified that will be used instead. It should return at least one entry.") (pam-authz-search - (maybe-string 'disabled) + maybe-string "This option allows flexible fine tuning of the authorisation check that should be performed. The search filter specified is executed and if any entries match, access is granted, otherwise access is denied.") (pam-password-prohibit-message - (maybe-string 'disabled) + maybe-string "If this option is set password modification using pam_ldap will be denied and the specified message will be presented to the user instead. The message can be used to direct the user to an alternative means of changing their diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 6865d03f25..d58afb27e3 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -16,7 +16,9 @@ ;;; Copyright © 2021 qblade <qblade@protonmail.com> ;;; Copyright © 2021 Hui Lu <luhuins@163.com> ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021 muradm <mail@muradm.net> ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net> +;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li> ;;; ;;; This file is part of GNU Guix. ;;; @@ -187,6 +189,12 @@ guix-configuration-extra-options guix-configuration-log-file + guix-extension + guix-extension? + guix-extension-authorized-keys + guix-extension-substitute-urls + guix-extension-chroot-directories + guix-service-type guix-publish-configuration guix-publish-configuration? @@ -219,6 +227,11 @@ pam-limits-service-type pam-limits-service + greetd-service-type + greetd-configuration + greetd-terminal-configuration + greetd-agreety-session + %base-services)) ;;; Commentary: @@ -1439,7 +1452,7 @@ information on the configuration file syntax." (module "pam_limits.so") (arguments '("conf=/etc/security/limits.conf"))))) (if (member (pam-service-name pam) - '("login" "su" "slim" "gdm-password" "sddm" + '("login" "greetd" "su" "slim" "gdm-password" "sddm" "sudo" "sshd")) (pam-service (inherit pam) @@ -1768,6 +1781,25 @@ proxy of 'guix-daemon'...~%") (substitute-key-authorization authorized-keys guix) #~#f)))) +(define-record-type* <guix-extension> + guix-extension make-guix-extension + guix-extension? + (authorized-keys guix-extension-authorized-keys ;list of file-like + (default '())) + (substitute-urls guix-extension-substitute-urls ;list of strings + (default '())) + (chroot-directories guix-extension-chroot-directories ;list of file-like/strings + (default '()))) + +(define (guix-extension-merge a b) + (guix-extension + (authorized-keys (append (guix-extension-authorized-keys a) + (guix-extension-authorized-keys b))) + (substitute-urls (append (guix-extension-substitute-urls a) + (guix-extension-substitute-urls b))) + (chroot-directories (append (guix-extension-chroot-directories a) + (guix-extension-chroot-directories b))))) + (define guix-service-type (service-type (name 'guix) @@ -1778,14 +1810,19 @@ proxy of 'guix-daemon'...~%") (service-extension profile-service-type (compose list guix-configuration-guix)))) - ;; Extensions can specify extra directories to add to the build chroot. - (compose concatenate) - (extend (lambda (config directories) + ;; Extensions can specify extra directories to add to the build chroot, + ;; extra substitute urls and extra authorized keys + (compose (lambda (args) (fold guix-extension-merge (guix-extension) args))) + (extend (lambda (config extension) (guix-configuration (inherit config) + (authorized-keys (append (guix-extension-authorized-keys extension) + (guix-configuration-authorized-keys config))) + (substitute-urls (append (guix-extension-substitute-urls extension) + (guix-configuration-substitute-urls config))) (chroot-directories - (append (guix-configuration-chroot-directories config) - directories))))) + (append (guix-extension-chroot-directories extension) + (guix-configuration-chroot-directories config)))))) (default-value (guix-configuration)) (description @@ -1801,7 +1838,7 @@ proxy of 'guix-daemon'...~%") (default 80)) (host guix-publish-configuration-host ;string (default "localhost")) - (advertise? guix-publish-advertise? ;boolean + (advertise? guix-publish-advertise? ;boolean (default #f)) (compression guix-publish-configuration-compression (thunked) @@ -2776,6 +2813,221 @@ to handle." (name-servers '("10.0.2.3")))) +;;; +;;; greetd-service-type -- minimal and flexible login manager daemon +;;; + +(define-record-type* <greetd-agreety-session> + greetd-agreety-session make-greetd-agreety-session + greetd-agreety-session? + (agreety greetd-agreety (default greetd)) + (command greetd-agreety-command (default (file-append bash "/bin/bash"))) + (command-args greetd-agreety-command-args (default '("-l"))) + (extra-env greetd-agreety-extra-env (default '())) + (xdg-env? greetd-agreety-xdg-env? (default #t))) + +(define greetd-agreety-tty-session-command + (match-lambda + (($ <greetd-agreety-session> _ command args extra-env) + (program-file + "agreety-tty-session-command" + #~(begin + (use-modules (ice-9 match)) + (for-each (match-lambda ((var . val) (setenv var val))) + (quote (#$@extra-env))) + (apply execl #$command #$command (list #$@args))))))) + +(define greetd-agreety-tty-xdg-session-command + (match-lambda + (($ <greetd-agreety-session> _ command args extra-env) + (program-file + "agreety-tty-xdg-session-command" + #~(begin + (use-modules (ice-9 match)) + (let* + ((username (getenv "USER")) + (useruid (passwd:uid (getpwuid username))) + (useruid (number->string useruid))) + (setenv "XDG_SESSION_TYPE" "tty") + (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))) + (for-each (match-lambda ((var . val) (setenv var val))) + (quote (#$@extra-env))) + (apply execl #$command #$command (list #$@args))))))) + +(define (make-greetd-agreety-session-command config command) + (let ((agreety (file-append (greetd-agreety config) "/bin/agreety"))) + (program-file + "agreety-command" + #~(execl #$agreety #$agreety "-c" #$command)))) + +(define (make-greetd-default-session-command config-or-command) + (cond ((greetd-agreety-session? config-or-command) + (cond ((greetd-agreety-xdg-env? config-or-command) + (make-greetd-agreety-session-command + config-or-command + (greetd-agreety-tty-xdg-session-command config-or-command))) + (#t + (make-greetd-agreety-session-command + config-or-command + (greetd-agreety-tty-session-command config-or-command))))) + (#t config-or-command))) + +(define-record-type* <greetd-terminal-configuration> + greetd-terminal-configuration make-greetd-terminal-configuration + greetd-terminal-configuration? + (greetd greetd-package (default greetd)) + (config-file-name greetd-config-file-name (thunked) + (default (default-config-file-name this-record))) + (log-file-name greetd-log-file-name (thunked) + (default (default-log-file-name this-record))) + (terminal-vt greetd-terminal-vt (default "7")) + (terminal-switch greetd-terminal-switch (default #f)) + (default-session-user greetd-default-session-user (default "greeter")) + (default-session-command greetd-default-session-command + (default (greetd-agreety-session)) + (sanitize make-greetd-default-session-command))) + +(define (default-config-file-name config) + (string-join (list "config-" (greetd-terminal-vt config) ".toml") "")) + +(define (default-log-file-name config) + (string-join (list "/var/log/greetd-" (greetd-terminal-vt config) ".log") "")) + +(define (make-greetd-terminal-configuration-file config) + (let* + ((config-file-name (greetd-config-file-name config)) + (terminal-vt (greetd-terminal-vt config)) + (terminal-switch (greetd-terminal-switch config)) + (default-session-user (greetd-default-session-user config)) + (default-session-command (greetd-default-session-command config))) + (mixed-text-file + config-file-name + "[terminal]\n" + "vt = " terminal-vt "\n" + "switch = " (if terminal-switch "true" "false") "\n" + "[default_session]\n" + "user = " default-session-user "\n" + "command = " default-session-command "\n"))) + +(define %greetd-accounts + (list (user-account + (name "greeter") + (group "wheel") + (supplementary-groups '("users" "tty" "input" "video" "audio")) + (system? #t)))) + +(define %greetd-file-systems + (list (file-system + (device "none") + (mount-point "/run/greetd/pam_mount") + (type "tmpfs") + (check? #f) + (flags '(no-suid no-dev no-exec)) + (options "mode=0755") + (create-mount-point? #t)))) + +(define %greetd-pam-mount-rules + `((debug (@ (enable "0"))) + (volume (@ (sgrp "users") + (fstype "tmpfs") + (mountpoint "/run/user/%(USERUID)") + (options "noexec,nosuid,nodev,size=1g,mode=0700,uid=%(USERUID),gid=%(USERGID)"))) + (logout (@ (wait "0") + (hup "0") + (term "yes") + (kill "no"))) + (mkmountpoint (@ (enable "1") (remove "true"))))) + +(define-record-type* <greetd-configuration> + greetd-configuration make-greetd-configuration + greetd-configuration? + (motd greetd-motd (default %default-motd)) + (allow-empty-passwords? greetd-allow-empty-passwords? (default #t)) + (terminals greetd-terminals (default '()))) + +(define (make-greetd-pam-mount-conf-file config) + (computed-file + "greetd_pam_mount.conf.xml" + #~(begin + (use-modules (sxml simple)) + (call-with-output-file #$output + (lambda (port) + (sxml->xml + '(*TOP* + (*PI* xml "version='1.0' encoding='utf-8'") + (pam_mount + #$@%greetd-pam-mount-rules + (pmvarrun + #$(file-append greetd-pam-mount + "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'")))) + port)))))) + +(define (greetd-etc-service config) + `(("security/greetd_pam_mount.conf.xml" + ,(make-greetd-pam-mount-conf-file config)))) + +(define (greetd-pam-service config) + (define optional-pam-mount + (pam-entry + (control "optional") + (module #~(string-append #$greetd-pam-mount "/lib/security/pam_mount.so")) + (arguments '("disable_interactive")))) + + (list + (unix-pam-service "greetd" + #:login-uid? #t + #:allow-empty-passwords? + (greetd-allow-empty-passwords? config) + #:motd + (greetd-motd config)) + (lambda (pam) + (if (member (pam-service-name pam) + '("login" "greetd" "su" "slim" "gdm-password")) + (pam-service + (inherit pam) + (auth (append (pam-service-auth pam) + (list optional-pam-mount))) + (session (append (pam-service-session pam) + (list optional-pam-mount)))) + pam)))) + +(define (greetd-shepherd-services config) + (map + (lambda (tc) + (let* + ((greetd-bin (file-append (greetd-package tc) "/sbin/greetd")) + (greetd-conf (make-greetd-terminal-configuration-file tc)) + (greetd-log (greetd-log-file-name tc)) + (greetd-vt (greetd-terminal-vt tc))) + (shepherd-service + (documentation "Minimal and flexible login manager daemon") + (requirement '(user-processes host-name udev virtual-terminal)) + (provision (list (symbol-append + 'term-tty + (string->symbol (greetd-terminal-vt tc))))) + (start #~(make-forkexec-constructor + (list #$greetd-bin "-c" #$greetd-conf) + #:log-file #$greetd-log)) + (stop #~(make-kill-destructor))))) + (greetd-terminals config))) + +(define greetd-service-type + (service-type + (name 'greetd) + (description "Provides necessary infrastructure for logging into the +system including @code{greetd} PAM service, @code{pam-mount} module to +mount/unmount /run/user/<uid> directory for user and @code{greetd} +login manager daemon.") + (extensions + (list + (service-extension account-service-type (const %greetd-accounts)) + (service-extension file-system-service-type (const %greetd-file-systems)) + (service-extension etc-service-type greetd-etc-service) + (service-extension pam-root-service-type greetd-pam-service) + (service-extension shepherd-root-service-type greetd-shepherd-services))) + (default-value (greetd-configuration)))) + + (define %base-services ;; Convenience variable holding the basic services. (list (service login-service-type) diff --git a/gnu/services/cgit.scm b/gnu/services/cgit.scm index bfc89a40a4..c2c003983a 100644 --- a/gnu/services/cgit.scm +++ b/gnu/services/cgit.scm @@ -241,27 +241,27 @@ is no suitable HEAD.") (repo-file-object "") "Override the default @code{email-filter}.") (enable-commit-graph? - (maybe-repo-boolean 'disabled) + maybe-repo-boolean "A flag which can be used to disable the global setting @code{enable-commit-graph?}.") (enable-log-filecount? - (maybe-repo-boolean 'disabled) + maybe-repo-boolean "A flag which can be used to disable the global setting @code{enable-log-filecount?}.") (enable-log-linecount? - (maybe-repo-boolean 'disabled) + maybe-repo-boolean "A flag which can be used to disable the global setting @code{enable-log-linecount?}.") (enable-remote-branches? - (maybe-repo-boolean 'disabled) + maybe-repo-boolean "Flag which, when set to @code{#t}, will make cgit display remote branches in the summary and refs views.") (enable-subject-links? - (maybe-repo-boolean 'disabled) + maybe-repo-boolean "A flag which can be used to override the global setting @code{enable-subject-links?}.") (enable-html-serving? - (maybe-repo-boolean 'disabled) + maybe-repo-boolean "A flag which can be used to override the global setting @code{enable-html-serving?}.") (hide? diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 0de350a4df..f6b20fb82b 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -92,7 +93,7 @@ (define (configuration-missing-field kind field) (configuration-error (format #f "~a configuration missing required field ~a" kind field))) -(define (configuration-no-default-value kind field) +(define (configuration-missing-default-value kind field) (configuration-error (format #f "The field `~a' of the `~a' configuration record \ does not have a default value" field kind))) @@ -141,7 +142,8 @@ does not have a default value" field kind))) (id #'stem #'serialize-maybe- #'stem)))) #`(begin (define (maybe-stem? val) - (or (eq? val 'disabled) (stem? val))) + (or (unspecified? val) + (stem? val))) #,@(if serialize? (list #'(define (serialize-maybe-stem field-name val) (if (stem? val) @@ -162,78 +164,88 @@ does not have a default value" field kind))) (define-syntax-rule (define-maybe/no-serialization stem) (define-maybe stem (no-serialization))) +(define (normalize-field-type+def s) + (syntax-case s () + ((field-type def) + (identifier? #'field-type) + (values #'(field-type def))) + ((field-type) + (identifier? #'field-type) + (values #'(field-type *unspecified*))) + (field-type + (identifier? #'field-type) + (values #'(field-type *unspecified*))))) + (define (define-configuration-helper serialize? serializer-prefix syn) (syntax-case syn () - ((_ stem (field (field-type def ...) doc custom-serializer ...) ...) - (with-syntax (((field-getter ...) - (map (lambda (field) - (id #'stem #'stem #'- field)) - #'(field ...))) - ((field-predicate ...) - (map (lambda (type) - (id #'stem type #'?)) - #'(field-type ...))) - ((field-default ...) - (map (match-lambda - ((field-type default-value) - default-value) - ((field-type) - ;; Quote `undefined' to prevent a possibly - ;; unbound warning. - (syntax 'undefined))) - #'((field-type def ...) ...))) - ((field-serializer ...) - (map (lambda (type custom-serializer) - (and serialize? - (match custom-serializer - ((serializer) - serializer) - (() - (if serializer-prefix - (id #'stem - serializer-prefix - #'serialize- type) - (id #'stem #'serialize- type)))))) - #'(field-type ...) - #'((custom-serializer ...) ...)))) - #`(begin - (define-record-type* #,(id #'stem #'< #'stem #'>) - #,(id #'stem #'% #'stem) - #,(id #'stem #'make- #'stem) - #,(id #'stem #'stem #'?) - (%location #,(id #'stem #'stem #'-location) - (default (and=> (current-source-location) - source-properties->location)) - (innate)) - #,@(map (lambda (name getter def) - (if (eq? (syntax->datum def) (quote 'undefined)) - #`(#,name #,getter) - #`(#,name #,getter (default #,def)))) - #'(field ...) - #'(field-getter ...) - #'(field-default ...))) - (define #,(id #'stem #'stem #'-fields) - (list (configuration-field - (name 'field) - (type 'field-type) - (getter field-getter) - (predicate field-predicate) - (serializer field-serializer) - (default-value-thunk - (lambda () - (display '#,(id #'stem #'% #'stem)) - (if (eq? (syntax->datum field-default) - 'undefined) - (configuration-no-default-value - '#,(id #'stem #'% #'stem) 'field) - field-default))) - (documentation doc)) - ...)) - (define-syntax-rule (stem arg (... ...)) - (let ((conf (#,(id #'stem #'% #'stem) arg (... ...)))) - (validate-configuration conf - #,(id #'stem #'stem #'-fields)) - conf))))))) + ((_ stem (field field-type+def doc custom-serializer ...) ...) + (with-syntax + ((((field-type def) ...) + (map normalize-field-type+def #'(field-type+def ...)))) + (with-syntax + (((field-getter ...) + (map (lambda (field) + (id #'stem #'stem #'- field)) + #'(field ...))) + ((field-predicate ...) + (map (lambda (type) + (id #'stem type #'?)) + #'(field-type ...))) + ((field-default ...) + (map (match-lambda + ((field-type default-value) + default-value)) + #'((field-type def) ...))) + ((field-serializer ...) + (map (lambda (type custom-serializer) + (and serialize? + (match custom-serializer + ((serializer) + serializer) + (() + (if serializer-prefix + (id #'stem + serializer-prefix + #'serialize- type) + (id #'stem #'serialize- type)))))) + #'(field-type ...) + #'((custom-serializer ...) ...)))) + #`(begin + (define-record-type* #,(id #'stem #'< #'stem #'>) + #,(id #'stem #'% #'stem) + #,(id #'stem #'make- #'stem) + #,(id #'stem #'stem #'?) + (%location #,(id #'stem #'stem #'-location) + (default (and=> (current-source-location) + source-properties->location)) + (innate)) + #,@(map (lambda (name getter def) + #`(#,name #,getter (default #,def))) + #'(field ...) + #'(field-getter ...) + #'(field-default ...))) + (define #,(id #'stem #'stem #'-fields) + (list (configuration-field + (name 'field) + (type 'field-type) + (getter field-getter) + (predicate field-predicate) + (serializer field-serializer) + (default-value-thunk + (lambda () + (display '#,(id #'stem #'% #'stem)) + (if (eq? (syntax->datum field-default) + '*unspecified*) + (configuration-missing-default-value + '#,(id #'stem #'% #'stem) 'field) + field-default))) + (documentation doc)) + ...)) + (define-syntax-rule (stem arg (... ...)) + (let ((conf (#,(id #'stem #'% #'stem) arg (... ...)))) + (validate-configuration conf + #,(id #'stem #'stem #'-fields)) + conf)))))))) (define no-serialization ;syntactic keyword for 'define-configuration' '(no serialization)) @@ -241,26 +253,26 @@ does not have a default value" field kind))) (define-syntax define-configuration (lambda (s) (syntax-case s (no-serialization prefix) - ((_ stem (field (field-type def ...) doc custom-serializer ...) ... + ((_ stem (field field-type+def doc custom-serializer ...) ... (no-serialization)) (define-configuration-helper - #f #f #'(_ stem (field (field-type def ...) doc custom-serializer ...) + #f #f #'(_ stem (field field-type+def doc custom-serializer ...) ...))) - ((_ stem (field (field-type def ...) doc custom-serializer ...) ... + ((_ stem (field field-type+def doc custom-serializer ...) ... (prefix serializer-prefix)) (define-configuration-helper - #t #'serializer-prefix #'(_ stem (field (field-type def ...) + #t #'serializer-prefix #'(_ stem (field field-type+def doc custom-serializer ...) ...))) - ((_ stem (field (field-type def ...) doc custom-serializer ...) ...) + ((_ stem (field field-type+def doc custom-serializer ...) ...) (define-configuration-helper - #t #f #'(_ stem (field (field-type def ...) doc custom-serializer ...) + #t #f #'(_ stem (field field-type+def doc custom-serializer ...) ...)))))) (define-syntax-rule (define-configuration/no-serialization - stem (field (field-type def ...) + stem (field field-type+def doc custom-serializer ...) ...) - (define-configuration stem (field (field-type def ...) + (define-configuration stem (field field-type+def doc custom-serializer ...) ... (no-serialization))) diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index ef6b82c572..52cb1e3a51 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -53,7 +53,9 @@ (dbus dbus-configuration-dbus ;file-like (default dbus)) (services dbus-configuration-services ;list of <package> - (default '()))) + (default '())) + (verbose? dbus-configuration-verbose? ;boolean + (default #f))) (define (system-service-directory services) "Return the system service directory, containing @code{.service} files for @@ -191,7 +193,7 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (define dbus-shepherd-service (match-lambda - (($ <dbus-configuration> dbus) + (($ <dbus-configuration> dbus _ verbose?) (list (shepherd-service (documentation "Run the D-Bus system daemon.") (provision '(dbus-system)) @@ -199,6 +201,12 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (start #~(make-forkexec-constructor (list (string-append #$dbus "/bin/dbus-daemon") "--nofork" "--system" "--syslog-only") + #$@(if verbose? + ;; Since the verbose output goes to the console, + ;; not syslog, add a log file to capture it. + '(#:environment-variables '("DBUS_VERBOSE=1") + #:log-file "/var/log/dbus-daemon.log") + '()) #:pid-file "/var/run/dbus/pid")) (stop #~(make-kill-destructor))))))) @@ -234,9 +242,12 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in bus. It allows programs and daemons to communicate and is also responsible for spawning (@dfn{activating}) D-Bus services on demand."))) -(define* (dbus-service #:key (dbus dbus) (services '())) +(define* (dbus-service #:key (dbus dbus) (services '()) verbose?) "Return a service that runs the \"system bus\", using @var{dbus}, with -support for @var{services}. +support for @var{services}. When @var{verbose?} is true, it causes the +@samp{DBUS_VERBOSE} environment variable to be set to @samp{1}; a +verbose-enabled D-Bus package such as @code{dbus-verbose} should be provided +as @var{dbus} in this scenario. @uref{http://dbus.freedesktop.org/, D-Bus} is an inter-process communication facility. Its system bus is used to allow system services to communicate and @@ -248,7 +259,8 @@ and policy files. For example, to allow avahi-daemon to use the system bus, @var{services} must be equal to @code{(list avahi)}." (service dbus-root-service-type (dbus-configuration (dbus dbus) - (services services)))) + (services services) + (verbose? verbose?)))) (define (wrapped-dbus-service service program variables) "Return a wrapper for @var{service}, a package containing a D-Bus service, diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 0499071436..29a3722f1b 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -13,6 +13,7 @@ ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org> ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2021 muradm <mail@muradm.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,7 +40,9 @@ #:use-module (gnu services networking) #:use-module (gnu services sound) #:use-module ((gnu system file-systems) - #:select (%elogind-file-systems file-system)) + #:select (%control-groups + %elogind-file-systems + file-system)) #:autoload (gnu services sddm) (sddm-service-type) #:use-module (gnu system) #:use-module (gnu system setuid) @@ -157,6 +160,9 @@ gnome-keyring-configuration? gnome-keyring-service-type + seatd-configuration + seatd-service-type + %desktop-services)) ;;; Commentary: @@ -1632,6 +1638,60 @@ or setting its password with passwd."))) ;;; +;;; seatd-service-type -- minimal seat management daemon +;;; + +(define-record-type* <seatd-configuration> seatd-configuration + make-seatd-configuration + seatd-configuration? + (seatd seatd-package (default seatd)) + (user seatd-user (default "root")) + (group seatd-group (default "users")) + (socket seatd-socket (default "/run/seatd.sock")) + (logfile seatd-logfile (default "/var/log/seatd.log")) + (loglevel seatd-loglevel (default "info"))) + +(define (seatd-shepherd-service config) + (list (shepherd-service + (documentation "Minimal seat management daemon") + (requirement '()) + ;; TODO: once cgroups is separate dependency + ;; here we should depend on it rather than elogind + (provision '(seatd elogind)) + (start #~(make-forkexec-constructor + (list #$(file-append (seatd-package config) "/bin/seatd") + "-u" #$(seatd-user config) + "-g" #$(seatd-group config)) + #:environment-variables + (list (string-append "SEATD_LOGLEVEL=" + #$(seatd-loglevel config)) + (string-append "SEATD_DEFAULTPATH=" + #$(seatd-socket config))) + #:log-file #$(seatd-logfile config))) + (stop #~(make-kill-destructor))))) + +(define seatd-environment + (match-lambda + (($ <seatd-configuration> _ _ _ socket) + `(("SEATD_SOCK" . ,socket))))) + +(define seatd-service-type + (service-type + (name 'seatd) + (description "Seat management takes care of mediating access +to shared devices (graphics, input), without requiring the +applications needing access to be root.") + (extensions + (list + (service-extension session-environment-service-type seatd-environment) + ;; TODO: once cgroups is separate dependency we should not mount it here + ;; for now it is mounted here, because elogind mounts it + (service-extension file-system-service-type (const %control-groups)) + (service-extension shepherd-root-service-type seatd-shepherd-service))) + (default-value (seatd-configuration)))) + + +;;; ;;; The default set of desktop services. ;;; diff --git a/gnu/services/file-sharing.scm b/gnu/services/file-sharing.scm index e3d681b08f..e32d1f145d 100644 --- a/gnu/services/file-sharing.scm +++ b/gnu/services/file-sharing.scm @@ -115,8 +115,7 @@ type generated and used by Transmission clients, suitable for passing to the (set! serialize-maybe-string (lambda (field-name val) (serialize-string field-name - (if (and (symbol? val) - (eq? val 'disabled)) + (if (unspecified? val) "" val)))) @@ -181,8 +180,7 @@ type generated and used by Transmission clients, suitable for passing to the (define-maybe file-object) (set! serialize-maybe-file-object (lambda (field-name val) - (if (and (symbol? val) - (eq? val 'disabled)) + (if (unspecified? val) (serialize-string field-name "") (serialize-file-object field-name val)))) @@ -281,7 +279,7 @@ torrent is being downloaded, then moved to @code{download-dir} once the torrent is complete. Otherwise, files for all torrents (including those still being downloaded) will be placed in @code{download-dir}.") (incomplete-dir - (maybe-string 'disabled) + maybe-string "The directory in which files from incompletely downloaded torrents will be held when @code{incomplete-dir-enabled?} is @code{#t}.") (umask @@ -305,7 +303,7 @@ for new @file{.torrent} files and the torrents they describe added automatically (and the original files removed, if @code{trash-original-torrent-files?} is @code{#t}).") (watch-dir - (maybe-string 'disabled) + maybe-string "The directory to be watched for @file{.torrent} files indicating new torrents to be added, when @code{watch-dir-enabled} is @code{#t}.") (trash-original-torrent-files? @@ -401,11 +399,11 @@ upstream gateway automatically using @acronym{UPnP} and @acronym{NAT-PMP}.") @code{prefer-unencrypted-connections}, @code{prefer-encrypted-connections} or @code{require-encrypted-connections}.") (peer-congestion-algorithm - (maybe-string 'disabled) + maybe-string "The TCP congestion-control algorithm to use for peer connections, specified using a string recognized by the operating system in calls to -@code{setsockopt} (or set to @code{disabled}, in which case the -operating-system default is used). +@code{setsockopt} (or leave it unset, in which case the operating-system +default is used). Note that on GNU/Linux systems, the kernel must be configured to allow processes to use a congestion-control algorithm not in the default set; @@ -465,7 +463,7 @@ torrent before it is regenerated.") "When @code{#t}, the daemon will ignore peers mentioned in the blocklist it has most recently downloaded from @code{blocklist-url}.") (blocklist-url - (maybe-string 'disabled) + maybe-string "The URL of a peer blocklist (in @acronym{P2P}-plaintext or eMule @file{.dat} format) to be periodically downloaded and applied when @code{blocklist-enabled?} is @code{#t}.") @@ -564,11 +562,11 @@ which allows remote control of the daemon via its Web interface, the the side effect of disabling host-name whitelisting (see @code{rpc-host-whitelist-enabled?}.") (rpc-username - (maybe-string 'disabled) + maybe-string "The username required by clients to access the @acronym{RPC} interface when @code{rpc-authentication-required?} is @code{#t}.") (rpc-password - (maybe-transmission-password-hash 'disabled) + maybe-transmission-password-hash "The password required by clients to access the @acronym{RPC} interface when @code{rpc-authentication-required?} is @code{#t}. This must be specified using a password hash in the format recognized by Transmission clients, either @@ -613,7 +611,7 @@ they are added in ``paused'' state.") @code{script-torrent-done-filename} will be invoked each time a torrent completes.") (script-torrent-done-filename - (maybe-file-object 'disabled) + maybe-file-object "A file name or file-like object specifying a script to run each time a torrent completes, when @code{script-torrent-done-enabled?} is @code{#t}.") (scrape-paused-torrents-enabled? diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index 2eb02ac5a3..60e2093e1d 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> ;;; Copyright © 2021 B. Wilson <elaexuotee@wilsonb.com> +;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,9 +22,12 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services linux) + #:use-module (guix diagnostics) #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix modules) + #:use-module (guix i18n) + #:use-module (guix ui) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services shepherd) @@ -252,7 +256,21 @@ representation." (memory-limit zram-device-configuration-memory-limit (default 0)) ; string or integer (priority zram-device-configuration-priority - (default -1))) ; integer + (default #f) ; integer | #f + (delayed) ; to avoid printing the deprecation + ; warning multiple times + (sanitize warn-zram-priority-change))) + +(define-with-syntax-properties + (warn-zram-priority-change (priority properties)) + (if (eqv? priority -1) + (begin + (warning (source-properties->location properties) + (G_ "using -1 for zram priority is deprecated~%")) + (display-hint (G_ "Use #f or leave as default instead (@pxref{Linux \ +Services}).")) + #f) + priority)) (define (zram-device-configuration->udev-string config) "Translate a <zram-device-configuration> into a string which can be @@ -278,9 +296,12 @@ placed in a udev rules file." "") "RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" " "RUN+=\"/run/current-system/profile/sbin/swapon " - (if (not (equal? -1 priority)) - (string-append "--priority " (number->string priority) " ") - "") + ;; TODO: Revert to simply use 'priority' after removing the deprecation + ;; warning and the delayed property of the field. + (let ((priority* (force priority))) + (if priority* + (format #f "--priority ~a " priority*) + "")) "/dev/zram0\"\n")))) (define %zram-device-config diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 48eff27b49..651f90adb2 100644 --- a/gnu/services/messaging.scm +++ b/gnu/services/messaging.scm @@ -76,6 +76,7 @@ (lambda (field target) (and (memq (syntax->datum target) `(common ,arg)) field))) (syntax-case stx () + ;; TODO Also handle (field-type) form, without a default. ((_ stem (field (field-type def) doc target) ...) (with-syntax (((new-field-type ...) (map (lambda (field-type target) @@ -89,7 +90,7 @@ ((new-def ...) (map (lambda (def target) (if (eq? 'common (syntax->datum target)) - #''disabled def)) + #'*unspecified* def)) #'(def ...) #'(target ...))) ((new-doc ...) (map (lambda (doc target) @@ -199,7 +200,7 @@ (define-maybe file-object-list) (define (raw-content? val) - (not (eq? val 'disabled))) + (not (unspecified? val))) (define (serialize-raw-content field-name val) val) (define-maybe raw-content) @@ -227,15 +228,15 @@ just joined the room.")) (define-configuration ssl-configuration (protocol - (maybe-string 'disabled) + maybe-string "This determines what handshake to use.") (key - (maybe-file-name 'disabled) + maybe-file-name "Path to your private key file.") (certificate - (maybe-file-name 'disabled) + maybe-file-name "Path to your certificate file.") (capath @@ -244,48 +245,48 @@ just joined the room.")) trust when verifying the certificates of remote servers.") (cafile - (maybe-file-object 'disabled) + maybe-file-object "Path to a file containing root certificates that you wish Prosody to trust. Similar to @code{capath} but with all certificates concatenated together.") (verify - (maybe-string-list 'disabled) + maybe-string-list "A list of verification options (these mostly map to OpenSSL's @code{set_verify()} flags).") (options - (maybe-string-list 'disabled) + maybe-string-list "A list of general options relating to SSL/TLS. These map to OpenSSL's @code{set_options()}. For a full list of options available in LuaSec, see the LuaSec source.") (depth - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "How long a chain of certificate authorities to check when looking for a trusted root certificate.") (ciphers - (maybe-string 'disabled) + maybe-string "An OpenSSL cipher string. This selects what ciphers Prosody will offer to clients, and in what order.") (dhparam - (maybe-file-name 'disabled) + maybe-file-name "A path to a file containing parameters for Diffie-Hellman key exchange. You can create such a file with: @code{openssl dhparam -out /etc/prosody/certs/dh-2048.pem 2048}") (curve - (maybe-string 'disabled) + maybe-string "Curve for Elliptic curve Diffie-Hellman. Prosody's default is @samp{\"secp384r1\"}.") (verifyext - (maybe-string-list 'disabled) + maybe-string-list "A list of \"extra\" verification options.") (password - (maybe-string 'disabled) + maybe-string "Password for encrypted private keys.")) (define (serialize-ssl-configuration field-name val) #~(format #f "ssl = {\n~a};\n" @@ -473,12 +474,12 @@ by the Prosody service. See @url{https://prosody.im/doc/logging}." global) (http-max-content-size - (maybe-non-negative-integer 'disabled) + (maybe-non-negative-integer *unspecified*) "Maximum allowed size of the HTTP body (in bytes)." common) (http-external-url - (maybe-string 'disabled) + (maybe-string *unspecified*) "Some modules expose their own URL in various ways. This URL is built from the protocol, host and port used. If Prosody sits behind a proxy, the public URL will be @code{http-external-url} instead. See @@ -555,7 +556,7 @@ support. To add an external component, you simply fill the hostname field. See int-component) (mod-muc - (maybe-mod-muc-configuration 'disabled) + (maybe-mod-muc-configuration *unspecified*) "Multi-user chat (MUC) is Prosody's module for allowing you to create hosted chatrooms/conferences for XMPP users. @@ -572,7 +573,7 @@ See also @url{https://prosody.im/doc/modules/mod_muc}." ext-component) (raw-content - (maybe-raw-content 'disabled) + (maybe-raw-content *unspecified*) "Raw content that will be added to the configuration file." common))) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 90b9317510..a9560db66b 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -771,17 +771,17 @@ logging is disabled.") "The node host name that is used to make the first connection to the network. A specific port value can be provided by appending the @code{:PORT} suffix. By default, it uses the Jami bootstrap nodes, but any host can be -specified here. It's also possible to disable bootstrapping by setting this -to the @code{'disabled} symbol.") +specified here. It's also possible to disable bootstrapping by explicitly +setting this field to the @code{*unspecified*} value.") (port (maybe-number 4222) - "The UDP port to bind to. When set to @code{'disabled}, an available port -is automatically selected.") + "The UDP port to bind to. When set to @code{*unspecified*}, an available +port is automatically selected.") (proxy-server-port - (maybe-number 'disabled) + maybe-number "Spawn a proxy server listening on the specified port.") (proxy-server-port-tls - (maybe-number 'disabled) + maybe-number "Spawn a proxy server listening to TLS connections on the specified port.")) diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm index 33649b0f7c..e60781d05b 100644 --- a/gnu/services/pam-mount.scm +++ b/gnu/services/pam-mount.scm @@ -90,7 +90,7 @@ (module #~(string-append #$pam-mount "/lib/security/pam_mount.so")))) (list (lambda (pam) (if (member (pam-service-name pam) - '("login" "su" "slim" "gdm-password" "sddm")) + '("login" "greetd" "su" "slim" "gdm-password" "sddm")) (pam-service (inherit pam) (auth (append (pam-service-auth pam) diff --git a/gnu/services/pm.scm b/gnu/services/pm.scm index e48236dbca..3daf484cc1 100644 --- a/gnu/services/pm.scm +++ b/gnu/services/pm.scm @@ -114,55 +114,55 @@ before syncing on AC.") "Same as @code{max-lost-work-secs-on-ac} but on BAT mode.") (cpu-scaling-governor-on-ac - (maybe-space-separated-string-list 'disabled) + maybe-space-separated-string-list "CPU frequency scaling governor on AC mode. With intel_pstate driver, alternatives are powersave and performance. With acpi-cpufreq driver, alternatives are ondemand, powersave, performance and conservative.") (cpu-scaling-governor-on-bat - (maybe-space-separated-string-list 'disabled) + maybe-space-separated-string-list "Same as @code{cpu-scaling-governor-on-ac} but on BAT mode.") (cpu-scaling-min-freq-on-ac - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Set the min available frequency for the scaling governor on AC.") (cpu-scaling-max-freq-on-ac - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Set the max available frequency for the scaling governor on AC.") (cpu-scaling-min-freq-on-bat - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Set the min available frequency for the scaling governor on BAT.") (cpu-scaling-max-freq-on-bat - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Set the max available frequency for the scaling governor on BAT.") (cpu-min-perf-on-ac - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Limit the min P-state to control the power dissipation of the CPU, in AC mode. Values are stated as a percentage of the available performance.") (cpu-max-perf-on-ac - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Limit the max P-state to control the power dissipation of the CPU, in AC mode. Values are stated as a percentage of the available performance.") (cpu-min-perf-on-bat - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Same as @code{cpu-min-perf-on-ac} on BAT mode.") (cpu-max-perf-on-bat - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Same as @code{cpu-max-perf-on-ac} on BAT mode.") (cpu-boost-on-ac? - (maybe-boolean 'disabled) + maybe-boolean "Enable CPU turbo boost feature on AC mode.") (cpu-boost-on-bat? - (maybe-boolean 'disabled) + maybe-boolean "Same as @code{cpu-boost-on-ac?} on BAT mode.") (sched-powersave-on-ac? @@ -179,7 +179,7 @@ used under light load conditions.") "Enable Linux kernel NMI watchdog.") (phc-controls - (maybe-string 'disabled) + maybe-string "For Linux kernels with PHC patch applied, change CPU voltages. An example value would be @samp{\"F:V F:V F:V F:V\"}.") @@ -205,16 +205,16 @@ performance, normal, powersave.") "Same as @code{disk-apm-bat} but on BAT mode.") (disk-spindown-timeout-on-ac - (maybe-space-separated-string-list 'disabled) + maybe-space-separated-string-list "Hard disk spin down timeout. One value has to be specified for each declared hard disk.") (disk-spindown-timeout-on-bat - (maybe-space-separated-string-list 'disabled) + maybe-space-separated-string-list "Same as @code{disk-spindown-timeout-on-ac} but on BAT mode.") (disk-iosched - (maybe-space-separated-string-list 'disabled) + maybe-space-separated-string-list "Select IO scheduler for disk devices. One value has to be specified for each declared hard disk. Example alternatives are cfq, deadline and noop.") @@ -228,16 +228,16 @@ min_power, medium_power, max_performance.") "Same as @code{sata-linkpwr-ac} but on BAT mode.") (sata-linkpwr-blacklist - (maybe-string 'disabled) + maybe-string "Exclude specified SATA host devices for link power management.") (ahci-runtime-pm-on-ac? - (maybe-on-off-boolean 'disabled) + maybe-on-off-boolean "Enable Runtime Power Management for AHCI controller and disks on AC mode.") (ahci-runtime-pm-on-bat? - (maybe-on-off-boolean 'disabled) + maybe-on-off-boolean "Same as @code{ahci-runtime-pm-on-ac} on BAT mode.") (ahci-runtime-pm-timeout @@ -254,19 +254,19 @@ default, performance, powersave.") "Same as @code{pcie-aspm-ac} but on BAT mode.") (start-charge-thresh-bat0 - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Percentage when battery 0 should begin charging.") (stop-charge-thresh-bat0 - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Percentage when battery 0 should stop charging.") (start-charge-thresh-bat1 - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Percentage when battery 1 should begin charging.") (stop-charge-thresh-bat1 - (maybe-non-negative-integer 'disabled) + maybe-non-negative-integer "Percentage when battery 1 should stop charging.") (radeon-power-profile-on-ac @@ -346,7 +346,7 @@ on and auto.") blacklisted ones.") (runtime-pm-blacklist - (maybe-space-separated-string-list 'disabled) + maybe-space-separated-string-list "Exclude specified PCI(e) device addresses from Runtime Power Management.") (runtime-pm-driver-blacklist @@ -359,7 +359,7 @@ Runtime Power Management.") "Enable USB autosuspend feature.") (usb-blacklist - (maybe-string 'disabled) + maybe-string "Exclude specified devices from USB autosuspend.") (usb-blacklist-wwan? @@ -367,12 +367,12 @@ Runtime Power Management.") "Exclude WWAN devices from USB autosuspend.") (usb-whitelist - (maybe-string 'disabled) + maybe-string "Include specified devices into USB autosuspend, even if they are already excluded by the driver or via @code{usb-blacklist-wwan?}.") (usb-autosuspend-disable-on-shutdown? - (maybe-boolean 'disabled) + maybe-boolean "Enable USB autosuspend before shutdown.") (restore-device-state-on-startup? diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm index d8ebc7b39d..e8bfbc88c5 100644 --- a/gnu/services/telephony.scm +++ b/gnu/services/telephony.scm @@ -26,6 +26,7 @@ #:use-module (gnu packages admin) #:use-module (gnu packages certs) #:use-module (gnu packages glib) + #:use-module (gnu packages guile-xyz) #:use-module (gnu packages jami) #:use-module (gnu packages telephony) #:use-module (guix deprecation) @@ -48,7 +49,7 @@ jami-account-name-server-uri jami-configuration - jami-configuration-jamid + jami-configuration-libjami jami-configuration-dbus jami-configuration-enable-logging? jami-configuration-debug? @@ -156,7 +157,7 @@ the @samp{root} user (i.e., not in the store), to guard against leaking the secret key material of the Jami account it contains." empty-serializer) (allowed-contacts - (maybe-account-fingerprint-list 'disabled) + maybe-account-fingerprint-list "The list of allowed contacts for the account, entered as their 40 characters long fingerprint. Messages or calls from accounts not in that list will be rejected. When unspecified, the configuration of the account archive @@ -165,7 +166,7 @@ allowance, which typically defaults to allow any contact to communicate with the account." empty-serializer) (moderators - (maybe-account-fingerprint-list 'disabled) + maybe-account-fingerprint-list "The list of contacts that should have moderation privileges (to ban, mute, etc. other users) in rendezvous conferences, entered as their 40 characters long fingerprint. When unspecified, the configuration of the account archive @@ -174,24 +175,24 @@ anyone to moderate." empty-serializer) ;; The serializable fields below are to be set with set-account-details. (rendezvous-point? - (maybe-boolean 'disabled) + maybe-boolean "Whether the account should operate in the rendezvous mode. In this mode, all the incoming audio/video calls are mixed into a conference. When left unspecified, the value from the account archive prevails.") (peer-discovery? - (maybe-boolean 'disabled) + maybe-boolean "Whether peer discovery should be enabled. Peer discovery is used to discover other OpenDHT nodes on the local network, which can be useful to maintain communication between devices on such network even when the connection to the the Internet has been lost. When left unspecified, the value from the account archive prevails.") (bootstrap-hostnames - (maybe-string-list 'disabled) + maybe-string-list "A list of hostnames or IPs pointing to OpenDHT nodes, that should be used to initially join the OpenDHT network. When left unspecified, the value from the account archive prevails.") (name-server-uri - (maybe-string 'disabled) + maybe-string "The URI of the name server to use, that can be used to retrieve the account fingerprint for a registered username.")) @@ -213,7 +214,7 @@ SET-ACCOUNT-DETAILS." name ((configuration-field-getter field) jami-account-object))) ;; The define-maybe default serializer produces an - ;; empty string for the 'disabled value. + ;; empty string for unspecified values. (value* (if (string-null? value) #f value))) @@ -227,11 +228,11 @@ SET-ACCOUNT-DETAILS." (define-maybe/no-serialization jami-account-list) (define-configuration/no-serialization jami-configuration - (jamid + (libjami (file-like libjami) "The Jami daemon package to use.") (dbus - (file-like dbus) + (file-like dbus-for-jami) "The D-Bus package to use to start the required D-Bus session.") (nss-certs (file-like nss-certs) @@ -246,7 +247,7 @@ SET-ACCOUNT-DETAILS." (boolean #f) "Whether to force automatic answer to incoming calls.") (accounts - (maybe-jami-account-list 'disabled) + maybe-jami-account-list "A list of Jami accounts to be (re-)provisioned every time the Jami daemon service starts. When providing this field, the account directories under @file{/var/lib/jami/} are recreated every time the service starts, ensuring a @@ -265,8 +266,8 @@ consistent state.")) "Derive the command line arguments to used to launch the Jami daemon from CONFIG, a <jami-configuration> object." (match-record config <jami-configuration> - (jamid dbus enable-logging? debug? auto-answer?) - `(,(file-append jamid "/libexec/jamid") + (libjami dbus enable-logging? debug? auto-answer?) + `(,(file-append libjami "/libexec/jamid") "--persistent" ;stay alive after client quits ,@(if enable-logging? '() ;logs go to syslog by default @@ -284,34 +285,48 @@ CONFIG, a <jami-configuration> object." #~(begin (use-modules (gnu build activation)) (let ((user (getpwnam "jami"))) - (mkdir-p/perms "/var/run/jami" user #o700))))) + (mkdir-p/perms "/var/run/jami" user #o700) + ;; Customize the D-Bus policy to allow 'root' to access other users' + ;; session bus. Also modify the location of the written PID file, + ;; from the default '/var/run/dbus/pid' location. This file is only + ;; honored by the 'dbus-for-jami' package variant. + (call-with-output-file "/var/run/jami/session-local.conf" + (lambda (port) + (format port "\ +<busconfig> + <pidfile>/var/run/jami/pid</pidfile> + <policy context=\"mandatory\"> + <allow user=\"root\"/> + </policy> +</busconfig>~%"))))))) (define (jami-shepherd-services config) "Return a <shepherd-service> running the Jami daemon." - (let* ((jamid (jami-configuration-jamid config)) + (let* ((libjami (jami-configuration-libjami config)) (nss-certs (jami-configuration-nss-certs config)) (dbus (jami-configuration-dbus config)) (dbus-daemon (file-append dbus "/bin/dbus-daemon")) - (dbus-send (file-append dbus "/bin/dbus-send")) (accounts (jami-configuration-accounts config)) - (declarative-mode? (not (eq? 'disabled accounts)))) - - (with-imported-modules (source-module-closure - '((gnu build jami-service) - (gnu build shepherd) - (gnu system file-systems))) - - (define list-accounts-action - (shepherd-action - (name 'list-accounts) - (documentation "List the available Jami accounts. Return the account + (declarative-mode? (not (unspecified? accounts)))) + + (with-extensions (list guile-packrat ;used by guile-ac-d-bus + guile-ac-d-bus + ;; Fibers is needed to provide the non-blocking + ;; variant of the 'sleep' procedure. + guile-fibers) + (with-imported-modules (source-module-closure + '((gnu build dbus-service) + (gnu build jami-service) + (gnu build shepherd) + (gnu system file-systems))) + + (define list-accounts-action + (shepherd-action + (name 'list-accounts) + (documentation "List the available Jami accounts. Return the account details alists keyed by their account username.") - (procedure - #~(lambda _ - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) + (procedure + #~(lambda _ ;; Print the accounts summary or long listing, according to ;; user-provided option. (let* ((usernames (get-usernames)) @@ -341,39 +356,31 @@ details alists keyed by their account username.") accounts) (display "\n"))) ;; Return the account-details-list alist. - (map cons usernames accounts))))))) + (map cons usernames accounts)))))) - (define list-account-details-action - (shepherd-action - (name 'list-account-details) - (documentation "Display the account details of the available Jami + (define list-account-details-action + (shepherd-action + (name 'list-account-details) + (documentation "Display the account details of the available Jami accounts in the @code{recutils} format. Return the account details alists keyed by their account username.") - (procedure - #~(lambda _ - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) + (procedure + #~(lambda _ (let* ((usernames (get-usernames)) (accounts (map-in-order username->account usernames))) (for-each (lambda (account) (display (account-details->recutil account)) (display "\n\n")) accounts) - (map cons usernames accounts))))))) + (map cons usernames accounts)))))) - (define list-contacts-action - (shepherd-action - (name 'list-contacts) - (documentation "Display the contacts for each Jami account. Return + (define list-contacts-action + (shepherd-action + (name 'list-contacts) + (documentation "Display the contacts for each Jami account. Return an alist containing the contacts keyed by the account usernames.") - (procedure - #~(lambda _ - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) + (procedure + #~(lambda _ (let* ((usernames (get-usernames)) (contacts (map-in-order username->contacts usernames))) (for-each (lambda (username contacts) @@ -381,19 +388,15 @@ an alist containing the contacts keyed by the account usernames.") username) (format #t "~{ - ~a~%~}~%" contacts)) usernames contacts) - (map cons usernames contacts))))))) + (map cons usernames contacts)))))) - (define list-moderators-action - (shepherd-action - (name 'list-moderators) - (documentation "Display the moderators for each Jami account. Return + (define list-moderators-action + (shepherd-action + (name 'list-moderators) + (documentation "Display the moderators for each Jami account. Return an alist containing the moderators keyed by the account usernames.") - (procedure - #~(lambda _ - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) + (procedure + #~(lambda _ (let* ((usernames (get-usernames)) (moderators (map-in-order username->moderators usernames))) @@ -406,12 +409,12 @@ an alist containing the moderators keyed by the account usernames.") (format #t "Moderators for account ~a:~%" username) (format #t "~{ - ~a~%~}~%" moderators)))) usernames moderators) - (map cons usernames moderators))))))) + (map cons usernames moderators)))))) - (define add-moderator-action - (shepherd-action - (name 'add-moderator) - (documentation "Add a moderator for a given Jami account. The + (define add-moderator-action + (shepherd-action + (name 'add-moderator) + (documentation "Add a moderator for a given Jami account. The MODERATOR contact must be given as its 40 characters fingerprint, while the Jami account can be provided as its registered USERNAME or fingerprint. @@ -420,21 +423,17 @@ herd add-moderator jami 1dbcb0f5f37324228235564b79f2b9737e9a008f username @end example Return the moderators for the account known by USERNAME.") - (procedure - #~(lambda (_ moderator username) - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) + (procedure + #~(lambda (_ moderator username) (set-all-moderators #f username) (add-contact moderator username) (set-moderator moderator #t username) - (username->moderators username)))))) + (username->moderators username))))) - (define ban-contact-action - (shepherd-action - (name 'ban-contact) - (documentation "Ban a contact for a given or all Jami accounts, and + (define ban-contact-action + (shepherd-action + (name 'ban-contact) + (documentation "Ban a contact for a given or all Jami accounts, and clear their moderator flag. The CONTACT must be given as its 40 characters fingerprint, while the Jami account can be provided as its registered USERNAME or fingerprint, or omitted. When the account is omitted, CONTACT is banned @@ -443,31 +442,22 @@ from all accounts. @example herd ban-contact jami 1dbcb0f5f37324228235564b79f2b9737e9a008f [username] @end example") - (procedure - #~(lambda* (_ contact #:optional username) - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) + (procedure + #~(lambda* (_ contact #:optional username) (let ((usernames (or (and=> username list) (get-usernames)))) (for-each (lambda (username) (set-moderator contact #f username) (remove-contact contact username #:ban? #t)) - usernames))))))) + usernames)))))) - (define list-banned-contacts-action - (shepherd-action - (name 'list-banned-contacts) - (documentation "List the banned contacts for each accounts. Return + (define list-banned-contacts-action + (shepherd-action + (name 'list-banned-contacts) + (documentation "List the banned contacts for each accounts. Return an alist of the banned contacts, keyed by the account usernames.") - (procedure - #~(lambda _ - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) - + (procedure + #~(lambda _ (define banned-contacts (let ((usernames (get-usernames))) (map cons usernames @@ -484,183 +474,157 @@ an alist of the banned contacts, keyed by the account usernames.") username) (format #t "~{ - ~a~%~}~%" banned)))) banned-contacts) - banned-contacts))))) + banned-contacts)))) - (define enable-account-action - (shepherd-action - (name 'enable-account) - (documentation "Enable an account. It takes USERNAME as an argument, + (define enable-account-action + (shepherd-action + (name 'enable-account) + (documentation "Enable an account. It takes USERNAME as an argument, either a registered username or the fingerprint of the account.") - (procedure - #~(lambda (_ username) - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) - (enable-account username)))))) - - (define disable-account-action - (shepherd-action - (name 'disable-account) - (documentation "Disable an account. It takes USERNAME as an + (procedure + #~(lambda (_ username) + (enable-account username))))) + + (define disable-account-action + (shepherd-action + (name 'disable-account) + (documentation "Disable an account. It takes USERNAME as an argument, either a registered username or the fingerprint of the account.") - (procedure - #~(lambda (_ username) - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) - (disable-account username)))))) - - (list (shepherd-service - (documentation "Run a D-Bus session for the Jami daemon.") - (provision '(jami-dbus-session)) - (modules `((gnu build shepherd) - (gnu build jami-service) - (gnu system file-systems) - ,@%default-modules)) - ;; The requirement on dbus-system is to ensure other required - ;; activation for D-Bus, such as a /etc/machine-id file. - (requirement '(dbus-system syslogd)) - (start - #~(lambda args - (define pid - ((make-forkexec-constructor/container - (list #$dbus-daemon "--session" - "--address=unix:path=/var/run/jami/bus" - "--nofork" "--syslog-only" "--nopidfile") - #:mappings (list (file-system-mapping - (source "/dev/log") ;for syslog - (target source)) - (file-system-mapping - (source "/var/run/jami") - (target source) - (writable? #t))) - #:user "jami" - #:group "jami" - #:environment-variables - ;; This is so that the cx.ring.Ring service D-Bus - ;; definition is found by dbus-send. - (list (string-append "XDG_DATA_DIRS=" - #$jamid "/share"))))) - - ;; XXX: This manual synchronization probably wouldn't be - ;; needed if we were using a PID file, but providing it via a - ;; customized config file with <pidfile> would not override - ;; the one inherited from the base config of D-Bus. - (let ((sock (socket PF_UNIX SOCK_STREAM 0))) - (with-retries 20 1 (catch 'system-error - (lambda () - (connect sock AF_UNIX - "/var/run/jami/bus") - (close-port sock) - #t) - (lambda args - #f)))) - - pid)) - (stop #~(make-kill-destructor))) - - (shepherd-service - (documentation "Run the Jami daemon.") - (provision '(jami)) - (actions (list list-accounts-action - list-account-details-action - list-contacts-action - list-moderators-action - add-moderator-action - ban-contact-action - list-banned-contacts-action - enable-account-action - disable-account-action)) - (requirement '(jami-dbus-session)) - (modules `((ice-9 format) - (ice-9 ftw) - (ice-9 match) - (ice-9 receive) - (srfi srfi-1) - (srfi srfi-26) - (gnu build jami-service) - (gnu build shepherd) - (gnu system file-systems) - ,@%default-modules)) - (start - #~(lambda args - (define (delete-file-recursively/safe file) - ;; Ensure we're not deleting things outside of - ;; /var/lib/jami. This prevents a possible attack in case - ;; the daemon is compromised and an attacker gains write - ;; access to /var/lib/jami. - (let ((parent-directory (dirname file))) - (if (eq? 'symlink (stat:type (stat parent-directory))) - (error "abnormality detected; unexpected symlink found at" - parent-directory) - (delete-file-recursively file)))) - - (when #$declarative-mode? - ;; Clear the Jami configuration and accounts, to enforce the - ;; declared state. - (catch #t - (lambda () - (for-each (cut delete-file-recursively/safe <>) - '("/var/lib/jami/.cache/jami" - "/var/lib/jami/.config/jami" - "/var/lib/jami/.local/share/jami" - "/var/lib/jami/accounts"))) - (lambda args - #t)) - ;; Copy the Jami account archives from somewhere readable - ;; by root to a place only the jami user can read. - (let* ((accounts-dir "/var/lib/jami/accounts/") - (pwd (getpwnam "jami")) - (user (passwd:uid pwd)) - (group (passwd:gid pwd))) - (mkdir-p accounts-dir) - (chown accounts-dir user group) - (for-each (lambda (f) - (let ((dest (string-append accounts-dir - (basename f)))) - (copy-file f dest) - (chown dest user group))) - '#$(and declarative-mode? - (map jami-account-archive accounts))))) - - ;; Start the daemon. - (define daemon-pid - ((make-forkexec-constructor/container - '#$(jami-configuration->command-line-arguments config) - #:mappings - (list (file-system-mapping - (source "/dev/log") ;for syslog - (target source)) - (file-system-mapping - (source "/var/lib/jami") - (target source) - (writable? #t)) - (file-system-mapping - (source "/var/run/jami") - (target source) - (writable? #t)) - ;; Expose TLS certificates for GnuTLS. - (file-system-mapping - (source #$(file-append nss-certs "/etc/ssl/certs")) - (target "/etc/ssl/certs"))) - #:user "jami" - #:group "jami" - #:environment-variables - (list (string-append "DBUS_SESSION_BUS_ADDRESS=" - "unix:path=/var/run/jami/bus") - ;; Expose TLS certificates for OpenSSL. - "SSL_CERT_DIR=/etc/ssl/certs")))) - - (parameterize ((%send-dbus-binary #$dbus-send) - (%send-dbus-bus "unix:path=/var/run/jami/bus") - (%send-dbus-user "jami") - (%send-dbus-group "jami")) + (procedure + #~(lambda (_ username) + (disable-account username))))) + + (list (shepherd-service + (documentation "Run a D-Bus session for the Jami daemon.") + (provision '(jami-dbus-session)) + (modules `((gnu build shepherd) + (gnu build dbus-service) + (gnu build jami-service) + (gnu system file-systems) + ,@%default-modules)) + ;; The requirement on dbus-system is to ensure other required + ;; activation for D-Bus, such as a /etc/machine-id file. + (requirement '(dbus-system syslogd)) + (start + #~(make-forkexec-constructor/container + (list #$dbus-daemon "--session" + "--address=unix:path=/var/run/jami/bus" + "--syslog-only") + #:pid-file "/var/run/jami/pid" + #:mappings + (list (file-system-mapping + (source "/dev/log") ;for syslog + (target source)) + (file-system-mapping + (source "/var/run/jami") + (target source) + (writable? #t))) + #:user "jami" + #:group "jami" + #:environment-variables + ;; This is so that the cx.ring.Ring service D-Bus + ;; definition is found by dbus-daemon. + (list (string-append "XDG_DATA_DIRS=" #$libjami "/share")))) + (stop #~(make-kill-destructor))) + + (shepherd-service + (documentation "Run the Jami daemon.") + (provision '(jami)) + (actions (list list-accounts-action + list-account-details-action + list-contacts-action + list-moderators-action + add-moderator-action + ban-contact-action + list-banned-contacts-action + enable-account-action + disable-account-action)) + (requirement '(jami-dbus-session)) + (modules `((ice-9 format) + (ice-9 ftw) + (ice-9 match) + (ice-9 receive) + (srfi srfi-1) + (srfi srfi-26) + (gnu build dbus-service) + (gnu build jami-service) + (gnu build shepherd) + (gnu system file-systems) + ,@%default-modules)) + (start + #~(lambda args + (define (delete-file-recursively/safe file) + ;; Ensure we're not deleting things outside of + ;; /var/lib/jami. This prevents a possible attack in case + ;; the daemon is compromised and an attacker gains write + ;; access to /var/lib/jami. + (let ((parent-directory (dirname file))) + (if (eq? 'symlink (stat:type (stat parent-directory))) + (error "abnormality detected; unexpected symlink found at" + parent-directory) + (delete-file-recursively file)))) + + (when #$declarative-mode? + ;; Clear the Jami configuration and accounts, to enforce the + ;; declared state. + (catch #t + (lambda () + (for-each (cut delete-file-recursively/safe <>) + '("/var/lib/jami/.cache/jami" + "/var/lib/jami/.config/jami" + "/var/lib/jami/.local/share/jami" + "/var/lib/jami/accounts"))) + (lambda args + #t)) + ;; Copy the Jami account archives from somewhere readable + ;; by root to a place only the jami user can read. + (let* ((accounts-dir "/var/lib/jami/accounts/") + (pwd (getpwnam "jami")) + (user (passwd:uid pwd)) + (group (passwd:gid pwd))) + (mkdir-p accounts-dir) + (chown accounts-dir user group) + (for-each (lambda (f) + (let ((dest (string-append accounts-dir + (basename f)))) + (copy-file f dest) + (chown dest user group))) + '#$(and declarative-mode? + (map jami-account-archive accounts))))) + + ;; Start the daemon. + (define daemon-pid + ((make-forkexec-constructor/container + '#$(jami-configuration->command-line-arguments config) + #:mappings + (list (file-system-mapping + (source "/dev/log") ;for syslog + (target source)) + (file-system-mapping + (source "/var/lib/jami") + (target source) + (writable? #t)) + (file-system-mapping + (source "/var/run/jami") + (target source) + (writable? #t)) + ;; Expose TLS certificates for GnuTLS. + (file-system-mapping + (source #$(file-append nss-certs "/etc/ssl/certs")) + (target "/etc/ssl/certs"))) + #:user "jami" + #:group "jami" + #:environment-variables + (list (string-append "DBUS_SESSION_BUS_ADDRESS=" + "unix:path=/var/run/jami/bus") + ;; Expose TLS certificates for OpenSSL. + "SSL_CERT_DIR=/etc/ssl/certs")))) + + (setenv "DBUS_SESSION_BUS_ADDRESS" + "unix:path=/var/run/jami/bus") ;; Wait until the service name has been acquired by D-Bus. - (with-retries 20 1 - (dbus-service-available? "cx.ring.Ring")) + (with-retries 20 1 (jami-service-available?)) (when #$declarative-mode? ;; Provision the accounts via the D-Bus API of the daemon. @@ -685,7 +649,7 @@ argument, either a registered username or the fingerprint of the account.") account-details) (let ((username (archive-name->username archive))) - (when (not (eq? 'disabled allowed-contacts)) + (when (not (unspecified? allowed-contacts)) ;; Reject calls from unknown contacts. (set-account-details '(("DHT.PublicInCalls" . "false")) username) @@ -695,7 +659,7 @@ argument, either a registered username or the fingerprint of the account.") ;; Add allowed ones. (for-each (cut add-contact <> username) allowed-contacts)) - (when (not (eq? 'disabled moderators)) + (when (not (unspecified? moderators)) ;; Disable the 'AllModerators' property. (set-all-moderators #f username) ;; Remove all moderators. @@ -717,17 +681,17 @@ argument, either a registered username or the fingerprint of the account.") (map-in-order (cut jami-account-moderators <>) accounts)) '#$(and declarative-mode? - (map-in-order jami-account->alist accounts)))))) - - ;; Finally, return the PID of the daemon process. - daemon-pid)) - (stop - #~(lambda (pid . args) - (kill pid SIGKILL) - ;; Wait for the process to exit; this prevents overlapping - ;; processes when issuing 'herd restart'. - (waitpid pid) - #f))))))) + (map-in-order jami-account->alist accounts))))) + + ;; Finally, return the PID of the daemon process. + daemon-pid)) + (stop + #~(lambda (pid . args) + (kill pid SIGKILL) + ;; Wait for the process to exit; this prevents overlapping + ;; processes when issuing 'herd restart'. + (waitpid pid) + #f)))))))) (define jami-service-type (service-type diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm index a3dc96c1a2..8be632d55f 100644 --- a/gnu/services/vpn.scm +++ b/gnu/services/vpn.scm @@ -363,7 +363,7 @@ poll/epoll/select prior to the write operation.") channel to protect against DoS attacks.") (auth-user-pass - (maybe-string 'disabled) + maybe-string "Authenticate with server using username/password. The option is a file containing username/password on 2 lines. Do not use a file-like object as it would be added to the store and readable by any user.") |