projects/guix·blob java-team · refs

1111 lines · 49.3 KiB

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