;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 nee  <nee-git@hidamari.blue>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(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))


\f
;;;
;;; 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 <jami-daemon-configuration> object."
  (match-record config <jami-daemon-configuration>
    (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 <shepherd-service> 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 <pidfile> would not
                ;; override the one inherited from the base config of D-Bus.
                (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
                  (with-retries 20 1 (catch 'system-error
                                       (lambda ()
                                         (connect sock AF_UNIX
                                                  "/var/run/jami/bus")
                                         (close-port sock)
                                         #t)
                                       (lambda args
                                         #f))))

                pid))
           (stop #~(make-kill-destructor)))

          (shepherd-service
           (documentation "Run the Jami daemon.")
           (provision '(jami-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.")))

\f
;;;
;;; Murmur.
;;;

;; https://github.com/mumble-voip/mumble/blob/master/scripts/murmur.ini

(define-record-type* <murmur-configuration> murmur-configuration
  make-murmur-configuration
  murmur-configuration?
  (package               murmur-configuration-package ;<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))  ; <murmur-public-registration-configuration>
  (file                  murmur-configuration-file
                         (default #f)))

(define-record-type* <murmur-public-registration-configuration>
  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
   <murmur-configuration>
   (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 '())
             (($ <murmur-public-registration-configuration>
                 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
    (($ <murmur-configuration> _ 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))))