telephony.scm 45 KB

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