;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 nee ;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu services telephony) #:use-module ((gnu services) #:hide (delete)) #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages glib) #:use-module (gnu packages jami) #:use-module (gnu packages telephony) #:use-module (guix records) #:use-module (guix modules) #:use-module (guix packages) #:use-module (guix gexp) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (jami-daemon-configuration jami-daemon-configuration-jami-daemon jami-daemon-configuration-dbus jami-daemon-configuration-enable-logging? jami-daemon-configuration-debug? jami-daemon-configuration-auto-answer? jami-daemon-configuration-account-archives jami-daemon-service-type murmur-configuration make-murmur-configuration murmur-configuration? murmur-configuration-package murmur-configuration-user murmur-configuration-group murmur-configuration-port murmur-configuration-welcome-text murmur-configuration-server-password murmur-configuration-max-users murmur-configuration-max-user-bandwidth murmur-configuration-database-file murmur-configuration-log-file murmur-configuration-pid-file murmur-configuration-autoban-attempts murmur-configuration-autoban-timeframe murmur-configuration-autoban-time murmur-configuration-opus-threshold murmur-configuration-channel-nesting-limit murmur-configuration-channelname-regex murmur-configuration-username-regex murmur-configuration-text-message-length murmur-configuration-image-message-length murmur-configuration-cert-required? murmur-configuration-remember-channel? murmur-configuration-allow-html? murmur-configuration-allow-ping? murmur-configuration-bonjour? murmur-configuration-send-version? murmur-configuration-log-days murmur-configuration-obfuscate-ips? murmur-configuration-ssl-cert murmur-configuration-ssl-key murmur-configuration-ssl-dh-params murmur-configuration-ssl-ciphers murmur-configuration-public-registration murmur-configuration-file murmur-public-registration-configuration make-murmur-public-registration-configuration murmur-public-registration-configuration? murmur-public-registration-configuration-name murmur-public-registration-configuration-url murmur-public-registration-configuration-password murmur-public-registration-configuration-hostname murmur-service-type)) ;;; ;;; Jami daemon. ;;; ;;; XXX: These dummy definitions is because there's no way to disable the ;;; serialization code from define-configuration. (define (serialize-boolean option value) "") (define (serialize-string-list field-name val) "") ;;; Copied from (gnu services messaging). (define (string-list? val) (and (list? val) (and-map (lambda (x) (or (computed-file? x) ;XXX: for tests (and (string? x) (not (string-index x #\,))))) val))) (define-maybe string-list) (define-configuration jami-daemon-configuration (jami-daemon (package libring) "The Jami daemon package to use.") (dbus (package dbus) "The D-Bus package to use to start the required D-Bus session.") (enable-logging? (boolean #true) "Whether to enable logging to syslog.") (debug? (boolean #false) "Whether to enable debug level messages.") (auto-answer? (boolean #false) "Whether to force automatic answer to incoming calls.") (account-archives (maybe-string-list 'disabled) "A list of Jami account archive (backup) file names to be (re-)provisioned every time the Jami daemon service starts. These Jami account backups should @emp{not} be encrypted and their file should be made readable only to the @samp{jami} user (i.e., not in the store), to guard against leaking the secret key material of the Jami accounts they contain. When providing this field, the account directories under @file{/var/lib/jami/} are recreated every time the service starts, ensuring a consistent state.")) (define %jami-daemon-accounts (list (user-group (name "jami") (system? #t)) (user-account (name "jami") (group "jami") (system? #t) (comment "Jami daemon user") (home-directory "/var/lib/jami")))) (define (jami-daemon-configuration->command-line-arguments config) "Derive the command line arguments to used to launch the Jami daemon from CONFIG, a object." (match-record config (jami-daemon dbus enable-logging? debug? auto-answer?) `(,(file-append jami-daemon "/lib/ring/dring") "--persistent" ;stay alive after client quits ,@(if enable-logging? '() ;logs go to syslog by default (list "--console")) ;else stdout/stderr ,@(if debug? (list "--debug") '()) ,@(if auto-answer? (list "--auto-answer") '())))) (define (jami-dbus-session-activation config) "Create a directory to hold the Jami D-Bus session socket." (with-imported-modules (source-module-closure '((gnu build activation))) #~(begin (use-modules (gnu build activation)) (let ((user (getpwnam "jami"))) (mkdir-p/perms "/var/run/jami" user #o700))))) ;; Local definitions to expand in source form in G-exps. (define define-with-retries '(define-syntax-rule (with-retries n delay body ...) "Retry the code in BODY up to N times until it returns #t, else #f. A delay of DELAY seconds is inserted before each retry." (let loop ((attempts 0)) (if (< attempts n) (or (begin body ...) ;return #t on success (begin (sleep delay) ;else wait and retry (loop (+ 1 attempts)))) #f)))) ;maximum number of attempts reached (define define-send-dbus '(define (send-dbus dbus-send interface method . arguments) "Print the response and return #t on success, else #f." (let* ((command `(,dbus-send "--bus=unix:path=/var/run/jami/bus" "--print-reply" "--dest=cx.ring.Ring" "/cx/ring/Ring/ConfigurationManager" ;object path ,(string-append interface "." method) ,@arguments)) (pid (fork+exec-command command #:user "jami" #:group "jami"))) (zero? (cdr (waitpid pid)))))) (define (jami-daemon-shepherd-services config) "Return a running the Jami daemon." (let* ((jami-daemon (jami-daemon-configuration-jami-daemon config)) (dbus (jami-daemon-configuration-dbus config)) (dbus-daemon (file-append dbus "/bin/dbus-daemon")) (dbus-send (file-append dbus "/bin/dbus-send")) (accounts (jami-daemon-configuration-account-archives config)) (declarative-mode? (not (eq? 'disabled accounts)))) (list (shepherd-service (documentation "Run a D-Bus session for the Jami daemon.") (provision '(jami-daemon-dbus-session)) ;; The requirement on dbus-system is to ensure other required ;; activation for D-Bus, such as a /etc/machine-id file. (requirement '(dbus-system syslogd)) (start #~(lambda args #$define-with-retries (define pid (fork+exec-command (list #$dbus-daemon "--session" "--address=unix:path=/var/run/jami/bus" "--nofork" "--syslog-only" "--nopidfile") #:user "jami" #:group "jami" #:environment-variables ;; This is so that the cx.ring.Ring service D-Bus ;; definition is found by dbus-send. (list (string-append "XDG_DATA_DIRS=" #$jami-daemon "/share")))) ;; XXX: This manual synchronization probably wouldn't be ;; needed if we were using a PID file, but providing it via a ;; customized config file with the would not ;; override the one inherited from the base config of D-Bus. (let ((sock (socket PF_UNIX SOCK_STREAM 0))) (with-retries 20 1 (catch 'system-error (lambda () (connect sock AF_UNIX "/var/run/jami/bus") (close-port sock) #t) (lambda args #f)))) pid)) (stop #~(make-kill-destructor))) (shepherd-service (documentation "Run the Jami daemon.") (provision '(jami-daemon dring)) (requirement '(jami-daemon-dbus-session)) (modules `((ice-9 ftw) (srfi srfi-1) (srfi srfi-26) ,@%default-modules)) (start #~(lambda args #$define-with-retries #$define-send-dbus (when #$declarative-mode? ;; Clear the Jami configuration and accounts, to enforce the ;; declared state. (catch #t (lambda () (delete-file-recursively "/var/lib/jami/.cache/jami") (delete-file-recursively "/var/lib/jami/.config/jami") (delete-file-recursively "/var/lib/jami/.local/share/jami") (delete-file-recursively "/var/lib/jami/accounts")) (lambda args #t)) ;; Copy the Jami accounts from somewhere readable by root to ;; a place only the jami user can read. (let* ((accounts-dir "/var/lib/jami/accounts/") (pwd (getpwnam "jami")) (user (passwd:uid pwd)) (group (passwd:gid pwd))) (mkdir-p accounts-dir) (chown accounts-dir user group) (for-each (lambda (f) (let ((dest (string-append accounts-dir (basename f)))) (copy-file f dest) (chown dest user group))) '#$accounts))) ;; Start the daemon. (define daemon-pid (fork+exec-command '#$(jami-daemon-configuration->command-line-arguments config) #:user "jami" #:group "jami" #:environment-variables (list (string-append "DBUS_SESSION_BUS_ADDRESS=" "unix:path=/var/run/jami/bus")))) ;; Wait until it's reachable via D-Bus. (with-retries 20 1 (send-dbus #$dbus-send "org.freedesktop.DBus.Peer" "Ping")) ;; Provision the accounts. (when #$declarative-mode? (or (every identity (map (lambda (archive) (send-dbus #$dbus-send "cx.ring.Ring.ConfigurationManager" "addAccount" (string-append "dict:string:string:Account.archivePath," archive ",Account.type,RING"))) (map (cut string-append "/var/lib/jami/accounts/" <>) (scandir "/var/lib/jami/accounts/" (lambda (f) (not (member f '("." "..")))))))) (format (current-error-port) "error: failed provisioning the jami accounts"))) ;; Finally, return the PID of the dring process. daemon-pid)) (stop #~(lambda (pid . args) (kill pid SIGTERM) ;; Wait for the process to exit; this prevents overlapping ;; processes when issuing 'herd restart'. (waitpid pid) #f)))))) (define jami-daemon-service-type (service-type (name 'jami-daemon) (default-value (jami-daemon-configuration)) (extensions (list (service-extension shepherd-root-service-type jami-daemon-shepherd-services) (service-extension account-service-type (const %jami-daemon-accounts)) (service-extension activation-service-type jami-dbus-session-activation))) (description "Run the Jami daemon (@command{dring}). This service is geared toward the use case of hosting Jami rendezvous points over a headless server. If you use Jami on your local machine, you may prefer to setup a user Shepherd service for it instead; this way, the daemon will be shared via your normal user D-Bus session bus."))) ;;; ;;; Murmur. ;;; ;; https://github.com/mumble-voip/mumble/blob/master/scripts/murmur.ini (define-record-type* murmur-configuration make-murmur-configuration murmur-configuration? (package murmur-configuration-package ; (default mumble)) (user murmur-configuration-user (default "murmur")) (group murmur-configuration-group (default "murmur")) (port murmur-configuration-port (default 64738)) (welcome-text murmur-configuration-welcome-text (default "")) (server-password murmur-configuration-server-password (default "")) (max-users murmur-configuration-max-users (default 100)) (max-user-bandwidth murmur-configuration-max-user-bandwidth (default #f)) (database-file murmur-configuration-database-file (default "/var/lib/murmur/db.sqlite")) (log-file murmur-configuration-log-file (default "/var/log/murmur/murmur.log")) (pid-file murmur-configuration-pid-file (default "/var/run/murmur/murmur.pid")) (autoban-attempts murmur-configuration-autoban-attempts (default 10)) (autoban-timeframe murmur-configuration-autoban-timeframe (default 120)) (autoban-time murmur-configuration-autoban-time (default 300)) (opus-threshold murmur-configuration-opus-threshold (default 100)) ; integer percent (channel-nesting-limit murmur-configuration-channel-nesting-limit (default 10)) (channelname-regex murmur-configuration-channelname-regex (default #f)) (username-regex murmur-configuration-username-regex (default #f)) (text-message-length murmur-configuration-text-message-length (default 5000)) (image-message-length murmur-configuration-image-message-length (default (* 128 1024))) ; 128 Kilobytes (cert-required? murmur-configuration-cert-required? (default #f)) (remember-channel? murmur-configuration-remember-channel? (default #f)) (allow-html? murmur-configuration-allow-html? (default #f)) (allow-ping? murmur-configuration-allow-ping? (default #f)) (bonjour? murmur-configuration-bonjour? (default #f)) (send-version? murmur-configuration-send-version? (default #f)) (log-days murmur-configuration-log-days (default 31)) (obfuscate-ips? murmur-obfuscate-ips? (default #t)) (ssl-cert murmur-configuration-ssl-cert (default #f)) (ssl-key murmur-configuration-ssl-key (default #f)) (ssl-dh-params murmur-configuration-ssl-dh-params (default #f)) (ssl-ciphers murmur-configuration-ssl-ciphers (default #f)) (public-registration murmur-configuration-public-registration (default #f)) ; (file murmur-configuration-file (default #f))) (define-record-type* murmur-public-registration-configuration make-murmur-public-registration-configuration murmur-public-registration-configuration? (name murmur-public-registration-configuration-name) (password murmur-public-registration-configuration-password) (url murmur-public-registration-configuration-url) (hostname murmur-public-registration-configuration-hostname (default #f))) (define (flatten . lst) "Return a list that recursively concatenates all sub-lists of LST." (define (flatten1 head out) (if (list? head) (fold-right flatten1 out head) (cons head out))) (fold-right flatten1 '() lst)) (define (default-murmur-config config) (match-record config (user port welcome-text server-password max-users max-user-bandwidth database-file log-file pid-file autoban-attempts autoban-timeframe autoban-time opus-threshold channel-nesting-limit channelname-regex username-regex text-message-length image-message-length cert-required? remember-channel? allow-html? allow-ping? bonjour? send-version? log-days obfuscate-ips? ssl-cert ssl-key ssl-dh-params ssl-ciphers public-registration) (apply mixed-text-file "murmur.ini" (flatten "welcometext=" welcome-text "\n" "port=" (number->string port) "\n" (if server-password (list "serverpassword=" server-password "\n") '()) (if max-user-bandwidth (list "bandwidth=" (number->string max-user-bandwidth) "\n") '()) "users=" (number->string max-users) "\n" "uname=" user "\n" "database=" database-file "\n" "logfile=" log-file "\n" "pidfile=" pid-file "\n" (if autoban-attempts (list "autobanAttempts=" (number->string autoban-attempts) "\n") '()) (if autoban-timeframe (list "autobanTimeframe=" (number->string autoban-timeframe) "\n") '()) (if autoban-time (list "autobanTime=" (number->string autoban-time) "\n") '()) (if opus-threshold (list "opusthreshold=" (number->string opus-threshold) "\n") '()) (if channel-nesting-limit (list "channelnestinglimit=" (number->string channel-nesting-limit) "\n") '()) (if channelname-regex (list "channelname=" channelname-regex "\n") '()) (if username-regex (list "username=" username-regex "\n") '()) (if text-message-length (list "textmessagelength=" (number->string text-message-length) "\n") '()) (if image-message-length (list "imagemessagelength=" (number->string image-message-length) "\n") '()) (if log-days (list "logdays=" (number->string log-days) "\n") '()) "obfuscate=" (if obfuscate-ips? "true" "false") "\n" "certrequired=" (if cert-required? "true" "false") "\n" "rememberchannel=" (if remember-channel? "true" "false") "\n" "allowhtml=" (if allow-html? "true" "false") "\n" "allowping=" (if allow-ping? "true" "false") "\n" "bonjour=" (if bonjour? "true" "false") "\n" "sendversion=" (if send-version? "true" "false") "\n" (cond ((and ssl-cert ssl-key) (list "sslCert=" ssl-cert "\n" "sslKey=" ssl-key "\n")) ((or ssl-cert ssl-key) (error "ssl-cert and ssl-key must both be set" ssl-cert ssl-key)) (else '())) (if ssl-dh-params (list "sslDHParams=" ssl-dh-params) '()) (if ssl-ciphers (list "sslCiphers=" ssl-ciphers) '()) (match public-registration (#f '()) (($ name password url hostname) (if (and (or (not server-password) (string-null? server-password)) allow-ping?) (list "registerName=" name "\n" "registerPassword=" password "\n" "registerUrl=" url "\n" (if hostname (string-append "registerHostname=" hostname "\n") "")) (error "To publicly register your murmur server your server must be publicy visible and users must be able to join without a password. To fix this set: (allow-ping? #t) (server-password \"\") Or set public-registration to #f")))))))) (define (murmur-activation config) #~(begin (use-modules (guix build utils)) (let* ((log-dir (dirname #$(murmur-configuration-log-file config))) (pid-dir (dirname #$(murmur-configuration-pid-file config))) (db-dir (dirname #$(murmur-configuration-database-file config))) (user (getpwnam #$(murmur-configuration-user config))) (init-dir (lambda (name dir) (format #t "creating murmur ~a directory '~a'\n" name dir) (mkdir-p dir) (chown dir (passwd:uid user) (passwd:gid user)) (chmod dir #o700))) (ini #$(or (murmur-configuration-file config) (default-murmur-config config)))) (init-dir "log" log-dir) (init-dir "pid" pid-dir) (init-dir "database" db-dir) (format #t "murmur: use config file: ~a~%\n" ini) (format #t "murmur: to set the SuperUser password run: `~a -ini ~a -readsupw`\n" #$(file-append (murmur-configuration-package config) "/bin/murmurd") ini) #t))) (define murmur-accounts (match-lambda (($ _ user group) (list (user-group (name group) (system? #t)) (user-account (name user) (group group) (system? #t) (comment "Murmur Daemon") (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))))) (define (murmur-shepherd-service config) (list (shepherd-service (provision '(murmur)) (documentation "Run the Murmur Mumble server.") (requirement '(networking)) (start #~(make-forkexec-constructor '(#$(file-append (murmur-configuration-package config) "/bin/murmurd") "-ini" #$(or (murmur-configuration-file config) (default-murmur-config config))) #:pid-file #$(murmur-configuration-pid-file config))) (stop #~(make-kill-destructor))))) (define murmur-service-type (service-type (name 'murmur) (description "Run the Murmur voice-over-IP (VoIP) server of the Mumble suite.") (extensions (list (service-extension shepherd-root-service-type murmur-shepherd-service) (service-extension activation-service-type murmur-activation) (service-extension account-service-type murmur-accounts))) (default-value (murmur-configuration))))