gnu/services/telephony.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 nee  <nee-git@hidamari.blue>
   3 ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu services telephony)
  21   #:use-module ((gnu build jami-service) #:select (account-fingerprint?))
  22   #:use-module ((gnu services) #:hide (delete))
  23   #:use-module (gnu services configuration)
  24   #:use-module (gnu services shepherd)
  25   #:use-module (gnu system shadow)
  26   #:use-module (gnu packages admin)
  27   #:use-module (gnu packages certs)
  28   #:use-module (gnu packages glib)
  29   #:use-module (gnu packages jami)
  30   #:use-module (gnu packages telephony)
  31   #:use-module (guix deprecation)
  32   #:use-module (guix records)
  33   #:use-module (guix modules)
  34   #:use-module (guix packages)
  35   #:use-module (guix gexp)
  36   #:use-module (srfi srfi-1)
  37   #:use-module (srfi srfi-2)
  38   #:use-module (srfi srfi-26)
  39   #:use-module (ice-9 format)
  40   #:use-module (ice-9 match)
  41   #:export (jami-account
  42             jami-account-archive
  43             jami-account-allowed-contacts
  44             jami-account-moderators
  45             jami-account-rendezvous-point?
  46             jami-account-discovery?
  47             jami-account-bootstrap-uri
  48             jami-account-name-server-uri
  49
  50             jami-configuration
  51             jami-configuration-jamid
  52             jami-configuration-dbus
  53             jami-configuration-enable-logging?
  54             jami-configuration-debug?
  55             jami-configuration-auto-answer?
  56             jami-configuration-accounts
  57
  58             jami-service-type
  59
  60             mumble-server-configuration
  61             make-mumble-server-configuration
  62             mumble-server-configuration?
  63             mumble-server-configuration-package
  64             mumble-server-configuration-user
  65             mumble-server-configuration-group
  66             mumble-server-configuration-port
  67             mumble-server-configuration-welcome-text
  68             mumble-server-configuration-server-password
  69             mumble-server-configuration-max-users
  70             mumble-server-configuration-max-user-bandwidth
  71             mumble-server-configuration-database-file
  72             mumble-server-configuration-log-file
  73             mumble-server-configuration-pid-file
  74             mumble-server-configuration-autoban-attempts
  75             mumble-server-configuration-autoban-timeframe
  76             mumble-server-configuration-autoban-time
  77             mumble-server-configuration-opus-threshold
  78             mumble-server-configuration-channel-nesting-limit
  79             mumble-server-configuration-channelname-regex
  80             mumble-server-configuration-username-regex
  81             mumble-server-configuration-text-message-length
  82             mumble-server-configuration-image-message-length
  83             mumble-server-configuration-cert-required?
  84             mumble-server-configuration-remember-channel?
  85             mumble-server-configuration-allow-html?
  86             mumble-server-configuration-allow-ping?
  87             mumble-server-configuration-bonjour?
  88             mumble-server-configuration-send-version?
  89             mumble-server-configuration-log-days
  90             mumble-server-configuration-obfuscate-ips?
  91             mumble-server-configuration-ssl-cert
  92             mumble-server-configuration-ssl-key
  93             mumble-server-configuration-ssl-dh-params
  94             mumble-server-configuration-ssl-ciphers
  95             mumble-server-configuration-public-registration
  96             mumble-server-configuration-file
  97
  98             mumble-server-public-registration-configuration
  99             make-mumble-server-public-registration-configuration
 100             mumble-server-public-registration-configuration?
 101             mumble-server-public-registration-configuration-name
 102             mumble-server-public-registration-configuration-url
 103             mumble-server-public-registration-configuration-password
 104             mumble-server-public-registration-configuration-hostname
 105
 106             mumble-server-service-type))
 107
 108 \f
 109 ;;;
 110 ;;; Jami daemon.
 111 ;;;
 112
 113 ;;; XXX: Passing a computed-file object as the account is used for tests.
 114 (define (string-or-computed-file? val)
 115   (or (string? val)
 116       (computed-file? val)))
 117
 118 (define (string-list? val)
 119   (and (list? val)
 120        (and-map string? val)))
 121
 122 (define (account-fingerprint-list? val)
 123   (and (list? val)
 124        (and-map account-fingerprint? val)))
 125
 126 (define-maybe string-list)
 127
 128 (define-maybe/no-serialization account-fingerprint-list)
 129
 130 (define-maybe boolean)
 131
 132 (define-maybe string)
 133
 134 ;;; The following serializers are used to derive an account details alist from
 135 ;;; a <jami-account> record.
 136 (define (serialize-string-list _ val)
 137   (string-join val ";"))
 138
 139 (define (serialize-boolean _ val)
 140   (format #f "~:[false~;true~]" val))
 141
 142 (define (serialize-string _ val)
 143   val)
 144
 145 ;;; Note: Serialization is used to produce an account details alist that can
 146 ;;; be passed to the SET-ACCOUNT-DETAILS procedure.  Fields that do not map to
 147 ;;; a Jami account 'detail' should have their serialization disabled via the
 148 ;;; 'empty-serializer' procedure.
 149 (define-configuration jami-account
 150   (archive
 151    (string-or-computed-file)
 152    "The account archive (backup) file name of the account.  This is used to
 153 provision the account when the service starts.  The account archive should
 154 @emph{not} be encrypted.  It is highly recommended to make it readable only to
 155 the @samp{root} user (i.e., not in the store), to guard against leaking the
 156 secret key material of the Jami account it contains."
 157    empty-serializer)
 158   (allowed-contacts
 159    (maybe-account-fingerprint-list 'disabled)
 160    "The list of allowed contacts for the account, entered as their 40
 161 characters long fingerprint.  Messages or calls from accounts not in that list
 162 will be rejected.  When unspecified, the configuration of the account archive
 163 is used as-is with respect to contacts and public inbound calls/messaging
 164 allowance, which typically defaults to allow any contact to communicate with
 165 the account."
 166    empty-serializer)
 167   (moderators
 168    (maybe-account-fingerprint-list 'disabled)
 169    "The list of contacts that should have moderation privileges (to ban, mute,
 170 etc. other users) in rendezvous conferences, entered as their 40 characters
 171 long fingerprint.  When unspecified, the configuration of the account archive
 172 is used as-is with respect to moderation, which typically defaults to allow
 173 anyone to moderate."
 174    empty-serializer)
 175   ;; The serializable fields below are to be set with set-account-details.
 176   (rendezvous-point?
 177    (maybe-boolean 'disabled)
 178    "Whether the account should operate in the rendezvous mode.  In this mode,
 179 all the incoming audio/video calls are mixed into a conference.  When left
 180 unspecified, the value from the account archive prevails.")
 181   (peer-discovery?
 182    (maybe-boolean 'disabled)
 183    "Whether peer discovery should be enabled.  Peer discovery is used to
 184 discover other OpenDHT nodes on the local network, which can be useful to
 185 maintain communication between devices on such network even when the
 186 connection to the the Internet has been lost.  When left unspecified, the
 187 value from the account archive prevails.")
 188   (bootstrap-hostnames
 189    (maybe-string-list 'disabled)
 190    "A list of hostnames or IPs pointing to OpenDHT nodes, that should be used
 191 to initially join the OpenDHT network.  When left unspecified, the value from
 192 the account archive prevails.")
 193   (name-server-uri
 194    (maybe-string 'disabled)
 195    "The URI of the name server to use, that can be used to retrieve the
 196 account fingerprint for a registered username."))
 197
 198 (define (jami-account->alist jami-account-object)
 199   "Serialize the JAMI-ACCOUNT object as an alist suitable to be passed to
 200 SET-ACCOUNT-DETAILS."
 201   (define (field-name->account-detail name)
 202     (match name
 203       ('rendezvous-point? "Account.rendezVous")
 204       ('peer-discovery? "Account.peerDiscovery")
 205       ('bootstrap-hostnames "Account.hostname")
 206       ('name-server-uri "RingNS.uri")
 207       (_ #f)))
 208
 209   (filter-map (lambda (field)
 210                 (and-let* ((name (field-name->account-detail
 211                                   (configuration-field-name field)))
 212                            (value ((configuration-field-serializer field)
 213                                    name ((configuration-field-getter field)
 214                                          jami-account-object)))
 215                            ;; The define-maybe default serializer produces an
 216                            ;; empty string for the 'disabled value.
 217                            (value* (if (string-null? value)
 218                                        #f
 219                                        value)))
 220                   (cons name value*)))
 221               jami-account-fields))
 222
 223 (define (jami-account-list? val)
 224   (and (list? val)
 225        (and-map jami-account? val)))
 226
 227 (define-maybe/no-serialization jami-account-list)
 228
 229 (define-configuration/no-serialization jami-configuration
 230   (jamid
 231    (file-like libjami)
 232    "The Jami daemon package to use.")
 233   (dbus
 234    (file-like dbus)
 235    "The D-Bus package to use to start the required D-Bus session.")
 236   (nss-certs
 237    (file-like nss-certs)
 238    "The nss-certs package to use to provide TLS certificates.")
 239   (enable-logging?
 240    (boolean #t)
 241    "Whether to enable logging to syslog.")
 242   (debug?
 243    (boolean #f)
 244    "Whether to enable debug level messages.")
 245   (auto-answer?
 246    (boolean #f)
 247    "Whether to force automatic answer to incoming calls.")
 248   (accounts
 249    (maybe-jami-account-list 'disabled)
 250    "A list of Jami accounts to be (re-)provisioned every time the Jami daemon
 251 service starts.  When providing this field, the account directories under
 252 @file{/var/lib/jami/} are recreated every time the service starts, ensuring a
 253 consistent state."))
 254
 255 (define %jami-accounts
 256   (list (user-group (name "jami") (system? #t))
 257         (user-account
 258          (name "jami")
 259          (group "jami")
 260          (system? #t)
 261          (comment "Jami daemon user")
 262          (home-directory "/var/lib/jami"))))
 263
 264 (define (jami-configuration->command-line-arguments config)
 265   "Derive the command line arguments to used to launch the Jami daemon from
 266 CONFIG, a <jami-configuration> object."
 267   (match-record config <jami-configuration>
 268     (jamid dbus enable-logging? debug? auto-answer?)
 269     `(,(file-append jamid "/libexec/jamid")
 270       "--persistent"                    ;stay alive after client quits
 271       ,@(if enable-logging?
 272             '()                         ;logs go to syslog by default
 273             (list "--console"))         ;else stdout/stderr
 274       ,@(if debug?
 275             (list "--debug")
 276             '())
 277       ,@(if auto-answer?
 278             (list "--auto-answer")
 279             '()))))
 280
 281 (define (jami-dbus-session-activation config)
 282   "Create a directory to hold the Jami D-Bus session socket."
 283   (with-imported-modules (source-module-closure '((gnu build activation)))
 284     #~(begin
 285         (use-modules (gnu build activation))
 286         (let ((user (getpwnam "jami")))
 287           (mkdir-p/perms "/var/run/jami" user #o700)))))
 288
 289 (define (jami-shepherd-services config)
 290   "Return a <shepherd-service> running the Jami daemon."
 291   (let* ((jamid (jami-configuration-jamid config))
 292          (nss-certs (jami-configuration-nss-certs config))
 293          (dbus (jami-configuration-dbus config))
 294          (dbus-daemon (file-append dbus "/bin/dbus-daemon"))
 295          (dbus-send (file-append dbus "/bin/dbus-send"))
 296          (accounts (jami-configuration-accounts config))
 297          (declarative-mode? (not (eq? 'disabled accounts))))
 298
 299     (with-imported-modules (source-module-closure
 300                             '((gnu build jami-service)
 301                               (gnu build shepherd)
 302                               (gnu system file-systems)))
 303
 304       (define list-accounts-action
 305         (shepherd-action
 306          (name 'list-accounts)
 307          (documentation "List the available Jami accounts.  Return the account
 308 details alists keyed by their account username.")
 309          (procedure
 310           #~(lambda _
 311               (parameterize ((%send-dbus-binary #$dbus-send)
 312                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 313                              (%send-dbus-user   "jami")
 314                              (%send-dbus-group  "jami"))
 315                 ;; Print the accounts summary or long listing, according to
 316                 ;; user-provided option.
 317                 (let* ((usernames (get-usernames))
 318                        (accounts (map-in-order username->account usernames)))
 319                   (match accounts
 320                     (()                 ;empty list
 321                      (format #t "There is no Jami account available.~%"))
 322                     ((one two ...)
 323                      (format #t "The following Jami accounts are available:~%")
 324                      (for-each
 325                       (lambda (account)
 326                         (define fingerprint (assoc-ref account
 327                                                        "Account.username"))
 328                         (define human-friendly-name
 329                           (or (assoc-ref account
 330                                          "Account.registeredName")
 331                               (assoc-ref account
 332                                          "Account.displayName")
 333                               (assoc-ref account
 334                                          "Account.alias")))
 335                         (define disabled?
 336                           (and=> (assoc-ref account "Account.enable")
 337                                  (cut string=? "false" <>)))
 338
 339                         (format #t "  - ~a~@[ (~a)~] ~:[~;[disabled]~]~%"
 340                                 fingerprint human-friendly-name disabled?))
 341                       accounts)
 342                      (display "\n")))
 343                   ;; Return the account-details-list alist.
 344                   (map cons usernames accounts)))))))
 345
 346       (define list-account-details-action
 347         (shepherd-action
 348          (name 'list-account-details)
 349          (documentation "Display the account details of the available Jami
 350 accounts in the @code{recutils} format.  Return the account details alists
 351 keyed by their account username.")
 352          (procedure
 353           #~(lambda _
 354               (parameterize ((%send-dbus-binary #$dbus-send)
 355                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 356                              (%send-dbus-user   "jami")
 357                              (%send-dbus-group  "jami"))
 358                 (let* ((usernames (get-usernames))
 359                        (accounts (map-in-order username->account usernames)))
 360                   (for-each (lambda (account)
 361                               (display (account-details->recutil account))
 362                               (display "\n\n"))
 363                             accounts)
 364                   (map cons usernames accounts)))))))
 365
 366       (define list-contacts-action
 367         (shepherd-action
 368          (name 'list-contacts)
 369          (documentation "Display the contacts for each Jami account.  Return
 370 an alist containing the contacts keyed by the account usernames.")
 371          (procedure
 372           #~(lambda _
 373               (parameterize ((%send-dbus-binary #$dbus-send)
 374                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 375                              (%send-dbus-user   "jami")
 376                              (%send-dbus-group  "jami"))
 377                 (let* ((usernames (get-usernames))
 378                        (contacts (map-in-order username->contacts usernames)))
 379                   (for-each (lambda (username contacts)
 380                               (format #t "Contacts for account ~a:~%"
 381                                       username)
 382                               (format #t "~{  - ~a~%~}~%" contacts))
 383                             usernames contacts)
 384                   (map cons usernames contacts)))))))
 385
 386       (define list-moderators-action
 387         (shepherd-action
 388          (name 'list-moderators)
 389          (documentation "Display the moderators for each Jami account.  Return
 390 an alist containing the moderators keyed by the account usernames.")
 391          (procedure
 392           #~(lambda _
 393               (parameterize ((%send-dbus-binary #$dbus-send)
 394                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 395                              (%send-dbus-user   "jami")
 396                              (%send-dbus-group  "jami"))
 397                 (let* ((usernames (get-usernames))
 398                        (moderators (map-in-order username->moderators
 399                                                  usernames)))
 400                   (for-each
 401                    (lambda (username moderators)
 402                      (if (username->all-moderators? username)
 403                          (format #t "Anyone can moderate for account ~a~%"
 404                                  username)
 405                          (begin
 406                            (format #t "Moderators for account ~a:~%" username)
 407                            (format #t "~{  - ~a~%~}~%" moderators))))
 408                    usernames moderators)
 409                   (map cons usernames moderators)))))))
 410
 411       (define add-moderator-action
 412         (shepherd-action
 413          (name 'add-moderator)
 414          (documentation "Add a moderator for a given Jami account.  The
 415 MODERATOR contact must be given as its 40 characters fingerprint, while the
 416 Jami account can be provided as its registered USERNAME or fingerprint.
 417
 418 @example
 419 herd add-moderator jami 1dbcb0f5f37324228235564b79f2b9737e9a008f username
 420 @end example
 421
 422 Return the moderators for the account known by USERNAME.")
 423          (procedure
 424           #~(lambda (_ moderator username)
 425               (parameterize ((%send-dbus-binary #$dbus-send)
 426                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 427                              (%send-dbus-user   "jami")
 428                              (%send-dbus-group  "jami"))
 429                 (set-all-moderators #f username)
 430                 (add-contact moderator username)
 431                 (set-moderator moderator #t username)
 432                 (username->moderators username))))))
 433
 434       (define ban-contact-action
 435         (shepherd-action
 436          (name 'ban-contact)
 437          (documentation "Ban a contact for a given or all Jami accounts, and
 438 clear their moderator flag.  The CONTACT must be given as its 40 characters
 439 fingerprint, while the Jami account can be provided as its registered USERNAME
 440 or fingerprint, or omitted.  When the account is omitted, CONTACT is banned
 441 from all accounts.
 442
 443 @example
 444 herd ban-contact jami 1dbcb0f5f37324228235564b79f2b9737e9a008f [username]
 445 @end example")
 446          (procedure
 447           #~(lambda* (_ contact #:optional username)
 448               (parameterize ((%send-dbus-binary #$dbus-send)
 449                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 450                              (%send-dbus-user   "jami")
 451                              (%send-dbus-group  "jami"))
 452                 (let ((usernames (or (and=> username list)
 453                                      (get-usernames))))
 454                   (for-each (lambda (username)
 455                               (set-moderator contact #f username)
 456                               (remove-contact contact username #:ban? #t))
 457                             usernames)))))))
 458
 459       (define list-banned-contacts-action
 460         (shepherd-action
 461          (name 'list-banned-contacts)
 462          (documentation "List the banned contacts for each accounts.  Return
 463 an alist of the banned contacts, keyed by the account usernames.")
 464          (procedure
 465           #~(lambda _
 466               (parameterize ((%send-dbus-binary #$dbus-send)
 467                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 468                              (%send-dbus-user   "jami")
 469                              (%send-dbus-group  "jami"))
 470
 471                 (define banned-contacts
 472                   (let ((usernames (get-usernames)))
 473                     (map cons usernames
 474                          (map-in-order (lambda (x)
 475                                          (receive (_ banned)
 476                                              (username->contacts x)
 477                                            banned))
 478                                        usernames))))
 479
 480                 (for-each (match-lambda
 481                             ((username . banned)
 482                              (unless (null? banned)
 483                                (format #t "Banned contacts for account ~a:~%"
 484                                        username)
 485                                (format #t "~{  - ~a~%~}~%" banned))))
 486                           banned-contacts)
 487                 banned-contacts)))))
 488
 489       (define enable-account-action
 490         (shepherd-action
 491          (name 'enable-account)
 492          (documentation "Enable an account.  It takes USERNAME as an argument,
 493 either a registered username or the fingerprint of the account.")
 494          (procedure
 495           #~(lambda (_ username)
 496               (parameterize ((%send-dbus-binary #$dbus-send)
 497                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 498                              (%send-dbus-user   "jami")
 499                              (%send-dbus-group  "jami"))
 500                 (enable-account username))))))
 501
 502       (define disable-account-action
 503         (shepherd-action
 504          (name 'disable-account)
 505          (documentation "Disable an account.  It takes USERNAME as an
 506 argument, either a registered username or the fingerprint of the account.")
 507          (procedure
 508           #~(lambda (_ username)
 509               (parameterize ((%send-dbus-binary #$dbus-send)
 510                              (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 511                              (%send-dbus-user   "jami")
 512                              (%send-dbus-group  "jami"))
 513                 (disable-account username))))))
 514
 515       (list (shepherd-service
 516              (documentation "Run a D-Bus session for the Jami daemon.")
 517              (provision '(jami-dbus-session))
 518              (modules `((gnu build shepherd)
 519                         (gnu build jami-service)
 520                         (gnu system file-systems)
 521                         ,@%default-modules))
 522              ;; The requirement on dbus-system is to ensure other required
 523              ;; activation for D-Bus, such as a /etc/machine-id file.
 524              (requirement '(dbus-system syslogd))
 525              (start
 526               #~(lambda args
 527                   (define pid
 528                     ((make-forkexec-constructor/container
 529                       (list #$dbus-daemon "--session"
 530                             "--address=unix:path=/var/run/jami/bus"
 531                             "--nofork" "--syslog-only" "--nopidfile")
 532                       #:mappings (list (file-system-mapping
 533                                         (source "/dev/log") ;for syslog
 534                                         (target source))
 535                                        (file-system-mapping
 536                                         (source "/var/run/jami")
 537                                         (target source)
 538                                         (writable? #t)))
 539                       #:user "jami"
 540                       #:group "jami"
 541                       #:environment-variables
 542                       ;; This is so that the cx.ring.Ring service D-Bus
 543                       ;; definition is found by dbus-send.
 544                       (list (string-append "XDG_DATA_DIRS="
 545                                            #$jamid "/share")))))
 546
 547                   ;; XXX: This manual synchronization probably wouldn't be
 548                   ;; needed if we were using a PID file, but providing it via a
 549                   ;; customized config file with <pidfile> would not override
 550                   ;; the one inherited from the base config of D-Bus.
 551                   (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
 552                     (with-retries 20 1 (catch 'system-error
 553                                          (lambda ()
 554                                            (connect sock AF_UNIX
 555                                                     "/var/run/jami/bus")
 556                                            (close-port sock)
 557                                            #t)
 558                                          (lambda args
 559                                            #f))))
 560
 561                   pid))
 562              (stop #~(make-kill-destructor)))
 563
 564             (shepherd-service
 565              (documentation "Run the Jami daemon.")
 566              (provision '(jami))
 567              (actions (list list-accounts-action
 568                             list-account-details-action
 569                             list-contacts-action
 570                             list-moderators-action
 571                             add-moderator-action
 572                             ban-contact-action
 573                             list-banned-contacts-action
 574                             enable-account-action
 575                             disable-account-action))
 576              (requirement '(jami-dbus-session))
 577              (modules `((ice-9 format)
 578                         (ice-9 ftw)
 579                         (ice-9 match)
 580                         (ice-9 receive)
 581                         (srfi srfi-1)
 582                         (srfi srfi-26)
 583                         (gnu build jami-service)
 584                         (gnu build shepherd)
 585                         (gnu system file-systems)
 586                         ,@%default-modules))
 587              (start
 588               #~(lambda args
 589                   (define (delete-file-recursively/safe file)
 590                     ;; Ensure we're not deleting things outside of
 591                     ;; /var/lib/jami.  This prevents a possible attack in case
 592                     ;; the daemon is compromised and an attacker gains write
 593                     ;; access to /var/lib/jami.
 594                     (let ((parent-directory (dirname file)))
 595                       (if (eq? 'symlink (stat:type (stat parent-directory)))
 596                           (error "abnormality detected; unexpected symlink found at"
 597                                  parent-directory)
 598                           (delete-file-recursively file))))
 599
 600                   (when #$declarative-mode?
 601                     ;; Clear the Jami configuration and accounts, to enforce the
 602                     ;; declared state.
 603                     (catch #t
 604                       (lambda ()
 605                         (for-each (cut delete-file-recursively/safe <>)
 606                                   '("/var/lib/jami/.cache/jami"
 607                                     "/var/lib/jami/.config/jami"
 608                                     "/var/lib/jami/.local/share/jami"
 609                                     "/var/lib/jami/accounts")))
 610                       (lambda args
 611                         #t))
 612                     ;; Copy the Jami account archives from somewhere readable
 613                     ;; by root to a place only the jami user can read.
 614                     (let* ((accounts-dir "/var/lib/jami/accounts/")
 615                            (pwd (getpwnam "jami"))
 616                            (user (passwd:uid pwd))
 617                            (group (passwd:gid pwd)))
 618                       (mkdir-p accounts-dir)
 619                       (chown accounts-dir user group)
 620                       (for-each (lambda (f)
 621                                   (let ((dest (string-append accounts-dir
 622                                                              (basename f))))
 623                                     (copy-file f dest)
 624                                     (chown dest user group)))
 625                                 '#$(and declarative-mode?
 626                                         (map jami-account-archive accounts)))))
 627
 628                   ;; Start the daemon.
 629                   (define daemon-pid
 630                     ((make-forkexec-constructor/container
 631                       '#$(jami-configuration->command-line-arguments config)
 632                       #:mappings
 633                       (list (file-system-mapping
 634                              (source "/dev/log") ;for syslog
 635                              (target source))
 636                             (file-system-mapping
 637                              (source "/var/lib/jami")
 638                              (target source)
 639                              (writable? #t))
 640                             (file-system-mapping
 641                              (source "/var/run/jami")
 642                              (target source)
 643                              (writable? #t))
 644                             ;; Expose TLS certificates for GnuTLS.
 645                             (file-system-mapping
 646                              (source #$(file-append nss-certs "/etc/ssl/certs"))
 647                              (target "/etc/ssl/certs")))
 648                       #:user "jami"
 649                       #:group "jami"
 650                       #:environment-variables
 651                       (list (string-append "DBUS_SESSION_BUS_ADDRESS="
 652                                            "unix:path=/var/run/jami/bus")
 653                             ;; Expose TLS certificates for OpenSSL.
 654                             "SSL_CERT_DIR=/etc/ssl/certs"))))
 655
 656                   (parameterize ((%send-dbus-binary #$dbus-send)
 657                                  (%send-dbus-bus    "unix:path=/var/run/jami/bus")
 658                                  (%send-dbus-user   "jami")
 659                                  (%send-dbus-group  "jami"))
 660
 661                     ;; Wait until the service name has been acquired by D-Bus.
 662                     (with-retries 20 1
 663                       (dbus-service-available? "cx.ring.Ring"))
 664
 665                     (when #$declarative-mode?
 666                       ;; Provision the accounts via the D-Bus API of the daemon.
 667                       (let* ((jami-account-archives
 668                               (map (cut string-append
 669                                         "/var/lib/jami/accounts/" <>)
 670                                    (scandir "/var/lib/jami/accounts/"
 671                                             (lambda (f)
 672                                               (not (member f '("." "..")))))))
 673                              (usernames (map-in-order (cut add-account <>)
 674                                                       jami-account-archives)))
 675
 676                         (define (archive-name->username archive)
 677                           (list-ref
 678                            usernames
 679                            (list-index (lambda (f)
 680                                          (string-suffix? (basename archive) f))
 681                                        jami-account-archives)))
 682
 683                         (for-each
 684                          (lambda (archive allowed-contacts moderators
 685                                           account-details)
 686                            (let ((username (archive-name->username
 687                                             archive)))
 688                              (when (not (eq? 'disabled allowed-contacts))
 689                                ;; Reject calls from unknown contacts.
 690                                (set-account-details
 691                                 '(("DHT.PublicInCalls" . "false")) username)
 692                                ;; Remove all contacts.
 693                                (for-each (cut remove-contact <> username)
 694                                          (username->contacts username))
 695                                ;; Add allowed ones.
 696                                (for-each (cut add-contact <> username)
 697                                          allowed-contacts))
 698                              (when (not (eq? 'disabled moderators))
 699                                ;; Disable the 'AllModerators' property.
 700                                (set-all-moderators #f username)
 701                                ;; Remove all moderators.
 702                                (for-each (cut set-moderator <> #f username)
 703                                          (username->moderators username))
 704                                ;; Add declared moderators.
 705                                (for-each (cut set-moderator <> #t username)
 706                                          moderators))
 707                              ;; Set the various account parameters.
 708                              (set-account-details account-details username)))
 709                          '#$(and declarative-mode?
 710                                  (map-in-order (cut jami-account-archive <>)
 711                                                accounts))
 712                          '#$(and declarative-mode?
 713                                  (map-in-order
 714                                   (cut jami-account-allowed-contacts <>)
 715                                   accounts))
 716                          '#$(and declarative-mode?
 717                                  (map-in-order (cut jami-account-moderators <>)
 718                                                accounts))
 719                          '#$(and declarative-mode?
 720                                  (map-in-order jami-account->alist accounts))))))
 721
 722                   ;; Finally, return the PID of the daemon process.
 723                   daemon-pid))
 724              (stop
 725               #~(lambda (pid . args)
 726                   (kill pid SIGKILL)
 727                   ;; Wait for the process to exit; this prevents overlapping
 728                   ;; processes when issuing 'herd restart'.
 729                   (waitpid pid)
 730                   #f)))))))
 731
 732 (define jami-service-type
 733   (service-type
 734    (name 'jami)
 735    (default-value (jami-configuration))
 736    (extensions
 737     (list (service-extension shepherd-root-service-type
 738                              jami-shepherd-services)
 739           (service-extension account-service-type
 740                              (const %jami-accounts))
 741           (service-extension activation-service-type
 742                              jami-dbus-session-activation)))
 743    (description "Run the Jami daemon (@command{jamid}).  This service is
 744 geared toward the use case of hosting Jami rendezvous points over a headless
 745 server.  If you use Jami on your local machine, you may prefer to setup a user
 746 Shepherd service for it instead; this way, the daemon will be shared via your
 747 normal user D-Bus session bus.")))
 748
 749 \f
 750 ;;;
 751 ;;; Mumble server.
 752 ;;;
 753
 754 ;; https://github.com/mumble-voip/mumble/blob/master/scripts/murmur.ini
 755
 756 (define-record-type* <mumble-server-configuration> mumble-server-configuration
 757   make-mumble-server-configuration
 758   mumble-server-configuration?
 759   (package               mumble-server-configuration-package ;file-like
 760                          (default mumble))
 761   (user                  mumble-server-configuration-user
 762                          (default "mumble-server"))
 763   (group                 mumble-server-configuration-group
 764                          (default "mumble-server"))
 765   (port                  mumble-server-configuration-port
 766                          (default 64738))
 767   (welcome-text          mumble-server-configuration-welcome-text
 768                          (default ""))
 769   (server-password       mumble-server-configuration-server-password
 770                          (default ""))
 771   (max-users             mumble-server-configuration-max-users
 772                          (default 100))
 773   (max-user-bandwidth    mumble-server-configuration-max-user-bandwidth
 774                          (default #f))
 775   (database-file         mumble-server-configuration-database-file
 776                          (default "/var/lib/mumble-server/db.sqlite"))
 777   (log-file              mumble-server-configuration-log-file
 778                          (default "/var/log/mumble-server/mumble-server.log"))
 779   (pid-file              mumble-server-configuration-pid-file
 780                          (default "/var/run/mumble-server/mumble-server.pid"))
 781   (autoban-attempts      mumble-server-configuration-autoban-attempts
 782                          (default 10))
 783   (autoban-timeframe     mumble-server-configuration-autoban-timeframe
 784                          (default 120))
 785   (autoban-time          mumble-server-configuration-autoban-time
 786                          (default 300))
 787   (opus-threshold        mumble-server-configuration-opus-threshold
 788                          (default 100)) ; integer percent
 789   (channel-nesting-limit mumble-server-configuration-channel-nesting-limit
 790                          (default 10))
 791   (channelname-regex     mumble-server-configuration-channelname-regex
 792                          (default #f))
 793   (username-regex        mumble-server-configuration-username-regex
 794                          (default #f))
 795   (text-message-length   mumble-server-configuration-text-message-length
 796                          (default 5000))
 797   (image-message-length  mumble-server-configuration-image-message-length
 798                          (default (* 128 1024))) ; 128 Kilobytes
 799   (cert-required?         mumble-server-configuration-cert-required?
 800                           (default #f))
 801   (remember-channel?     mumble-server-configuration-remember-channel?
 802                          (default #f))
 803   (allow-html?           mumble-server-configuration-allow-html?
 804                          (default #f))
 805   (allow-ping?           mumble-server-configuration-allow-ping?
 806                          (default #f))
 807   (bonjour?              mumble-server-configuration-bonjour?
 808                          (default #f))
 809   (send-version?         mumble-server-configuration-send-version?
 810                          (default #f))
 811   (log-days              mumble-server-configuration-log-days
 812                          (default 31))
 813   (obfuscate-ips?        mumble-server-obfuscate-ips?
 814                          (default #t))
 815   (ssl-cert              mumble-server-configuration-ssl-cert
 816                          (default #f))
 817   (ssl-key               mumble-server-configuration-ssl-key
 818                          (default #f))
 819   (ssl-dh-params         mumble-server-configuration-ssl-dh-params
 820                          (default #f))
 821   (ssl-ciphers           mumble-server-configuration-ssl-ciphers
 822                          (default #f))
 823   (public-registration   mumble-server-configuration-public-registration
 824                          (default #f))  ; <mumble-server-public-registration-configuration>
 825   (file                  mumble-server-configuration-file
 826                          (default #f)))
 827
 828 (define-record-type* <mumble-server-public-registration-configuration>
 829   mumble-server-public-registration-configuration
 830   make-mumble-server-public-registration-configuration
 831   mumble-server-public-registration-configuration?
 832   (name         mumble-server-public-registration-configuration-name)
 833   (password     mumble-server-public-registration-configuration-password)
 834   (url          mumble-server-public-registration-configuration-url)
 835   (hostname     mumble-server-public-registration-configuration-hostname
 836                 (default #f)))
 837
 838 (define (flatten . lst)
 839   "Return a list that recursively concatenates all sub-lists of LST."
 840   (define (flatten1 head out)
 841     (if (list? head)
 842         (fold-right flatten1 out head)
 843         (cons head out)))
 844   (fold-right flatten1 '() lst))
 845
 846 (define (default-mumble-server-config config)
 847   (match-record
 848    config
 849    <mumble-server-configuration>
 850    (user port welcome-text server-password max-users max-user-bandwidth
 851     database-file log-file pid-file autoban-attempts autoban-timeframe
 852     autoban-time opus-threshold channel-nesting-limit channelname-regex
 853     username-regex text-message-length image-message-length cert-required?
 854     remember-channel? allow-html? allow-ping? bonjour? send-version?
 855     log-days obfuscate-ips? ssl-cert ssl-key ssl-dh-params ssl-ciphers
 856     public-registration)
 857    (apply mixed-text-file "mumble-server.ini"
 858           (flatten
 859            "welcometext=" welcome-text "\n"
 860            "port=" (number->string port) "\n"
 861            (if server-password (list "serverpassword=" server-password "\n") '())
 862            (if max-user-bandwidth (list "bandwidth="
 863                                         (number->string max-user-bandwidth) "\n")
 864                '())
 865            "users=" (number->string max-users) "\n"
 866            "uname=" user "\n"
 867            "database=" database-file "\n"
 868            "logfile=" log-file "\n"
 869            "pidfile=" pid-file "\n"
 870            (if autoban-attempts (list "autobanAttempts=" (number->string autoban-attempts) "\n") '())
 871            (if autoban-timeframe (list "autobanTimeframe=" (number->string autoban-timeframe) "\n") '())
 872            (if autoban-time (list "autobanTime=" (number->string autoban-time) "\n") '())
 873            (if opus-threshold (list "opusthreshold=" (number->string opus-threshold) "\n") '())
 874            (if channel-nesting-limit (list "channelnestinglimit=" (number->string channel-nesting-limit) "\n") '())
 875            (if channelname-regex (list "channelname=" channelname-regex "\n") '())
 876            (if username-regex (list "username=" username-regex "\n") '())
 877            (if text-message-length (list "textmessagelength=" (number->string text-message-length) "\n") '())
 878            (if image-message-length (list "imagemessagelength=" (number->string image-message-length) "\n") '())
 879            (if log-days (list "logdays=" (number->string log-days) "\n") '())
 880            "obfuscate=" (if obfuscate-ips? "true" "false") "\n"
 881            "certrequired=" (if cert-required? "true" "false") "\n"
 882            "rememberchannel=" (if remember-channel? "true" "false") "\n"
 883            "allowhtml=" (if allow-html? "true" "false") "\n"
 884            "allowping=" (if allow-ping? "true" "false") "\n"
 885            "bonjour=" (if bonjour? "true" "false") "\n"
 886            "sendversion=" (if send-version? "true" "false") "\n"
 887            (cond ((and ssl-cert ssl-key)
 888                   (list
 889                    "sslCert=" ssl-cert "\n"
 890                    "sslKey=" ssl-key "\n"))
 891                  ((or ssl-cert ssl-key)
 892                   (error "ssl-cert and ssl-key must both be set"
 893                          ssl-cert ssl-key))
 894                  (else '()))
 895            (if ssl-dh-params (list "sslDHParams=" ssl-dh-params) '())
 896            (if ssl-ciphers (list "sslCiphers=" ssl-ciphers) '())
 897
 898            (match public-registration
 899              (#f '())
 900              (($ <mumble-server-public-registration-configuration>
 901                  name password url hostname)
 902               (if (and (or (not server-password) (string-null? server-password))
 903                        allow-ping?)
 904                   (list
 905                    "registerName=" name "\n"
 906                    "registerPassword=" password "\n"
 907                    "registerUrl=" url "\n"
 908                    (if hostname
 909                        (string-append "registerHostname=" hostname "\n")
 910                        ""))
 911                   (error "To publicly register your mumble-server server your server must be publicy visible
 912 and users must be able to join without a password. To fix this set:
 913 (allow-ping? #t)
 914 (server-password \"\")
 915 Or set public-registration to #f"))))))))
 916
 917 (define (mumble-server-activation config)
 918   #~(begin
 919       (use-modules (guix build utils))
 920       (let* ((log-dir (dirname #$(mumble-server-configuration-log-file config)))
 921              (pid-dir (dirname #$(mumble-server-configuration-pid-file config)))
 922              (db-dir (dirname #$(mumble-server-configuration-database-file config)))
 923              (user (getpwnam #$(mumble-server-configuration-user config)))
 924              (init-dir
 925               (lambda (name dir)
 926                 (format #t "creating mumble-server ~a directory '~a'\n" name dir)
 927                 (mkdir-p dir)
 928                 (chown dir (passwd:uid user) (passwd:gid user))
 929                 (chmod dir #o700)))
 930              (ini #$(or (mumble-server-configuration-file config)
 931                         (default-mumble-server-config config))))
 932         (init-dir "log" log-dir)
 933         (init-dir "pid" pid-dir)
 934         (init-dir "database" db-dir)
 935
 936         (format #t "mumble-server: use config file: ~a~%\n" ini)
 937         (format #t "mumble-server: to set the SuperUser password run:
 938     `~a -ini ~a -readsupw`\n"
 939                 #$(file-append (mumble-server-configuration-package config)
 940                                "/bin/mumble-server") ini)
 941         #t)))
 942
 943 (define mumble-server-accounts
 944   (match-lambda
 945     (($ <mumble-server-configuration> _ user group)
 946      (list
 947       (user-group
 948        (name group)
 949        (system? #t))
 950       (user-account
 951        (name user)
 952        (group group)
 953        (system? #t)
 954        (comment "Mumble server daemon")
 955        (home-directory "/var/empty")
 956        (shell (file-append shadow "/sbin/nologin")))))))
 957
 958 (define (mumble-server-shepherd-service config)
 959   (list (shepherd-service
 960          (provision '(mumble-server))
 961          (documentation "Run the Mumble server.")
 962          (requirement '(networking))
 963          (start #~(make-forkexec-constructor
 964                    '(#$(file-append (mumble-server-configuration-package config)
 965                                     "/bin/mumble-server")
 966                      "-ini"
 967                      #$(or (mumble-server-configuration-file config)
 968                            (default-mumble-server-config config)))
 969                    #:pid-file #$(mumble-server-configuration-pid-file config)))
 970          (stop #~(make-kill-destructor)))))
 971
 972 (define mumble-server-service-type
 973   (service-type (name 'mumble-server)
 974                 (description
 975                  "Run the Mumble voice-over-IP (VoIP) server.")
 976                 (extensions
 977                  (list (service-extension shepherd-root-service-type
 978                                           mumble-server-shepherd-service)
 979                        (service-extension activation-service-type
 980                                           mumble-server-activation)
 981                        (service-extension account-service-type
 982                                           mumble-server-accounts)))
 983                 (default-value (mumble-server-configuration))))
 984
 985 (define-deprecated/public-alias
 986   murmur-configuration
 987   mumble-server-configuration)
 988 (define-deprecated/public-alias
 989   make-murmur-configuration
 990   make-mumble-server-configuration)
 991 (define-deprecated/public-alias
 992   murmur-configuration?
 993   mumble-server-configuration?)
 994 (define-deprecated/public-alias
 995   murmur-configuration-package
 996   mumble-server-configuration-package)
 997 (define-deprecated/public-alias
 998   murmur-configuration-user
 999   mumble-server-configuration-user)
1000 (define-deprecated/public-alias
1001   murmur-configuration-group
1002   mumble-server-configuration-group)
1003 (define-deprecated/public-alias
1004   murmur-configuration-port
1005   mumble-server-configuration-port)
1006 (define-deprecated/public-alias
1007   murmur-configuration-welcome-text
1008   mumble-server-configuration-welcome-text)
1009 (define-deprecated/public-alias
1010   murmur-configuration-server-password
1011   mumble-server-configuration-server-password)
1012 (define-deprecated/public-alias
1013   murmur-configuration-max-users
1014   mumble-server-configuration-max-users)
1015 (define-deprecated/public-alias
1016   murmur-configuration-max-user-bandwidth
1017   mumble-server-configuration-max-user-bandwidth)
1018 (define-deprecated/public-alias
1019   murmur-configuration-database-file
1020   mumble-server-configuration-database-file)
1021 (define-deprecated/public-alias
1022   murmur-configuration-log-file
1023   mumble-server-configuration-log-file)
1024 (define-deprecated/public-alias
1025   murmur-configuration-pid-file
1026   mumble-server-configuration-pid-file)
1027 (define-deprecated/public-alias
1028   murmur-configuration-autoban-attempts
1029   mumble-server-configuration-autoban-attempts)
1030 (define-deprecated/public-alias
1031   murmur-configuration-autoban-timeframe
1032   mumble-server-configuration-autoban-timeframe)
1033 (define-deprecated/public-alias
1034   murmur-configuration-autoban-time
1035   mumble-server-configuration-autoban-time)
1036 (define-deprecated/public-alias
1037   murmur-configuration-opus-threshold
1038   mumble-server-configuration-opus-threshold)
1039 (define-deprecated/public-alias
1040   murmur-configuration-channel-nesting-limit
1041   mumble-server-configuration-channel-nesting-limit)
1042 (define-deprecated/public-alias
1043   murmur-configuration-channelname-regex
1044   mumble-server-configuration-channelname-regex)
1045 (define-deprecated/public-alias
1046   murmur-configuration-username-regex
1047   mumble-server-configuration-username-regex)
1048 (define-deprecated/public-alias
1049   murmur-configuration-text-message-length
1050   mumble-server-configuration-text-message-length)
1051 (define-deprecated/public-alias
1052   murmur-configuration-image-message-length
1053   mumble-server-configuration-image-message-length)
1054 (define-deprecated/public-alias
1055   murmur-configuration-cert-required?
1056   mumble-server-configuration-cert-required?)
1057 (define-deprecated/public-alias
1058   murmur-configuration-remember-channel?
1059   mumble-server-configuration-remember-channel?)
1060 (define-deprecated/public-alias
1061   murmur-configuration-allow-html?
1062   mumble-server-configuration-allow-html?)
1063 (define-deprecated/public-alias
1064   murmur-configuration-allow-ping?
1065   mumble-server-configuration-allow-ping?)
1066 (define-deprecated/public-alias
1067   murmur-configuration-bonjour?
1068   mumble-server-configuration-bonjour?)
1069 (define-deprecated/public-alias
1070   murmur-configuration-send-version?
1071   mumble-server-configuration-send-version?)
1072 (define-deprecated/public-alias
1073   murmur-configuration-log-days
1074   mumble-server-configuration-log-days)
1075 (define-deprecated/public-alias
1076   murmur-configuration-obfuscate-ips?
1077   mumble-server-configuration-obfuscate-ips?)
1078 (define-deprecated/public-alias
1079   murmur-configuration-ssl-cert
1080   mumble-server-configuration-ssl-cert)
1081 (define-deprecated/public-alias
1082   murmur-configuration-ssl-key
1083   mumble-server-configuration-ssl-key)
1084 (define-deprecated/public-alias
1085   murmur-configuration-ssl-dh-params
1086   mumble-server-configuration-ssl-dh-params)
1087 (define-deprecated/public-alias
1088   murmur-configuration-ssl-ciphers
1089   mumble-server-configuration-ssl-ciphers)
1090 (define-deprecated/public-alias
1091   murmur-configuration-public-registration
1092   mumble-server-configuration-public-registration)
1093 (define-deprecated/public-alias
1094   murmur-configuration-file
1095   mumble-server-configuration-file)
1096
1097 (define-deprecated/public-alias
1098   murmur-public-registration-configuration
1099   mumble-server-public-registration-configuration)
1100 (define-deprecated/public-alias
1101   make-murmur-public-registration-configuration
1102   make-mumble-server-public-registration-configuration)
1103 (define-deprecated/public-alias
1104   murmur-public-registration-configuration?
1105   mumble-server-public-registration-configuration?)
1106 (define-deprecated/public-alias
1107   murmur-public-registration-configuration-name
1108   mumble-server-public-registration-configuration-name)
1109 (define-deprecated/public-alias
1110   murmur-public-registration-configuration-url
1111   mumble-server-public-registration-configuration-url)
1112 (define-deprecated/public-alias
1113   murmur-public-registration-configuration-password
1114   mumble-server-public-registration-configuration-password)
1115 (define-deprecated/public-alias
1116   murmur-public-registration-configuration-hostname
1117   mumble-server-public-registration-configuration-hostname)
1118
1119 (define-deprecated/public-alias
1120   murmur-service-type
1121   mumble-server-service-type)
1122
1123 ;; Local Variables:
1124 ;; eval: (put 'with-retries 'scheme-indent-function 2)
1125 ;; End: