diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/base.scm | 42 | ||||
| -rw-r--r-- | gnu/services/configuration.scm | 83 | ||||
| -rw-r--r-- | gnu/services/telephony.scm | 684 |
3 files changed, 756 insertions, 53 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index ab3e441a7b..c784d312b1 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -12,7 +12,7 @@ ;;; Copyright © 2019 John Soo <jsoo1@asu.edu> ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de> -;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re> ;;; Copyright © 2021 qblade <qblade@protonmail.com> ;;; Copyright © 2021 Hui Lu <luhuins@163.com> ;;; @@ -1383,14 +1383,8 @@ information on the configuration file syntax." (let ((security-limits ;; Create /etc/security containing the provided "limits.conf" file. (lambda (limits-file) - `(("security" - ,(computed-file - "security" - #~(begin - (mkdir #$output) - (stat #$limits-file) - (symlink #$limits-file - (string-append #$output "/limits.conf")))))))) + `(("security/limits.conf" + ,limits-file)))) (pam-extension (lambda (pam) (let ((pam-limits (pam-entry @@ -1700,21 +1694,21 @@ proxy of 'guix-daemon'...~%") (define (guix-activation config) "Return the activation gexp for CONFIG." - (match config - (($ <guix-configuration> guix build-group build-accounts authorize-key? keys) - ;; 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. - #~(begin - (unless (file-exists? "/etc/guix/signing-key.pub") - (system* #$(file-append guix "/bin/guix") "archive" - "--generate-key")) - - #$(if authorize-key? - (substitute-key-authorization keys guix) - #~#f))))) + (match-record config <guix-configuration> + (guix 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") + (system* #$(file-append guix "/bin/guix") "archive" + "--generate-key")) + + #$(if authorize-key? + (substitute-key-authorization authorized-keys guix) + #~#f)))) (define* (references-file item #:optional (name "references")) "Return a file that contains the list of references of ITEM." diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index fd07b6fa49..df3d3b6f9b 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -25,10 +25,12 @@ #:use-module (guix records) #:use-module (guix gexp) #:use-module ((guix utils) #:select (source-properties->location)) + #:use-module ((guix diagnostics) #:select (location-file)) + #:use-module ((guix modules) #:select (file-name->module-name)) #:autoload (texinfo) (texi-fragment->stexi) #:autoload (texinfo serialize) (stexi->texi) #:use-module (ice-9 match) - #:use-module ((srfi srfi-1) #:select (append-map)) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (configuration-field @@ -252,35 +254,62 @@ does not have a default value" field kind))) ;; A little helper to make it easier to document all those fields. (define (generate-documentation documentation documentation-name) (define (str x) (object->string x)) + + (define (package->symbol package) + "Return the first symbol name of a package that matches PACKAGE, else #f." + (let* ((module (file-name->module-name + (location-file (package-location package)))) + (symbols (filter-map + identity + (module-map (lambda (symbol var) + (and (equal? package (variable-ref var)) + symbol)) + (resolve-module module))))) + (if (null? symbols) + #f + (first symbols)))) + (define (generate configuration-name) (match (assq-ref documentation configuration-name) ((fields . sub-documentation) - `((para "Available " (code ,(str configuration-name)) " fields are:") - ,@(map - (lambda (f) - (let ((field-name (configuration-field-name f)) - (field-type (configuration-field-type f)) - (field-docs (cdr (texi-fragment->stexi - (configuration-field-documentation f)))) - (default (catch #t - (configuration-field-default-value-thunk f) - (lambda _ '%invalid)))) - (define (show-default? val) - (or (string? val) (number? val) (boolean? val) - (and (symbol? val) (not (eq? val '%invalid))) - (and (list? val) (and-map show-default? val)))) - `(deftypevr (% (category - (code ,(str configuration-name)) " parameter") - (data-type ,(str field-type)) - (name ,(str field-name))) - ,@field-docs - ,@(if (show-default? default) - `((para "Defaults to " (samp ,(str default)) ".")) - '()) - ,@(append-map - generate - (or (assq-ref sub-documentation field-name) '()))))) - fields))))) + `((deftp (% (category "Data Type") (name ,(str configuration-name))) + (para "Available " (code ,(str configuration-name)) " fields are:") + (table + (% (formatter (asis))) + ,@(map + (lambda (f) + (let ((field-name (configuration-field-name f)) + (field-type (configuration-field-type f)) + (field-docs (cdr (texi-fragment->stexi + (configuration-field-documentation f)))) + (default (catch #t + (configuration-field-default-value-thunk f) + (lambda _ '%invalid)))) + (define (show-default? val) + (or (string? val) (number? val) (boolean? val) + (package? val) + (and (symbol? val) (not (eq? val '%invalid))) + (and (list? val) (and-map show-default? val)))) + + (define (show-default val) + (cond + ((package? val) + (symbol->string (package->symbol val))) + (else (str val)))) + + `(entry (% (heading + (code ,(str field-name)) + ,@(if (show-default? default) + `(" (default: " + (code ,(show-default default)) ")") + '()) + " (type: " ,(str field-type) ")")) + (para ,@field-docs) + ,@(append-map + generate + (or (assq-ref sub-documentation field-name) + '()))))) + fields))))))) (stexi->texi `(*fragment* . ,(generate documentation-name)))) (define (configuration->documentation configuration-symbol) diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm index e1259cc2df..fd90840324 100644 --- a/gnu/services/telephony.scm +++ b/gnu/services/telephony.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 nee <nee-git@hidamari.blue> +;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,16 +18,45 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services telephony) - #:use-module (gnu services) + #:use-module ((gnu build jami-service) #:select (account-fingerprint?)) + #:use-module ((gnu services) #:hide (delete)) + #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module (gnu packages admin) + #:use-module (gnu packages certs) + #:use-module (gnu packages glib) + #:use-module (gnu packages jami) #:use-module (gnu packages telephony) #:use-module (guix records) + #:use-module (guix modules) + #:use-module (guix packages) #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-26) + #:use-module (ice-9 format) #:use-module (ice-9 match) - #:export (murmur-configuration + #:export (jami-account + jami-account-archive + jami-account-allowed-contacts + jami-account-moderators + jami-account-rendezvous-point? + jami-account-discovery? + jami-account-bootstrap-uri + jami-account-name-server-uri + + jami-configuration + jami-configuration-jamid + jami-configuration-dbus + jami-configuration-enable-logging? + jami-configuration-debug? + jami-configuration-auto-answer? + jami-configuration-accounts + + jami-service-type + + murmur-configuration make-murmur-configuration murmur-configuration? murmur-configuration-package @@ -74,6 +104,652 @@ murmur-service-type)) + +;;; +;;; Jami daemon. +;;; + +;;; XXX: Passing a computed-file object as the account is used for tests. +(define (string-or-computed-file? val) + (or (string? val) + (computed-file? val))) + +(define (string-list? val) + (and (list? val) + (and-map string? val))) + +(define (account-fingerprint-list? val) + (and (list? val) + (and-map account-fingerprint? val))) + +(define-maybe string-list) + +(define-maybe/no-serialization account-fingerprint-list) + +(define-maybe boolean) + +(define-maybe string) + +;;; The following serializers are used to derive an account details alist from +;;; a <jami-account> record. +(define (serialize-string-list _ val) + (string-join val ";")) + +(define (serialize-boolean _ val) + (format #f "~:[false~;true~]" val)) + +(define (serialize-string _ val) + val) + +;;; Note: Serialization is used to produce an account details alist that can +;;; be passed to the SET-ACCOUNT-DETAILS procedure. Fields that do not map to +;;; a Jami account 'detail' should have their serialization disabled via the +;;; 'empty-serializer' procedure. +(define-configuration jami-account + (archive + (string-or-computed-file) + "The account archive (backup) file name of the account. This is used to +provision the account when the service starts. The account archive should +@emph{not} be encrypted. It is highly recommended to make it readable only to +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) + "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 +is used as-is with respect to contacts and public inbound calls/messaging +allowance, which typically defaults to allow any contact to communicate with +the account." + empty-serializer) + (moderators + (maybe-account-fingerprint-list 'disabled) + "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 +is used as-is with respect to moderation, which typically defaults to allow +anyone to moderate." + empty-serializer) + ;; The serializable fields below are to be set with set-account-details. + (rendezvous-point? + (maybe-boolean 'disabled) + "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) + "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) + "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) + "The URI of the name server to use, that can be used to retrieve the +account fingerprint for a registered username.")) + +(define (jami-account->alist jami-account-object) + "Serialize the JAMI-ACCOUNT object as an alist suitable to be passed to +SET-ACCOUNT-DETAILS." + (define (field-name->account-detail name) + (match name + ('rendezvous-point? "Account.rendezVous") + ('peer-discovery? "Account.peerDiscovery") + ('bootstrap-hostnames "Account.hostname") + ('name-server-uri "RingNS.uri") + (_ #f))) + + (filter-map (lambda (field) + (and-let* ((name (field-name->account-detail + (configuration-field-name field))) + (value ((configuration-field-serializer field) + name ((configuration-field-getter field) + jami-account-object))) + ;; The define-maybe default serializer produces an + ;; empty string for the 'disabled value. + (value* (if (string-null? value) + #f + value))) + (cons name value*))) + jami-account-fields)) + +(define (jami-account-list? val) + (and (list? val) + (and-map jami-account? val))) + +(define-maybe/no-serialization jami-account-list) + +(define-configuration/no-serialization jami-configuration + (jamid + (package libring) + "The Jami daemon package to use.") + (dbus + (package dbus) + "The D-Bus package to use to start the required D-Bus session.") + (nss-certs + (package nss-certs) + "The nss-certs package to use to provide TLS certificates.") + (enable-logging? + (boolean #t) + "Whether to enable logging to syslog.") + (debug? + (boolean #f) + "Whether to enable debug level messages.") + (auto-answer? + (boolean #f) + "Whether to force automatic answer to incoming calls.") + (accounts + (maybe-jami-account-list 'disabled) + "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 +consistent state.")) + +(define %jami-accounts + (list (user-group (name "jami") (system? #t)) + (user-account + (name "jami") + (group "jami") + (system? #t) + (comment "Jami daemon user") + (home-directory "/var/lib/jami")))) + +(define (jami-configuration->command-line-arguments config) + "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 "/lib/ring/dring") + "--persistent" ;stay alive after client quits + ,@(if enable-logging? + '() ;logs go to syslog by default + (list "--console")) ;else stdout/stderr + ,@(if debug? + (list "--debug") + '()) + ,@(if auto-answer? + (list "--auto-answer") + '())))) + +(define (jami-dbus-session-activation config) + "Create a directory to hold the Jami D-Bus session socket." + (with-imported-modules (source-module-closure '((gnu build activation))) + #~(begin + (use-modules (gnu build activation)) + (let ((user (getpwnam "jami"))) + (mkdir-p/perms "/var/run/jami" user #o700))))) + +(define (jami-shepherd-services config) + "Return a <shepherd-service> running the Jami daemon." + (let* ((jamid (jami-configuration-jamid 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 +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")) + ;; Print the accounts summary or long listing, according to + ;; user-provided option. + (let* ((usernames (get-usernames)) + (accounts (map-in-order username->account usernames))) + (match accounts + (() ;empty list + (format #t "There is no Jami account available.~%")) + ((one two ...) + (format #t "The following Jami accounts are available:~%") + (for-each + (lambda (account) + (define fingerprint (assoc-ref account + "Account.username")) + (define human-friendly-name + (or (assoc-ref account + "Account.registeredName") + (assoc-ref account + "Account.displayName") + (assoc-ref account + "Account.alias"))) + (define disabled? + (and=> (assoc-ref account "Account.enable") + (cut string=? "false" <>))) + + (format #t " - ~a~@[ (~a)~] ~:[~;[disabled]~]~%" + fingerprint human-friendly-name disabled?)) + accounts) + (display "\n"))) + ;; Return the account-details-list alist. + (map cons usernames accounts))))))) + + (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")) + (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))))))) + + (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")) + (let* ((usernames (get-usernames)) + (contacts (map-in-order username->contacts usernames))) + (for-each (lambda (username contacts) + (format #t "Contacts for account ~a:~%" + username) + (format #t "~{ - ~a~%~}~%" contacts)) + usernames contacts) + (map cons usernames contacts))))))) + + (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")) + (let* ((usernames (get-usernames)) + (moderators (map-in-order username->moderators + usernames))) + (for-each + (lambda (username moderators) + (if (username->all-moderators? username) + (format #t "Anyone can moderate for account ~a~%" + username) + (begin + (format #t "Moderators for account ~a:~%" username) + (format #t "~{ - ~a~%~}~%" moderators)))) + 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 +MODERATOR contact must be given as its 40 characters fingerprint, while the +Jami account can be provided as its registered USERNAME or fingerprint. + +@example +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")) + (set-all-moderators #f username) + (add-contact moderator username) + (set-moderator moderator #t 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 +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 +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")) + (let ((usernames (or (and=> username list) + (get-usernames)))) + (for-each (lambda (username) + (set-moderator contact #f username) + (remove-contact contact username #:ban? #t)) + usernames))))))) + + (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")) + + (define banned-contacts + (let ((usernames (get-usernames))) + (map cons usernames + (map-in-order (lambda (x) + (receive (_ banned) + (username->contacts x) + banned)) + usernames)))) + + (for-each (match-lambda + ((username . banned) + (unless (null? banned) + (format #t "Banned contacts for account ~a:~%" + username) + (format #t "~{ - ~a~%~}~%" banned)))) + banned-contacts) + banned-contacts))))) + + (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 +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")) + + ;; Wait until the service name has been acquired by D-Bus. + (with-retries 20 1 + (dbus-service-available? "cx.ring.Ring")) + + (when #$declarative-mode? + ;; Provision the accounts via the D-Bus API of the daemon. + (let* ((jami-account-archives + (map (cut string-append + "/var/lib/jami/accounts/" <>) + (scandir "/var/lib/jami/accounts/" + (lambda (f) + (not (member f '("." ".."))))))) + (usernames (map-in-order (cut add-account <>) + jami-account-archives))) + + (define (archive-name->username archive) + (list-ref + usernames + (list-index (lambda (f) + (string-suffix? (basename archive) f)) + jami-account-archives))) + + (for-each + (lambda (archive allowed-contacts moderators + account-details) + (let ((username (archive-name->username + archive))) + (when (not (eq? 'disabled allowed-contacts)) + ;; Reject calls from unknown contacts. + (set-account-details + '(("DHT.PublicInCalls" . "false")) username) + ;; Remove all contacts. + (for-each (cut remove-contact <> username) + (username->contacts username)) + ;; Add allowed ones. + (for-each (cut add-contact <> username) + allowed-contacts)) + (when (not (eq? 'disabled moderators)) + ;; Disable the 'AllModerators' property. + (set-all-moderators #f username) + ;; Remove all moderators. + (for-each (cut set-moderator <> #f username) + (username->moderators username)) + ;; Add declared moderators. + (for-each (cut set-moderator <> #t username) + moderators)) + ;; Set the various account parameters. + (set-account-details account-details username))) + '#$(and declarative-mode? + (map-in-order (cut jami-account-archive <>) + accounts)) + '#$(and declarative-mode? + (map-in-order + (cut jami-account-allowed-contacts <>) + accounts)) + '#$(and declarative-mode? + (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))))))) + +(define jami-service-type + (service-type + (name 'jami) + (default-value (jami-configuration)) + (extensions + (list (service-extension shepherd-root-service-type + jami-shepherd-services) + (service-extension account-service-type + (const %jami-accounts)) + (service-extension activation-service-type + jami-dbus-session-activation))) + (description "Run the Jami daemon (@command{dring}). This service is +geared toward the use case of hosting Jami rendezvous points over a headless +server. If you use Jami on your local machine, you may prefer to setup a user +Shepherd service for it instead; this way, the daemon will be shared via your +normal user D-Bus session bus."))) + + +;;; +;;; Murmur. +;;; + ;; https://github.com/mumble-voip/mumble/blob/master/scripts/murmur.ini (define-record-type* <murmur-configuration> murmur-configuration @@ -305,3 +981,7 @@ suite.") (service-extension account-service-type murmur-accounts))) (default-value (murmur-configuration)))) + +;; Local Variables: +;; eval: (put 'with-retries 'scheme-indent-function 2) +;; End: |