projects/guix·blob javascript-team · refs

2825 lines · 105.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017, 2018 Clément Lassieur <[email protected]>
3;;; Copyright © 2017 Mathieu Othacehe <[email protected]>
4;;; Copyright © 2015, 2017-2020, 2022-2024 Ludovic Courtès <[email protected]>
5;;; Copyright © 2018 Pierre-Antoine Rouby <[email protected]>
6;;; Copyright © 2025 Maxim Cournoyer <[email protected]>
7;;; Copyright © 2024 Evgeny Pisemsky <[email protected]>
8;;; Copyright © 2026 Giacomo Leidi <[email protected]>
9;;;
10;;; This file is part of GNU Guix.
11;;;
12;;; GNU Guix is free software; you can redistribute it and/or modify it
13;;; under the terms of the GNU General Public License as published by
14;;; the Free Software Foundation; either version 3 of the License, or (at
15;;; your option) any later version.
16;;;
17;;; GNU Guix is distributed in the hope that it will be useful, but
18;;; WITHOUT ANY WARRANTY; without even the implied warranty of
19;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;;; GNU General Public License for more details.
21;;;
22;;; You should have received a copy of the GNU General Public License
23;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26;;;
27;;; Messaging services.
28;;;
29;;; Code:
30
31(define-module (gnu services messaging)
32 #:use-module ((gnu home services utils) #:select (object->camel-case-string))
33 #:use-module (gnu packages admin)
34 #:use-module (gnu packages base)
35 #:use-module (gnu packages irc)
36 #:use-module (gnu packages messaging)
37 #:use-module (gnu packages python)
38 #:autoload (gnu packages rust-apps) (mollysocket)
39 #:use-module (gnu packages tls)
40 #:use-module (gnu services)
41 #:use-module (gnu services admin)
42 #:use-module (gnu services shepherd)
43 #:use-module (gnu services configuration)
44 #:use-module (gnu system shadow)
45 #:autoload (gnu build linux-container) (%namespaces)
46 #:use-module ((gnu system file-systems) #:select (file-system-mapping))
47 #:use-module (guix diagnostics)
48 #:use-module (guix gexp)
49 #:use-module (guix i18n)
50 #:use-module (guix modules)
51 #:use-module (guix records)
52 #:use-module (guix packages)
53 #:use-module (guix deprecation)
54 #:use-module (guix least-authority)
55 #:use-module (srfi srfi-1)
56 #:use-module (srfi srfi-26)
57 #:use-module (srfi srfi-35)
58 #:use-module (srfi srfi-71)
59 #:use-module (ice-9 format)
60 #:use-module (ice-9 match)
61 #:export (prosody-service-type
62 prosody-configuration
63 opaque-prosody-configuration
64
65 virtualhost-configuration
66 int-component-configuration
67 ext-component-configuration
68
69 mod-muc-configuration
70 ssl-configuration
71
72 %default-modules-enabled
73 prosody-configuration-pidfile
74
75 bitlbee-configuration
76 bitlbee-configuration?
77 bitlbee-service-type
78
79 ngircd-service-type
80 ngircd-configuration
81 ngircd-configuration?
82 ngircd-configuration-ngircd
83 ngircd-configuration-debug?
84 ngircd-configuration-shepherd-requirement
85 ngircd-configuration-global
86 ngircd-configuration-limits
87 ngircd-configuration-options
88 ngircd-configuration-ssl
89 ngircd-configuration-operators
90 ngircd-configuration-servers
91 ngircd-configuration-channels
92 ngircd-global
93 ngircd-global?
94 ngircd-global-name
95 ngircd-global-admin-info-1
96 ngircd-global-admin-info-2
97 ngircd-global-admin-email
98 ngircd-global-help-file
99 ngircd-global-info
100 ngircd-global-listen
101 ngircd-global-motd-file
102 ngircd-global-motd-phrase
103 ngircd-global-network
104 ngircd-global-password
105 ngircd-global-pid-file
106 ngircd-global-ports
107 ngircd-global-server-uid
108 ngircd-global-server-gid
109 ngircd-limits
110 ngircd-limits?
111 ngircd-limits-connect-retry
112 ngircd-limits-max-connections
113 ngircd-limits-max-connections-ip
114 ngircd-limits-max-joins
115 ngircd-limits-max-list-size
116 ngircd-limits-ping-timeout
117 ngircd-limits-pong-timeout
118 ngircd-options
119 ngircd-options?
120 ngircd-options-allowed-channel-types
121 ngircd-options-allow-remote-oper?
122 ngircd-options-connect-ipv4?
123 ngircd-options-connect-ipv6?
124 ngircd-options-dns?
125 ngircd-options-more-privacy?
126 ngircd-options-notice-before-registration?
127 ngircd-options-oper-can-use-mode?
128 ngircd-options-oper-chan-p-auto-op?
129 ngircd-options-oper-server-mode?
130 ngircd-options-pam?
131 ngircd-options-pam-is-optional?
132 ngircd-options-require-auth-ping?
133 ngircd-ssl
134 ngircd-ssl?
135 ngircd-ssl-cert-file
136 ngircd-ssl-key-file
137 ngircd-ssl-ca-file
138 ngircd-ssl-ports
139 ngircd-ssl-cipher-list
140 ngircd-ssl-dh-file
141 ngircd-operator
142 ngircd-operator?
143 ngircd-operator-name
144 ngircd-operator-password
145 ngircd-operator-mask
146 ngircd-server
147 ngircd-server?
148 ngircd-server-name
149 ngircd-server-host
150 ngircd-server-my-password
151 ngircd-server-peer-password
152 ngircd-server-bind
153 ngircd-server-port
154 ngircd-server-group
155 ngircd-server-passive?
156 ngircd-server-ssl-connect?
157 ngircd-server-ssl-verify?
158 ngircd-channel
159 ngircd-channel?
160 ngircd-channel-name
161 ngircd-channel-topic
162 ngircd-channel-modes
163 ngircd-channel-key-file
164
165 pounce-configuration
166 pounce-configuration-pounce
167 pounce-configuration-shepherd-provision
168 pounce-configuration-shepherd-requirement
169 pounce-configuration-log-file
170 pounce-configuration-verbose?
171 pounce-configuration-local-host
172 pounce-configuration-local-port
173 pounce-configuration-local-ca
174 pounce-configuration-local-cert
175 pounce-configuration-local-priv
176 pounce-configuration-local-pass
177 pounce-configuration-size
178 pounce-configuration-bind
179 pounce-configuration-host
180 pounce-configuration-port
181 pounce-configuration-pass
182 pounce-configuration-join
183 pounce-configuration-mode
184 pounce-configuration-user
185 pounce-configuration-nick
186 pounce-configuration-real
187 pounce-configuration-away
188 pounce-configuration-quit
189 pounce-configuration-no-names?
190 pounce-configuration-queue-interval
191 pounce-configuration-trust
192 pounce-configuration-client-cert
193 pounce-configuration-client-priv
194 pounce-configuration-sasl-plain
195 pounce-configuration-sasl-external?
196
197 pounce-service-type
198
199 quassel-configuration
200 quassel-service-type
201
202 snuik-configuration
203 snuik-service-type
204
205 mosquitto-configuration
206 mosquitto-configuration?
207 mosquitto-configuration-package
208 mosquitto-configuration-config-file
209 mosquitto-configuration-user
210 mosquitto-configuration-group
211 mosquitto-service-type
212
213 mollysocket-configuration
214 mollysocket-configuration?
215 mollysocket-configuration-host
216 mollysocket-configuration-port
217 mollysocket-configuration-webserver
218 mollysocket-configuration-allowed-endpoints
219 mollysocket-configuration-allowed-uuids
220 mollysocket-configuration-db
221 mollysocket-configuration-vapid-key-file
222 mollysocket-service-type
223
224 %default-soju-shepherd-requirement
225
226 soju-ssl
227 soju-ssl?
228 soju-ssl-fields
229 soju-ssl-certificate
230 soju-ssl-key
231
232 soju-database
233 soju-database?
234 soju-database-fields
235 soju-database-datadir
236 soju-database-driver
237 soju-database-source
238
239 soju-configuration
240 soju-configuration?
241 soju-configuration-fields
242 soju-configuration-soju
243 soju-configuration-debug?
244 soju-configuration-listen
245 soju-configuration-hostname
246 soju-configuration-title
247 soju-configuration-ssl-certificate
248 soju-configuration-log-file
249 soju-configuration-shepherd-requirement
250 soju-configuration-database
251 soju-configuration-extra-content
252
253 soju-configuration->mixed-text-file
254 soju-activation
255 soju-accounts
256 soju-shepherd-services
257
258 soju-service-type
259
260 zulip-irc-bridge-configuration
261 zulip-irc-bridge-service-type))
262
263(define-syntax define-all-configurations
264 (lambda (stx)
265 (define-syntax-rule (id ctx parts ...)
266 "Assemble PARTS into a raw (unhygienic) identifier."
267 (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
268 (define (make-pred arg)
269 (lambda (field target)
270 (and (memq (syntax->datum target) `(common ,arg)) field)))
271 (syntax-case stx ()
272 ;; TODO Also handle (field-type) form, without a default.
273 ((_ stem (field (field-type def) doc target) ...)
274 (with-syntax (((new-field-type ...)
275 (map (lambda (field-type target)
276 (if (and (eq? 'common (syntax->datum target))
277 (not (string-prefix?
278 "maybe-"
279 (symbol->string
280 (syntax->datum field-type)))))
281 (id #'stem #'maybe- field-type) field-type))
282 #'(field-type ...) #'(target ...)))
283 ((new-def ...)
284 (map (lambda (def target)
285 (if (eq? 'common (syntax->datum target))
286 ;; TODO Use the %unset-value variable, or
287 ;; even better just simplify this so that it
288 ;; doesn't interfere with
289 ;; define-configuration and define-maybe
290 ;; internals.
291 #''%unset-marker% def))
292 #'(def ...) #'(target ...)))
293 ((new-doc ...)
294 (map (lambda (doc target)
295 (if (eq? 'common (syntax->datum target))
296 "" doc))
297 #'(doc ...) #'(target ...))))
298 #`(begin
299 (define #,(id #'stem #'common-fields)
300 '(#,@(filter-map (make-pred #f) #'(field ...) #'(target ...))))
301 (define-configuration #,(id #'stem #'prosody-configuration)
302 #,@(filter-map (make-pred 'global)
303 #'((field (field-type def) doc) ...)
304 #'(target ...)))
305 (define-configuration #,(id #'stem #'virtualhost-configuration)
306 #,@(filter-map (make-pred 'virtualhost)
307 #'((field (new-field-type new-def) new-doc) ...)
308 #'(target ...)))
309 (define-configuration #,(id #'stem #'int-component-configuration)
310 #,@(filter-map (make-pred 'int-component)
311 #'((field (new-field-type new-def) new-doc) ...)
312 #'(target ...)))
313 (define-configuration #,(id #'stem #'ext-component-configuration)
314 #,@(filter-map (make-pred 'ext-component)
315 #'((field (new-field-type new-def) new-doc) ...)
316 #'(target ...)))))))))
317
318(define (uglify-field-name field-name)
319 (let ((str (symbol->string field-name)))
320 (string-join (string-split (if (string-suffix? "?" str)
321 (substring str 0 (1- (string-length str)))
322 str)
323 #\-)
324 "_")))
325
326(define (serialize-field field-name val)
327 #~(format #f "~a = ~a;\n" #$(uglify-field-name field-name) #$val))
328(define (serialize-field-list field-name val)
329 (serialize-field field-name #~(format #f "{\n~@{~a;\n~}}" #$@val)))
330
331(define (serialize-boolean field-name val)
332 (serialize-field field-name (if val "true" "false")))
333(define-maybe boolean)
334
335(define (string-or-boolean? val)
336 (or (string? val) (boolean? val)))
337(define (serialize-string-or-boolean field-name val)
338 (if (string? val)
339 (serialize-string field-name val)
340 (serialize-boolean field-name val)))
341
342(define (non-negative-integer? val)
343 (and (exact-integer? val) (not (negative? val))))
344(define (serialize-non-negative-integer field-name val)
345 (serialize-field field-name (number->string val)))
346(define-maybe non-negative-integer)
347
348(define (non-negative-integer-list? val)
349 (and (list? val) (and-map non-negative-integer? val)))
350(define (serialize-non-negative-integer-list field-name val)
351 (serialize-field-list field-name (map number->string val)))
352(define-maybe non-negative-integer-list)
353
354(define (enclose-quotes s)
355 #~(string-append "\"" #$s "\""))
356(define (serialize-string field-name val)
357 (serialize-field field-name (enclose-quotes val)))
358(define-maybe string)
359
360(define (string-list? val)
361 (and (list? val)
362 (and-map (lambda (x)
363 (and (string? x) (not (string-index x #\,))))
364 val)))
365(define (serialize-string-list field-name val)
366 (serialize-field-list field-name (map enclose-quotes val)))
367(define-maybe string-list)
368
369(define (module-list? val)
370 (string-list? val))
371(define (serialize-module-list field-name val)
372 (serialize-string-list field-name val))
373(define-maybe module-list)
374
375(define (file-name? val)
376 (and (string? val)
377 (string-prefix? "/" val)))
378(define (serialize-file-name field-name val)
379 (serialize-string field-name val))
380(define-maybe file-name)
381
382(define (file-name-list? val)
383 (and (list? val) (and-map file-name? val)))
384(define (serialize-file-name-list field-name val)
385 (serialize-string-list field-name val))
386(define-maybe file-name-list)
387
388(define (file-object? val)
389 (or (file-like? val) (file-name? val)))
390(define (serialize-file-object field-name val)
391 (serialize-string field-name val))
392(define-maybe file-object)
393
394(define (file-object-list? val)
395 (and (list? val) (and-map file-object? val)))
396(define (serialize-file-object-list field-name val)
397 (serialize-string-list field-name val))
398(define-maybe file-object-list)
399
400(define (raw-content? val)
401 (maybe-value-set? val))
402(define (serialize-raw-content field-name val)
403 val)
404(define-maybe raw-content)
405
406(define-configuration mod-muc-configuration
407 (name
408 (string "Prosody Chatrooms")
409 "The name to return in service discovery responses.")
410
411 (restrict-room-creation
412 (string-or-boolean #f)
413 "If @samp{#t}, this will only allow admins to create new chatrooms.
414Otherwise anyone can create a room. The value @samp{\"local\"} restricts room
415creation to users on the service's parent domain. E.g. @samp{user@@example.com}
416can create rooms on @samp{rooms.example.com}. The value @samp{\"admin\"}
417restricts to service administrators only.")
418
419 (max-history-messages
420 (non-negative-integer 20)
421 "Maximum number of history messages that will be sent to the member that has
422just joined the room."))
423(define (serialize-mod-muc-configuration field-name val)
424 (serialize-configuration val mod-muc-configuration-fields))
425(define-maybe mod-muc-configuration)
426
427(define-configuration ssl-configuration
428 (protocol
429 maybe-string
430 "This determines what handshake to use.")
431
432 (key
433 maybe-file-name
434 "Path to your private key file.")
435
436 (certificate
437 maybe-file-name
438 "Path to your certificate file.")
439
440 (capath
441 (file-object "/etc/ssl/certs")
442 "Path to directory containing root certificates that you wish Prosody to
443trust when verifying the certificates of remote servers.")
444
445 (cafile
446 maybe-file-object
447 "Path to a file containing root certificates that you wish Prosody to trust.
448Similar to @code{capath} but with all certificates concatenated together.")
449
450 (verify
451 maybe-string-list
452 "A list of verification options (these mostly map to OpenSSL's
453@code{set_verify()} flags).")
454
455 (options
456 maybe-string-list
457 "A list of general options relating to SSL/TLS. These map to OpenSSL's
458@code{set_options()}. For a full list of options available in LuaSec, see the
459LuaSec source.")
460
461 (depth
462 maybe-non-negative-integer
463 "How long a chain of certificate authorities to check when looking for a
464trusted root certificate.")
465
466 (ciphers
467 maybe-string
468 "An OpenSSL cipher string. This selects what ciphers Prosody will offer to
469clients, and in what order.")
470
471 (dhparam
472 maybe-file-name
473 "A path to a file containing parameters for Diffie-Hellman key exchange. You
474can create such a file with:
475@code{openssl dhparam -out /etc/prosody/certs/dh-2048.pem 2048}")
476
477 (curve
478 maybe-string
479 "Curve for Elliptic curve Diffie-Hellman. Prosody's default is
480@samp{\"secp384r1\"}.")
481
482 (verifyext
483 maybe-string-list
484 "A list of \"extra\" verification options.")
485
486 (password
487 maybe-string
488 "Password for encrypted private keys."))
489(define (serialize-ssl-configuration field-name val)
490 #~(format #f "ssl = {\n~a};\n"
491 #$(serialize-configuration val ssl-configuration-fields)))
492(define-maybe ssl-configuration)
493
494(define %default-modules-enabled
495 '("roster"
496 "saslauth"
497 "tls"
498 "dialback"
499 "disco"
500 "carbons"
501 "private"
502 "blocklist"
503 "vcard"
504 "version"
505 "uptime"
506 "time"
507 "ping"
508 "pep"
509 "register"
510 "admin_adhoc"))
511
512;; Guile bug. Use begin wrapper, because otherwise virtualhost-configuration
513;; is assumed to be a function. See
514;; https://www.gnu.org/software/guile/manual/html_node/R6RS-Incompatibilities.html
515(begin
516 (define (virtualhost-configuration-list? val)
517 (and (list? val) (and-map virtualhost-configuration? val)))
518 (define (serialize-virtualhost-configuration-list l)
519 #~(string-append
520 #$@(map (lambda (val)
521 (serialize-virtualhost-configuration val)) l)))
522
523 (define (int-component-configuration-list? val)
524 (and (list? val) (and-map int-component-configuration? val)))
525 (define (serialize-int-component-configuration-list l)
526 #~(string-append
527 #$@(map (lambda (val)
528 (serialize-int-component-configuration val)) l)))
529
530 (define (ext-component-configuration-list? val)
531 (and (list? val) (and-map ext-component-configuration? val)))
532 (define (serialize-ext-component-configuration-list l)
533 #~(string-append
534 #$@(map (lambda (val)
535 (serialize-ext-component-configuration val)) l)))
536
537 (define-all-configurations prosody-configuration
538 (prosody
539 (file-like prosody)
540 "The Prosody package."
541 global)
542
543 (data-path
544 (file-name "/var/lib/prosody")
545 "Location of the Prosody data storage directory. See
546@url{https://prosody.im/doc/configure}."
547 global)
548
549 (plugin-paths
550 (file-object-list '())
551 "Additional plugin directories. They are searched in all the specified
552paths in order. See @url{https://prosody.im/doc/plugins_directory}."
553 global)
554
555 (certificates
556 (file-name "/etc/prosody/certs")
557 "Every virtual host and component needs a certificate so that clients and
558servers can securely verify its identity. Prosody will automatically load
559certificates/keys from the directory specified here."
560 global)
561
562 (admins
563 (string-list '())
564 "This is a list of accounts that are admins for the server. Note that you
565must create the accounts separately. See @url{https://prosody.im/doc/admins} and
566@url{https://prosody.im/doc/creating_accounts}.
567Example: @code{(admins '(\"user1@@example.com\" \"user2@@example.net\"))}"
568 common)
569
570 (use-libevent?
571 (boolean #f)
572 "Enable use of libevent for better performance under high load. See
573@url{https://prosody.im/doc/libevent}."
574 common)
575
576 (modules-enabled
577 (module-list %default-modules-enabled)
578 "This is the list of modules Prosody will load on startup. It looks for
579@code{mod_modulename.lua} in the plugins folder, so make sure that exists too.
580Documentation on modules can be found at:
581@url{https://prosody.im/doc/modules}."
582 common)
583
584 (modules-disabled
585 (string-list '())
586 "@samp{\"offline\"}, @samp{\"c2s\"} and @samp{\"s2s\"} are auto-loaded, but
587should you want to disable them then add them to this list."
588 common)
589
590 (groups-file
591 (file-object "/var/lib/prosody/sharedgroups.txt")
592 "Path to a text file where the shared groups are defined. If this path is
593empty then @samp{mod_groups} does nothing. See
594@url{https://prosody.im/doc/modules/mod_groups}."
595 common)
596
597 (allow-registration?
598 (boolean #f)
599 "Disable account creation by default, for security. See
600@url{https://prosody.im/doc/creating_accounts}."
601 common)
602
603 (ssl
604 (maybe-ssl-configuration (ssl-configuration))
605 "These are the SSL/TLS-related settings. Most of them are disabled so to
606use Prosody's defaults. If you do not completely understand these options, do
607not add them to your config, it is easy to lower the security of your server
608using them. See @url{https://prosody.im/doc/advanced_ssl_config}."
609 common)
610
611 (c2s-require-encryption?
612 (boolean #f)
613 "Whether to force all client-to-server connections to be encrypted or not.
614See @url{https://prosody.im/doc/modules/mod_tls}."
615 common)
616
617 (disable-sasl-mechanisms
618 (string-list '("DIGEST-MD5"))
619 "Set of mechanisms that will never be offered. See
620@url{https://prosody.im/doc/modules/mod_saslauth}."
621 common)
622
623 (insecure-sasl-mechanisms
624 (string-list '("PLAIN" "LOGIN"))
625 "Set of mechanisms that will not be offered on unencrypted connections.
626See @url{https://prosody.im/doc/modules/mod_saslauth}."
627 common)
628
629 (s2s-require-encryption?
630 (boolean #f)
631 "Whether to force all server-to-server connections to be encrypted or not.
632See @url{https://prosody.im/doc/modules/mod_tls}."
633 common)
634
635 (s2s-secure-auth?
636 (boolean #f)
637 "Whether to require encryption and certificate authentication. This
638provides ideal security, but requires servers you communicate with to support
639encryption AND present valid, trusted certificates. See
640@url{https://prosody.im/doc/s2s#security}."
641 common)
642
643 (s2s-insecure-domains
644 (string-list '())
645 "Many servers don't support encryption or have invalid or self-signed
646certificates. You can list domains here that will not be required to
647authenticate using certificates. They will be authenticated using DNS. See
648@url{https://prosody.im/doc/s2s#security}."
649 common)
650
651 (s2s-secure-domains
652 (string-list '())
653 "Even if you leave @code{s2s-secure-auth?} disabled, you can still require
654valid certificates for some domains by specifying a list here. See
655@url{https://prosody.im/doc/s2s#security}."
656 common)
657
658 (authentication
659 (string "internal_plain")
660 "Select the authentication backend to use. The default provider stores
661passwords in plaintext and uses Prosody's configured data storage to store the
662authentication data. If you do not trust your server please see
663@url{https://prosody.im/doc/modules/mod_auth_internal_hashed} for information
664about using the hashed backend. See also
665@url{https://prosody.im/doc/authentication}"
666 common)
667
668 ;; TODO: Handle more complicated log structures.
669 (log
670 (maybe-string "*syslog")
671 "Set logging options. Advanced logging configuration is not yet supported
672by the Prosody service. See @url{https://prosody.im/doc/logging}."
673 common)
674
675 (pidfile
676 (file-name "/var/run/prosody/prosody.pid")
677 "File to write pid in. See @url{https://prosody.im/doc/modules/mod_posix}."
678 global)
679
680 (http-max-content-size
681 (maybe-non-negative-integer %unset-value)
682 "Maximum allowed size of the HTTP body (in bytes)."
683 common)
684
685 (http-external-url
686 (maybe-string %unset-value)
687 "Some modules expose their own URL in various ways. This URL is built
688from the protocol, host and port used. If Prosody sits behind a proxy, the
689public URL will be @code{http-external-url} instead. See
690@url{https://prosody.im/doc/http#external_url}."
691 common)
692
693 (virtualhosts
694 (virtualhost-configuration-list
695 (list (virtualhost-configuration
696 (domain "localhost"))))
697 "A host in Prosody is a domain on which user accounts can be created. For
698example if you want your users to have addresses like
699@samp{\"john.smith@@example.com\"} then you need to add a host
700@samp{\"example.com\"}. All options in this list will apply only to this host.
701
702Note: the name \"virtual\" host is used in configuration to avoid confusion with
703the actual physical host that Prosody is installed on. A single Prosody
704instance can serve many domains, each one defined as a VirtualHost entry in
705Prosody's configuration. Conversely a server that hosts a single domain would
706have just one VirtualHost entry.
707
708See @url{https://prosody.im/doc/configure#virtual_host_settings}."
709 global)
710
711 (int-components
712 (int-component-configuration-list '())
713 "Components are extra services on a server which are available to clients,
714usually on a subdomain of the main server (such as
715@samp{\"mycomponent.example.com\"}). Example components might be chatroom
716servers, user directories, or gateways to other protocols.
717
718Internal components are implemented with Prosody-specific plugins. To add an
719internal component, you simply fill the hostname field, and the plugin you wish
720to use for the component.
721
722See @url{https://prosody.im/doc/components}."
723 global)
724
725 (ext-components
726 (ext-component-configuration-list '())
727 "External components use XEP-0114, which most standalone components
728support. To add an external component, you simply fill the hostname field. See
729@url{https://prosody.im/doc/components}."
730 global)
731
732 (component-secret
733 (string (configuration-missing-field 'ext-component 'component-secret))
734 "Password which the component will use to log in."
735 ext-component)
736
737 (component-ports
738 (non-negative-integer-list '(5347))
739 "Port(s) Prosody listens on for component connections."
740 global)
741
742 (component-interface
743 (string "127.0.0.1")
744 "Interface Prosody listens on for component connections."
745 global)
746
747 (domain
748 (string (configuration-missing-field 'virtualhost 'domain))
749 "Domain you wish Prosody to serve."
750 virtualhost)
751
752 (hostname
753 (string (configuration-missing-field 'int-component 'hostname))
754 "Hostname of the component."
755 int-component)
756
757 (plugin
758 (string (configuration-missing-field 'int-component 'plugin))
759 "Plugin you wish to use for the component."
760 int-component)
761
762 (mod-muc
763 (maybe-mod-muc-configuration %unset-value)
764 "Multi-user chat (MUC) is Prosody's module for allowing you to create
765hosted chatrooms/conferences for XMPP users.
766
767General information on setting up and using multi-user chatrooms can be found
768in the \"Chatrooms\" documentation (@url{https://prosody.im/doc/chatrooms}),
769which you should read if you are new to XMPP chatrooms.
770
771See also @url{https://prosody.im/doc/modules/mod_muc}."
772 int-component)
773
774 (hostname
775 (string (configuration-missing-field 'ext-component 'hostname))
776 "Hostname of the component."
777 ext-component)
778
779 (raw-content
780 (maybe-raw-content %unset-value)
781 "Raw content that will be added to the configuration file."
782 common)))
783
784;; Serialize Virtualhost line first.
785(define (serialize-virtualhost-configuration config)
786 (define (rest? field)
787 (not (memq (configuration-field-name field)
788 '(domain))))
789 (let ((domain (virtualhost-configuration-domain config))
790 (rest (filter rest? virtualhost-configuration-fields)))
791 #~(string-append
792 #$(format #f "VirtualHost \"~a\"\n" domain)
793 #$(serialize-configuration config rest))))
794
795;; Serialize Component line first.
796(define (serialize-int-component-configuration config)
797 (define (rest? field)
798 (not (memq (configuration-field-name field)
799 '(hostname plugin))))
800 (let ((hostname (int-component-configuration-hostname config))
801 (plugin (int-component-configuration-plugin config))
802 (rest (filter rest? int-component-configuration-fields)))
803 #~(string-append
804 #$(format #f "Component \"~a\" \"~a\"\n" hostname plugin)
805 #$(serialize-configuration config rest))))
806
807;; Serialize Component line first.
808(define (serialize-ext-component-configuration config)
809 (define (rest? field)
810 (not (memq (configuration-field-name field)
811 '(hostname))))
812 (let ((hostname (ext-component-configuration-hostname config))
813 (rest (filter rest? ext-component-configuration-fields)))
814 #~(string-append
815 #$(format #f "Component \"~a\"\n" hostname)
816 #$(serialize-configuration config rest))))
817
818;; Serialize virtualhosts and components last.
819(define (serialize-prosody-configuration config)
820 (define (rest? field)
821 (not (memq (configuration-field-name field)
822 '(virtualhosts int-components ext-components))))
823 #~(string-append
824 #$(let ((rest (filter rest? prosody-configuration-fields)))
825 (serialize-configuration config rest))
826 #$(serialize-virtualhost-configuration-list
827 (prosody-configuration-virtualhosts config))
828 #$(serialize-int-component-configuration-list
829 (prosody-configuration-int-components config))
830 #$(serialize-ext-component-configuration-list
831 (prosody-configuration-ext-components config))))
832
833(define-configuration opaque-prosody-configuration
834 (prosody
835 (file-like prosody)
836 "The prosody package.")
837
838 (prosody.cfg.lua
839 (string (configuration-missing-field 'opaque-prosody-configuration
840 'prosody.cfg.lua))
841 "The contents of the @code{prosody.cfg.lua} to use."))
842
843(define (prosody-shepherd-service config)
844 "Return a <shepherd-service> for Prosody with CONFIG."
845 (let* ((prosody (if (opaque-prosody-configuration? config)
846 (opaque-prosody-configuration-prosody config)
847 (prosody-configuration-prosody config)))
848 (pid-file (prosody-configuration-pidfile config))
849 (prosody-bin (file-append prosody "/bin/prosody")))
850 (list (shepherd-service
851 (documentation "Run the Prosody XMPP server")
852 (provision '(prosody xmpp-daemon))
853 (requirement '(networking syslogd user-processes))
854 (modules `((ice-9 match)
855 ,@%default-modules))
856 (start #~(make-forkexec-constructor
857 (list #$prosody-bin "-F")
858 #:user "prosody"
859 #:group "prosody"
860 #:pid-file #$pid-file))
861 (stop #~(make-kill-destructor))))))
862
863(define %prosody-accounts
864 (list (user-group (name "prosody") (system? #t))
865 (user-account
866 (name "prosody")
867 (group "prosody")
868 (system? #t)
869 (comment "Prosody daemon user")
870 (home-directory "/var/empty")
871 (shell (file-append shadow "/sbin/nologin")))))
872
873(define (prosody-activation config)
874 "Return the activation gexp for CONFIG."
875 (let* ((config-dir "/etc/prosody")
876 (default-certs-dir "/etc/prosody/certs")
877 (data-path (prosody-configuration-data-path config))
878 (pidfile-dir (dirname (prosody-configuration-pidfile config)))
879 (config-str (if (opaque-prosody-configuration? config)
880 (opaque-prosody-configuration-prosody.cfg.lua config)
881 #~(begin
882 (use-modules (ice-9 format))
883 #$(serialize-prosody-configuration config))))
884 (config-file (mixed-text-file "prosody.cfg.lua" config-str)))
885 #~(begin
886 (use-modules (guix build utils))
887 (define %user (getpw "prosody"))
888
889 (mkdir-p #$config-dir)
890 (chown #$config-dir (passwd:uid %user) (passwd:gid %user))
891 (copy-file #$config-file (string-append #$config-dir
892 "/prosody.cfg.lua"))
893
894 (mkdir-p #$default-certs-dir)
895 (chown #$default-certs-dir (passwd:uid %user) (passwd:gid %user))
896 (chmod #$default-certs-dir #o750)
897
898 (mkdir-p #$data-path)
899 (chown #$data-path (passwd:uid %user) (passwd:gid %user))
900 (chmod #$data-path #o750)
901
902 (mkdir-p #$pidfile-dir)
903 (chown #$pidfile-dir (passwd:uid %user) (passwd:gid %user)))))
904
905(define prosody-service-type
906 (service-type (name 'prosody)
907 (extensions
908 (list (service-extension shepherd-root-service-type
909 prosody-shepherd-service)
910 (service-extension account-service-type
911 (const %prosody-accounts))
912 (service-extension activation-service-type
913 prosody-activation)))
914 (default-value (prosody-configuration
915 (virtualhosts
916 (list
917 (virtualhost-configuration
918 (domain "localhost"))))))
919 (description
920 "Run Prosody, a modern XMPP communication server.")))
921
922;; A little helper to make it easier to document all those fields.
923(define (generate-documentation)
924 (define documentation
925 `((prosody-configuration
926 ,prosody-configuration-fields
927 (ssl ssl-configuration)
928 (virtualhosts virtualhost-configuration)
929 (int-components int-component-configuration)
930 (ext-components ext-component-configuration))
931 (ssl-configuration ,ssl-configuration-fields)
932 (int-component-configuration ,int-component-configuration-fields
933 (mod-muc mod-muc-configuration))
934 (ext-component-configuration ,ext-component-configuration-fields)
935 (mod-muc-configuration ,mod-muc-configuration-fields)
936 (virtualhost-configuration ,virtualhost-configuration-fields)
937 (opaque-prosody-configuration ,opaque-prosody-configuration-fields)))
938 (define (generate configuration-name)
939 (match (assq-ref documentation configuration-name)
940 ((fields . sub-documentation)
941 (format #t "\nAvailable @code{~a} fields are:\n\n" configuration-name)
942 (when (memq configuration-name
943 '(virtualhost-configuration
944 int-component-configuration
945 ext-component-configuration))
946 (format #t "all these @code{prosody-configuration} fields: ~a, plus:\n"
947 (string-join (map (lambda (s)
948 (format #f "@code{~a}" s)) common-fields)
949 ", ")))
950 (for-each
951 (lambda (f)
952 (let ((field-name (configuration-field-name f))
953 (field-type (configuration-field-type f))
954 (field-docs (string-trim-both
955 (configuration-field-documentation f)))
956 (default (catch #t
957 (configuration-field-default-value-thunk f)
958 (lambda _ 'nope))))
959 (define (escape-chars str chars escape)
960 (with-output-to-string
961 (lambda ()
962 (string-for-each (lambda (c)
963 (when (char-set-contains? chars c)
964 (display escape))
965 (display c))
966 str))))
967 (define (show-default? val)
968 (or (string? val) (number? val) (boolean? val)
969 (and (list? val) (and-map show-default? val))))
970 (format #t "@deftypevr {@code{~a} parameter} ~a ~a\n~a\n"
971 configuration-name field-type field-name field-docs)
972 (when (show-default? default)
973 (format #t "Defaults to @samp{~a}.\n"
974 (escape-chars (format #f "~s" default)
975 (char-set #\@ #\{ #\})
976 #\@)))
977 (for-each generate (or (assq-ref sub-documentation field-name) '()))
978 (format #t "@end deftypevr\n\n")))
979 (filter (lambda (f)
980 (not (string=? "" (configuration-field-documentation f))))
981 fields)))))
982 (generate 'prosody-configuration)
983 (format #t "It could be that you just want to get a @code{prosody.cfg.lua}
984up and running. In that case, you can pass an
985@code{opaque-prosody-configuration} record as the value of
986@code{prosody-service-type}. As its name indicates, an opaque configuration
987does not have easy reflective capabilities.")
988 (generate 'opaque-prosody-configuration)
989 (format #t "For example, if your @code{prosody.cfg.lua} is just the empty
990string, you could instantiate a prosody service like this:
991
992@example
993(service prosody-service-type
994 (opaque-prosody-configuration
995 (prosody.cfg.lua \"\")))
996@end example"))
997
998
999;;;
1000;;; BitlBee.
1001;;;
1002
1003(define-record-type* <bitlbee-configuration>
1004 bitlbee-configuration make-bitlbee-configuration
1005 bitlbee-configuration?
1006 (bitlbee bitlbee-configuration-bitlbee
1007 (default bitlbee))
1008 (interface bitlbee-configuration-interface
1009 (default "127.0.0.1"))
1010 (port bitlbee-configuration-port
1011 (default 6667))
1012 (plugins bitlbee-plugins
1013 (default '()))
1014 (extra-settings bitlbee-configuration-extra-settings
1015 (default "")))
1016
1017(define bitlbee-shepherd-service
1018 (match-lambda
1019 (($ <bitlbee-configuration> bitlbee interface port
1020 plugins extra-settings)
1021 (let* ((plugins (directory-union "bitlbee-plugins" plugins))
1022 (conf (mixed-text-file "bitlbee.conf"
1023 "
1024 [settings]
1025 User = bitlbee
1026 ConfigDir = /var/lib/bitlbee
1027 DaemonInterface = " interface "
1028 DaemonPort = " (number->string port) "
1029 PluginDir = " plugins "/lib/bitlbee
1030" extra-settings))
1031 (bitlbee* (least-authority-wrapper
1032 (file-append bitlbee "/sbin/bitlbee")
1033 #:name "bitlbee"
1034 #:preserved-environment-variables
1035 '("PURPLE_PLUGIN_PATH" "GUIX_LOCPATH" "LC_ALL")
1036 #:mappings (list (file-system-mapping
1037 (source "/var/lib/bitlbee")
1038 (target source)
1039 (writable? #t))
1040 (file-system-mapping
1041 (source "/run/current-system/locale")
1042 (target source))
1043 (file-system-mapping
1044 (source conf)
1045 (target conf)))
1046 #:namespaces (delq 'net %namespaces))))
1047
1048 (list (shepherd-service
1049 (provision '(bitlbee))
1050
1051 ;; Note: If networking is not up, then /etc/resolv.conf
1052 ;; doesn't get mapped in the container, hence the dependency
1053 ;; on 'networking'.
1054 (requirement '(user-processes networking))
1055
1056 (start #~(make-inetd-constructor
1057 (list #$bitlbee* "-I" "-c" #$conf)
1058 (list (endpoint
1059 (addrinfo:addr
1060 (car (getaddrinfo #$interface
1061 #$(number->string port)
1062 (logior AI_NUMERICHOST
1063 AI_NUMERICSERV))))))
1064 #:requirements '#$requirement
1065 #:service-name-stem "bitlbee"
1066 #:user "bitlbee" #:group "bitlbee"
1067
1068 ;; Allow 'bitlbee-purple' to use libpurple plugins.
1069 #:environment-variables
1070 (list (string-append "PURPLE_PLUGIN_PATH="
1071 #$plugins "/lib/purple-2")
1072 "GUIX_LOCPATH=/run/current-system/locale")))
1073 (stop #~(make-inetd-destructor))))))))
1074
1075(define %bitlbee-accounts
1076 ;; User group and account to run BitlBee.
1077 (list (user-group (name "bitlbee") (system? #t))
1078 (user-account
1079 (name "bitlbee")
1080 (group "bitlbee")
1081 (system? #t)
1082 (comment "BitlBee daemon user")
1083 (home-directory "/var/empty")
1084 (shell (file-append shadow "/sbin/nologin")))))
1085
1086(define %bitlbee-activation
1087 ;; Activation gexp for BitlBee.
1088 #~(begin
1089 (use-modules (guix build utils))
1090
1091 ;; This directory is used to store OTR data.
1092 (mkdir-p "/var/lib/bitlbee")
1093 (let ((user (getpwnam "bitlbee")))
1094 (chown "/var/lib/bitlbee"
1095 (passwd:uid user) (passwd:gid user)))))
1096
1097(define bitlbee-service-type
1098 (service-type (name 'bitlbee)
1099 (extensions
1100 (list (service-extension shepherd-root-service-type
1101 bitlbee-shepherd-service)
1102 (service-extension account-service-type
1103 (const %bitlbee-accounts))
1104 (service-extension activation-service-type
1105 (const %bitlbee-activation))))
1106 (default-value (bitlbee-configuration))
1107 (description
1108 "Run @url{http://bitlbee.org,BitlBee}, a daemon that acts as
1109a gateway between IRC and chat networks.")))
1110
1111
1112;;;
1113;;; ngIRCd.
1114;;;
1115
1116(define-maybe string
1117 (prefix ngircd-))
1118
1119(define-maybe file-like
1120 (prefix ngircd-))
1121
1122(define-maybe list-of-strings
1123 (prefix ngircd-))
1124
1125(define (port? x)
1126 (and (number? x)
1127 (and (>= x 0) (<= x 65535))))
1128
1129(define list-of-ports?
1130 (list-of port?))
1131
1132(define-maybe port
1133 (prefix ngircd-))
1134
1135(define-maybe list-of-ports
1136 (prefix ngircd-))
1137
1138(define-maybe number
1139 (prefix ngircd-))
1140
1141(define-maybe boolean
1142 (prefix ngircd-))
1143
1144(define (pascal-case text)
1145 (object->camel-case-string text 'upper))
1146
1147(define (ngircd-serialize-string field value)
1148 (format #f "~a = ~a~%" (pascal-case field) value))
1149
1150(define (ngircd-serialize-boolean field value)
1151 (let* ((field (symbol->string field))
1152 (name (if (string-suffix? "?" field)
1153 (string-drop-right field 1)
1154 field)))
1155 (format #f "~a = ~:[false~;true~]~%" (pascal-case name) value)))
1156
1157(define (ngircd-serialize-file-like field value)
1158 #~(format #f "~a = ~a~%" #$(pascal-case field) #$value))
1159
1160(define (ngircd-serialize-list-of-strings field value)
1161 (format #f "~a = ~{~a~^,~}~%" (pascal-case field) value))
1162
1163(define ngircd-serialize-list-of-ports
1164 ngircd-serialize-list-of-strings)
1165
1166(define ngircd-serialize-number ngircd-serialize-string)
1167
1168(define ngircd-serialize-port ngircd-serialize-number)
1169
1170(define (string-or-number? x)
1171 (or (string? x) (number? x)))
1172
1173(define ngircd-serialize-string-or-number ngircd-serialize-string)
1174
1175(define-configuration ngircd-global ;[Global]
1176 (name
1177 maybe-string
1178 "Server name in the IRC network. This is an individual name of the IRC
1179server, it is not related to the DNS host name. It must be unique in the IRC
1180network and must contain at least one dot (@samp{.}) character. When not set,
1181ngIRCd tries to deduce a valid IRC server name from the local host name.")
1182 (admin-info-1
1183 maybe-string
1184 "First administrator information.")
1185 (admin-info-2
1186 maybe-string
1187 "Second administrator information.")
1188 (admin-email
1189 maybe-string
1190 "Email to reach administrators.")
1191 (help-file
1192 maybe-file-like
1193 "File-like containing the ngIRCd help text.")
1194 (info
1195 maybe-string
1196 "Info text of the server. This will be shown by WHOIS and LINKS requests
1197for example.")
1198 (listen
1199 (list-of-strings (list "::" "0.0.0.0"))
1200 "A list of IP address on which the server should listen. By default it
1201listens on all configured IP addresses and interfaces.")
1202 (motd-file
1203 ;; Provide an empty default file to avoid a warning when running
1204 ;; --configtest to validate the configuration file.
1205 (file-like (plain-file "ngircd.motd" ""))
1206 "Text file with the @i{message of the day} (MOTD). This message will be
1207shown to all users connecting to the server.")
1208 (motd-phrase
1209 maybe-string
1210 "A simple phrase (<127 chars) to use if you don't want to use a MOTD
1211file.")
1212 (network
1213 maybe-string
1214 "The name of the IRC network to which this server belongs. This name is
1215optional, should only contain ASCII characters, and can't contain spaces. It
1216is only used to inform clients.")
1217 (password
1218 maybe-string
1219 "Global password or all users needed to connect to the server. By default,
1220no password is required. PAM must be disabled for this option to have an
1221effect.")
1222 (pid-file
1223 (string "/run/ngircd/ngircd.pid")
1224 "The file name where the PID of ngIRCd should be written after it starts.")
1225 (ports
1226 (list-of-ports (list 6667))
1227 "Port number(s) on which the server should listen for @emph{unencrypted}
1228connections.")
1229 (server-uid
1230 (string-or-number "ngircd")
1231 "The user that the @command{ngircd} command should run as.")
1232 (server-gid
1233 (string-or-number "ngircd")
1234 "The group that the @command{ngircd} command should run as.")
1235 (prefix ngircd-))
1236
1237(define (serialize-ngircd-global _ config)
1238 #~(string-append
1239 "[Global]\n"
1240 #$(serialize-configuration config ngircd-global-fields)))
1241
1242(define-configuration ngircd-limits ;[Limits]
1243 (connect-retry
1244 (maybe-number 60)
1245 "The number of seconds the server should wait before re-attempting to
1246establish a link to not yet (or no longer) connected servers.")
1247 (max-connections
1248 (maybe-number 0)
1249 "Maximum number of simultaneous in- and outbound connections the server is
1250allowed to accept. There is no limit by default.")
1251 (max-connections-ip
1252 (maybe-number 5)
1253 "Maximum number of simultaneous connections from a single IP address that
1254the server will accept. This configuration options lowers the risk of denial
1255of service attacks (DoS). Set to 0 to remove the limit.")
1256 (max-joins
1257 (maybe-number 10)
1258 "Maximum number of channels a user can be member of. Set to 0 to remove
1259the limit.")
1260 (max-list-size
1261 (maybe-number 100)
1262 "Maximum number of channels returned in response to a LIST command.")
1263 (ping-timeout
1264 (maybe-number 120)
1265 "Number of seconds of inactivity after which the server will send a PING to
1266the peer to test whether it is alive or not.")
1267 (pong-timeout
1268 (maybe-number 20)
1269 "If a client fails to answer a PING with a PONG within this amount of
1270seconds, it will be disconnected by the server.")
1271 (prefix ngircd-))
1272
1273(define (serialize-ngircd-limits _ config)
1274 #~(string-append
1275 "\n[Limits]\n"
1276 #$(serialize-configuration config ngircd-limits-fields)))
1277
1278(define-maybe ngircd-limits)
1279
1280(define-configuration ngircd-options ;[Options]
1281 (allowed-channel-types
1282 (maybe-string "#&+")
1283 "List of allowed channel types (channel prefixes) for newly created
1284channels on the local server. By default, all supported channel types are
1285allowed.")
1286 (allow-remote-oper?
1287 (maybe-boolean #f)
1288 "If this option is active, IRC operators connected to remote servers are
1289allowed to control this local server using administrative commands, for
1290example like CONNECT, DIE, SQUIT, etc.")
1291 (connect-ipv4?
1292 (maybe-boolean #t)
1293 "Set to @code{#f} to prevent ngIRCd from connecting to other IRC servers
1294using the IPv4 protocol, allowed by default.")
1295 (connect-ipv6?
1296 (maybe-boolean #t)
1297 "Set to @code{#f} to prevent ngIRCd from connecting to other IRC servers
1298using the IPv6 protocol, allowed by default.")
1299 (dns?
1300 (maybe-boolean #t)
1301 "Set to @code{#f} to disable DNS lookups when clients connect. If you
1302configure the daemon to connect to other servers, ngIRCd may still perform a
1303DNS lookup if required.")
1304 (more-privacy?
1305 (maybe-boolean #f)
1306 "Set this to @code{#t} to have ngIRCd censor user idle time, logon time as
1307well as the PART/QUIT messages (that sometimes used to inform everyone about
1308which client software is being used). WHOWAS requests are also silently
1309ignored, and NAMES output doesn't list any clients for non-members. This
1310option is most useful when ngIRCd is being used together with anonymizing
1311software such as TOR or I2P and one does not wish to make it too easy to
1312collect statistics on the users.")
1313 (notice-before-registration?
1314 (maybe-boolean #f)
1315 "Normally ngIRCd doesn't send any messages to a client until it is
1316registered. Enable this option to let the daemon send @samp{NOTICE *}
1317messages to clients while connecting.")
1318 (oper-can-use-mode?
1319 (maybe-boolean #f)
1320 "Should IRC Operators be allowed to use the MODE command even if they are
1321not(!) channel-operators?")
1322 (oper-chan-p-auto-op?
1323 (maybe-boolean #t)
1324 "Should IRC Operators get AutoOp (+o) in persistent (+P) channels?")
1325 (oper-server-mode?
1326 (maybe-boolean #f)
1327 "If @code{open-can-use-mode?} is @code{#t}, this may lead the compatibility
1328problems with servers that run the ircd-irc2 software. This option masks mode
1329requests by non-chanops as if they were coming from the server. Only enable
1330this if you have ircd-irc2 servers in your IRC network.")
1331 (pam?
1332 (boolean #f)
1333 "Set to @code{#t} to enable calls to the PAM library at runtime; all users
1334connecting without password are allowed to connect, all passwords given will
1335fail. Users identified without PAM are registered with a tilde (@samp{~})
1336prepended to their user name. This defaults to @code{#f} in Guix because the
1337service runs as an unprivileged user and thus cannot authenticate other users
1338via the @code{pam_unix} PAM module.")
1339 (pam-is-optional?
1340 (maybe-boolean #f)
1341 "Set to @code{#t} to make PAM authentication optional, causing clients not
1342sending a password to still be able to connect, but won't become identified
1343and keep the tilder (@samp{~}) character prepended to their supplied user
1344name.")
1345 (require-auth-ping?
1346 (maybe-boolean #f)
1347 "Set to @code{#t} to have ngIRCd send an authentication PING when a new
1348client connects, and register this client only after receiving the
1349corresponding PONG reply.")
1350 (prefix ngircd-))
1351
1352(define (serialize-ngircd-options _ config)
1353 #~(string-append
1354 "\n[Options]\n"
1355 #$(serialize-configuration config ngircd-options-fields)))
1356
1357(define-maybe ngircd-options)
1358
1359(define-configuration ngircd-ssl ;[SSL]
1360 (cert-file
1361 maybe-string
1362 "SSL certificate file of the private server key.")
1363 (key-file
1364 maybe-string
1365 "File name of the SSL Server Key to be used for SSL connections, which is
1366required for SSL/TLS support.")
1367 (ca-file
1368 (maybe-string "/etc/ssl/certs/ca-certificates.crt")
1369 "A file listing all the certificates of the trusted Certificate
1370Authorities.")
1371 (ports
1372 maybe-list-of-ports
1373 "Like the global configuration's @code{port} option, except that ngIRCd
1374will expect incoming connections to be SSL/TLS encrypted. Common port numbers
1375for SSL-encrypted IRC are 6669 and 6697.")
1376 (cipher-list
1377 maybe-string
1378 "The GnuTLS cipher suites allowed for SSL/TLS connections, a value such as
1379@code{\"SECURE128:-VERS-SSL3.0\"}. Refer to @samp{man 3 gnutls_priority_init}
1380for details.")
1381 (dh-file
1382 maybe-file-like
1383 "A file-like containing the Diffie-Hellman parameters, which can be created
1384with GnuTLS via @samp{certtool --generate-dh-params}. If this file is not
1385present, the Diffie-Hellman parameters will be computed on startup, which may
1386take some time.")
1387 (prefix ngircd-))
1388
1389(define (serialize-ngircd-ssl _ config)
1390 #~(string-append
1391 "\n[SSL]\n"
1392 #$(serialize-configuration config ngircd-ssl-fields)))
1393
1394(define-maybe ngircd-ssl)
1395
1396(define-configuration ngircd-operator ;[Operator]
1397 (name
1398 string
1399 "ID of the operator (may be different of the nickname).")
1400 (password
1401 string
1402 "Password of the IRC operator.")
1403 (mask
1404 maybe-string
1405 "Mask that is to be checked before an /OPER for this account is accepted,
1406for example: @code{\"nick!ident@@*.example.com\"}.")
1407 (prefix ngircd-))
1408
1409(define list-of-ngircd-operators?
1410 (list-of ngircd-operator?))
1411
1412(define (serialize-ngircd-operator _ operator)
1413 #~(string-append
1414 "\n[Operator]\n"
1415 #$(serialize-configuration operator ngircd-operator-fields)))
1416
1417(define (serialize-list-of-ngircd-operators _ operators)
1418 #~(string-append #$@(map (cut serialize-ngircd-operator #f <>) operators)))
1419
1420(define-maybe list-of-ngircd-operators)
1421
1422(define-configuration ngircd-server ;[Server]
1423 (name
1424 string
1425 "IRC name of the remote server.")
1426 (host
1427 string
1428 "Internet host name (or IP address) of the peer.")
1429 (my-password
1430 string
1431 "Own password for this connection. This password has to be configured as
1432@code{peer-password} on the other server and must not have @samp{:} as first
1433character.")
1434 (peer-password
1435 string
1436 "Foreign password for this connection. This password has to be configured
1437as @code{my-password} on the other server.")
1438 (bind
1439 maybe-string
1440 "IP address to use as source IP for the outgoing connection. The default
1441is to let the operating system decide.")
1442 (port
1443 maybe-port
1444 "Port of the remote server to which ngIRCd should connect (active). If no
1445port is assigned to a configured server, the daemon only waits for incoming
1446connections (passive, which is the default).")
1447 (group
1448 maybe-number
1449 "Group of this server.")
1450 (passive?
1451 (maybe-boolean #f)
1452 "Set to @code{#t} to disable automatic connection even if the port value is
1453specified.")
1454 (ssl-connect?
1455 (maybe-boolean #f)
1456 "Set to @code{#t} to enforce the use of TLS to connect to the remote
1457server.")
1458 (ssl-verify?
1459 (maybe-boolean #t)
1460 "Set to @code{#f} to disable the verification of the TLS certificate
1461presented by the remote server. This can be useful if the remote server uses
1462a self-signed certificate. Beware that this degrades security by enabling
1463man-in-the-middle attacks, as the @emph{remote site is not verified at all}.")
1464 (prefix ngircd-))
1465
1466(define list-of-ngircd-servers?
1467 (list-of ngircd-server?))
1468
1469(define (serialize-ngircd-server _ server)
1470 #~(string-append
1471 "\n[Server]\n"
1472 #$(serialize-configuration server ngircd-server-fields)))
1473
1474(define (serialize-list-of-ngircd-servers _ servers)
1475 #~(string-append #$@(map (cut serialize-ngircd-server #f <>) servers)))
1476
1477(define-maybe list-of-ngircd-servers)
1478
1479(define-configuration ngircd-channel ;[Channel]
1480 (name
1481 string
1482 "Name of the channel, including channel prefix (\"#\" or \"&\").")
1483 (topic
1484 maybe-string
1485 "Topic for this channel.")
1486 (modes
1487 maybe-list-of-strings
1488 "Initial channel modes, as used in MODE commands. Modifying lists (ban
1489list, invite list, exception list) is supported. If multiple MODE strings are
1490specified, they are evaluated in the order listed (left to right)."
1491 (serializer (lambda (_ value)
1492 ;; Special case: each mode string gets serialized to a
1493 ;; separate option.
1494 (format #f "~{Modes = ~a~%~}" value))))
1495 (key-file
1496 maybe-file-like
1497 "Path and file name of a ngIRCd key file containing individual channel keys
1498for different users. Refer to @samp{man 5 ngircd.conf} for more details.")
1499 (prefix ngircd-))
1500
1501(define list-of-ngircd-channels?
1502 (list-of ngircd-channel?))
1503
1504(define (serialize-ngircd-channel _ channel)
1505 #~(string-append
1506 "\n[Channel]\n"
1507 #$(serialize-configuration channel ngircd-channel-fields)))
1508
1509(define (serialize-list-of-ngircd-channels _ channels)
1510 #~(string-append #$@(map (cut serialize-ngircd-channel #f <>) channels)))
1511
1512(define-maybe list-of-ngircd-channels)
1513
1514(define-configuration ngircd-configuration
1515 (ngircd
1516 (file-like ngircd)
1517 "The @code{ngircd} package to use.")
1518 (debug?
1519 (boolean #f)
1520 "Turn on debugging messages."
1521 (serializer empty-serializer))
1522 (shepherd-requirement
1523 (list-of-symbols '(user-processes networking))
1524 "Shepherd requirements the service should depend on."
1525 (serializer empty-serializer))
1526 (global
1527 ;; Always use a ngircd-global default to ensure 'pid-file' is defined.
1528 (ngircd-global (ngircd-global))
1529 "A ngircd-global record object used to specify global options.")
1530 (limits
1531 maybe-ngircd-limits
1532 "The ngircd-limits record object used to specify limits options.")
1533 ;; Always use a ngircd-options default to ensure PAM is disabled by default.
1534 (options
1535 (ngircd-options (ngircd-options))
1536 "The ngircd-options record object used to specify optional features and
1537configuration options.")
1538 (ssl
1539 maybe-ngircd-ssl
1540 "The ngircd-ssl record object used to specify the SSL-related options.")
1541 (operators
1542 maybe-list-of-ngircd-operators
1543 "A list of ngircd-operator record objects used to specify the operators.")
1544 (servers
1545 maybe-list-of-ngircd-servers
1546 "A list of ngircd-server record objects used to specify other remote
1547servers to connect to.")
1548 (channels
1549 maybe-list-of-ngircd-channels
1550 "A list of ngircd-channels record objects specifying pre-defined channels
1551to be created by the server when starting up."))
1552
1553(define (ngircd-generate-documentation)
1554 (configuration->documentation 'ngircd-configuration)
1555 (configuration->documentation 'ngircd-global)
1556 (configuration->documentation 'ngircd-limits)
1557 (configuration->documentation 'ngircd-options)
1558 (configuration->documentation 'ngircd-ssl)
1559 (configuration->documentation 'ngircd-operator)
1560 (configuration->documentation 'ngircd-server)
1561 (configuration->documentation 'ngircd-channel))
1562
1563(define (ngircd-user+group config)
1564 "Return the Global->ServerUID and Global->ServerGID configuration options as
1565values."
1566 (let* ((global (ngircd-configuration-global config))
1567 (user (ngircd-global-server-uid global))
1568 (group (ngircd-global-server-gid global)))
1569 (values user group)))
1570
1571(define (ngircd-account config)
1572 (let* ((user group (ngircd-user+group config))
1573 (group-name (if (string? group)
1574 group
1575 "ngircd"))
1576 (user-name (if (string? user)
1577 user
1578 "ngircd"))
1579 (gid (if (number? group)
1580 group
1581 #f))
1582 (uid (if (number? user)
1583 user
1584 #f)))
1585 (list (user-group
1586 (name group-name)
1587 (id gid)
1588 (system? #t))
1589 (user-account
1590 (name user-name)
1591 (uid uid)
1592 (group group-name)
1593 (system? #t)
1594 (comment "Ngircd daemon user")
1595 (home-directory "/var/empty")
1596 (shell (file-append shadow "/sbin/nologin"))))))
1597
1598(define (serialize-ngircd-configuration config)
1599 "Return a file-like object corresponding to the serialized
1600<ngircd-configuration> record."
1601 (let ((ngircd (file-append (ngircd-configuration-ngircd config)
1602 "/sbin/ngircd"))
1603 (ngircd.conf (mixed-text-file "unvalidated-ngircd.conf"
1604 (serialize-configuration
1605 config ngircd-configuration-fields))))
1606 (computed-file
1607 "ngircd.conf"
1608 (with-imported-modules '((guix build utils))
1609 #~(begin
1610 (use-modules (guix build utils))
1611 ;; Ensure stdin is not connected to a TTY source to avoid ngircd
1612 ;; configtest blocking with a confirmation prompt.
1613 (parameterize ((current-input-port (%make-void-port "r")))
1614 (invoke #+ngircd "--config" #$ngircd.conf "--configtest"))
1615 (copy-file #$ngircd.conf #$output))))))
1616
1617(define (ngircd-wrapper config)
1618 "Take CONFIG, a <ngircd-configuration> object, and provide a least-authority
1619wrapper for the 'ngircd' command."
1620 (let* ((ngircd.conf (serialize-ngircd-configuration config))
1621 (user group (ngircd-user+group config))
1622 (global (ngircd-configuration-global config))
1623 (pid-file (ngircd-global-pid-file global))
1624 (help-file (ngircd-global-help-file global))
1625 (motd-file (ngircd-global-motd-file global))
1626 (ssl (ngircd-configuration-ssl config))
1627 (channels (ngircd-configuration-channels config)))
1628 (least-authority-wrapper
1629 (file-append (ngircd-configuration-ngircd config) "/sbin/ngircd")
1630 #:name "ngircd-pola-wrapper"
1631 ;; Expose all needed files, such as all options corresponding to
1632 ;; file-like objects and string file names.
1633 #:mappings
1634 (append
1635 (list (file-system-mapping
1636 (source "/var/log/ngircd.log")
1637 (target source)
1638 (writable? #t))
1639 (file-system-mapping
1640 (source ngircd.conf)
1641 (target source))
1642 (file-system-mapping
1643 (source (string-append (dirname pid-file)))
1644 (target source)
1645 (writable? #t)))
1646 (if (maybe-value-set? help-file)
1647 (list (file-system-mapping
1648 (source help-file)
1649 (target source)))
1650 '())
1651 (if (maybe-value-set? motd-file)
1652 (list (file-system-mapping
1653 (source motd-file)
1654 (target source)))
1655 '())
1656 (if (maybe-value-set? ssl)
1657 ;; When SSL is used, expose the specified keys and certificates.
1658 (filter-map (lambda (value)
1659 (if (maybe-value-set? value)
1660 (file-system-mapping
1661 (source value)
1662 (target source))
1663 #f))
1664 (list (ngircd-ssl-ca-file ssl)
1665 (ngircd-ssl-cert-file ssl)
1666 (ngircd-ssl-key-file ssl)
1667 (ngircd-ssl-dh-file ssl)))
1668 '())
1669 (if (maybe-value-set? channels)
1670 (filter-map (lambda (channel)
1671 (let ((key-file (ngircd-channel-key-file channel)))
1672 (and (maybe-value-set? key-file)
1673 key-file)))
1674 channels)
1675 '()))
1676 #:user user
1677 #:group group
1678 ;; ngircd wants to look up users in /etc/passwd so run in the global user
1679 ;; namespace. Also preserve the PID namespaces otherwise the PID file
1680 ;; would contain an unrelated PID number and confuse Shepherd.
1681 #:namespaces (fold delq %namespaces '(net pid user)))))
1682
1683(define (ngircd-shepherd-service config)
1684 (match-record config <ngircd-configuration>
1685 (debug? global shepherd-requirement ssl)
1686 (let* ((ngircd.conf (serialize-ngircd-configuration config))
1687 (pid-file (ngircd-global-pid-file global)))
1688 (list (shepherd-service
1689 (provision '(ngircd))
1690 (requirement shepherd-requirement)
1691 (modules (cons '(srfi srfi-1) %default-modules))
1692 (actions (list (shepherd-configuration-action ngircd.conf)))
1693 ;; Sadly, 'make-systemd-constructor' doesn't work with TLS
1694 ;; connections, which hang up (see:
1695 ;; https://github.com/ngircd/ngircd/issues/330).
1696 (start #~(make-forkexec-constructor
1697 (append (list #$(ngircd-wrapper config)
1698 "--nodaemon"
1699 "--config" #$ngircd.conf)
1700 (if #$debug?
1701 '("--debug")
1702 '()))
1703 #:pid-file #$pid-file
1704 #:log-file "/var/log/ngircd.log"))
1705 (stop #~(make-kill-destructor)))))))
1706
1707(define (ngircd-activation config)
1708 (let* ((pid-file (ngircd-global-pid-file
1709 (ngircd-configuration-global config)))
1710 (user _ (ngircd-user+group config)))
1711 #~(begin
1712 (use-modules (guix build utils)
1713 (ice-9 match))
1714 (define pw (match #$user
1715 ((? number?) (getpwuid #$user))
1716 ((? string?) (getpwnam #$user))))
1717 (mkdir-p/perms #$(dirname pid-file) pw #o755))))
1718
1719(define ngircd-service-type
1720 (service-type
1721 (name 'ngircd)
1722 (extensions
1723 (list (service-extension shepherd-root-service-type
1724 ngircd-shepherd-service)
1725 (service-extension profile-service-type
1726 (compose list ngircd-configuration-ngircd))
1727 (service-extension account-service-type
1728 ngircd-account)
1729 (service-extension activation-service-type
1730 ngircd-activation)))
1731 (default-value (ngircd-configuration))
1732 (description
1733 "Run @url{https://ngircd.barton.de/, ngIRCd}, a lightweight @acronym{IRC,
1734Internet Relay Chat} daemon.")))
1735
1736
1737;;;
1738;;; Pounce.
1739;;;
1740(define (pounce-serialize-boolean field value)
1741 "Boolean arguments for pounce serialize to their field name, minus the
1742trailing '?'."
1743 (let ((name (symbol->string field)))
1744 (string-append (if (string-suffix? "?" name)
1745 (string-drop-right name 1)
1746 name)
1747 "\n")))
1748
1749(define (pounce-serialize-string field value)
1750 (format #f "~a=~a~%" field value))
1751
1752(define (pounce-serialize-list-of-strings field value)
1753 (format #f "~a=~{~a~^,~}~%" field value))
1754
1755(define (pounce-serialize-pair field value)
1756 (match value
1757 ((head . tail)
1758 (format #f "~a=~a:~a~%" field head tail))))
1759
1760(define (power-of-two? x)
1761 "Predicate to check if X is an exact power of two."
1762 (exact-integer? (sqrt x)))
1763
1764(define pounce-serialize-number pounce-serialize-string)
1765(define pounce-serialize-power-of-two pounce-serialize-number)
1766(define pounce-serialize-port pounce-serialize-number)
1767
1768(define-maybe boolean (prefix pounce-))
1769(define-maybe number (prefix pounce-))
1770(define-maybe pair (prefix pounce-))
1771(define-maybe port (prefix pounce-))
1772(define-maybe power-of-two (prefix pounce-))
1773(define-maybe string (prefix pounce-))
1774(define-maybe list-of-strings (prefix pounce-))
1775
1776;;; For a reference w.r.t. which options require an argument, refer to the
1777;;; `options' array defined in bounce.c.
1778(define-configuration pounce-configuration
1779 (pounce
1780 (file-like pounce)
1781 "The @code{pounce} package to use."
1782 (serializer empty-serializer))
1783
1784 (shepherd-provision
1785 (list-of-symbols '(pounce))
1786 "The name(s) of the service."
1787 (serializer empty-serializer))
1788
1789 (shepherd-requirement
1790 (list-of-symbols '(user-processes networking))
1791 "Shepherd requirements the service should depend on."
1792 (serializer empty-serializer))
1793
1794 (log-file
1795 (string "/var/log/pounce.log")
1796 "The log file name to use."
1797 (serializer empty-serializer))
1798
1799 (verbose?
1800 maybe-boolean
1801 "When true, log IRC messages to standard output.")
1802
1803 ;; Client options.
1804 (local-host
1805 (maybe-string "localhost")
1806 "The host to bind to.")
1807
1808 (local-port
1809 (maybe-port 6697)
1810 "The port to bind to.")
1811
1812 (local-ca
1813 maybe-string
1814 "Require clients to authenticate using a TLS client certificate either
1815contained in or signed by a certificate in the file loaded from
1816@code{local-ca}, a file name. The file is reloaded when the SIGUSR1 signal is
1817received.")
1818
1819 (local-cert
1820 maybe-string
1821 "File name of the TLS certificate to load. The file is reloaded when the
1822SIGUSR1 signal is received. Unless specified, a self-signed certificate is
1823generated at @file{/var/lib/pounce/.config/pounce/@var{host}.pem}, where
1824@var{host} corresponds to the value of the @code{local-host} field.")
1825
1826 (local-priv
1827 maybe-string
1828 "File name of the private TLS key to load. Unless specified, a key is
1829generated at @file{/var/lib/pounce/.config/pounce/@var{host}.key}, where
1830@var{host} corresponds to the value of the @code{local-host} field.")
1831
1832 (local-pass
1833 maybe-string
1834 "Require the server password pass for clients to connect. The pass string
1835must be hashed using @samp{pounce -x}.")
1836
1837 (size
1838 (maybe-power-of-two 4096)
1839 "Set the number of messages contained in the buffer to @var{size}. This
1840sets the maximum number of recent messages which can be relayed to a
1841reconnecting client. The size must be a power of two.")
1842
1843 ;; Server options.
1844 (bind
1845 maybe-string
1846 "Host to bind the @emph{source} address to when connecting to the server.
1847To connect from any address over IPv4 only, use @samp{0.0.0.0}. To connect
1848from any address over IPv6 only, use @samp{::}.")
1849
1850 (host
1851 string
1852 "The host name to connect to.")
1853
1854 (port
1855 maybe-port
1856 "The port number to connect to.")
1857
1858 (pass
1859 maybe-string
1860 "Password to use to log in with the server. The password must have been
1861hashed via the @samp{pounce -x} command.")
1862
1863 (join
1864 maybe-list-of-strings
1865 "The list of channels to join.")
1866
1867 (mode maybe-string "The user mode.")
1868
1869 (user
1870 maybe-string
1871 "To set the username. The default username is the same as the nickname.")
1872
1873 (nick
1874 (maybe-string "pounce")
1875 "Set nickname to @var{nick}.")
1876
1877 (real
1878 maybe-string
1879 "Set the real name. The default is @code{nick}.")
1880
1881 (away
1882 maybe-string
1883 "The away status to use when no clients are connected and no other away
1884status has been set.")
1885
1886 (quit
1887 maybe-string
1888 "The message to use when quitting.")
1889
1890 (no-names?
1891 maybe-boolean
1892 "Do not request @samp{NAMES} for each channel when a client connects. This
1893avoids already connected clients receiving unsolicited responses but prevents
1894new clients from populating user lists.")
1895
1896 (queue-interval
1897 (maybe-number 200)
1898 "Set the server send queue interval in milliseconds. The queue is used to
1899send automated messages from pounce to the server. Messages from clients are
1900sent to the server directly.")
1901
1902 (trust
1903 maybe-string
1904 "File name of a certificate to trust. When used, server name verification
1905is disabled.")
1906
1907 (client-cert
1908 maybe-string
1909 "The file name of the TLS client. If the private key is in a separate
1910file, it is loaded with @code{client-priv}. With @code{sasl-external?},
1911authenticate using SASL EXTERNAL. Certificates can be generated with
1912@samp{pounce -g}. For more details, refer to ``Generating Client
1913Certificates'' in @samp{man 1 pounce}.")
1914
1915 (client-priv
1916 maybe-string
1917 "The file name of the TLS client private key.")
1918
1919 (sasl-plain
1920 maybe-pair
1921 "A pair of the username and password in plain text to authenticate using
1922SASL PLAIN. Since this method requires the account password in plain text, it
1923is recommended to use CertFP instead with @code{sasl-external}.")
1924
1925 (sasl-external?
1926 maybe-boolean
1927 "Authenticate using SASL EXTERNAL, also known as CertFP. The TLS client
1928certificate is loaded from @code{client-cert}.")
1929 (prefix pounce-))
1930
1931(define %pounce-account
1932 (list (user-group (name "pounce") (system? #t))
1933 (user-account
1934 (name "pounce")
1935 (group "pounce")
1936 (system? #t)
1937 (comment "Pounce daemon user")
1938 (home-directory "/var/lib/pounce")
1939 (shell (file-append shadow "/sbin/nologin")))))
1940
1941(define (pounce-activation config)
1942 "Create the HOME directory for pounce as well as the default TLS certificate
1943and key, if not explicitly provided."
1944 (match-record config <pounce-configuration>
1945 ( local-host local-ca local-cert local-priv
1946 trust client-cert client-priv)
1947 (with-imported-modules (source-module-closure
1948 '((gnu build activation)))
1949 #~(begin
1950 (use-modules (gnu build activation)
1951 (srfi srfi-34))
1952
1953 (let* ((home "/var/lib/pounce")
1954 (user (getpwnam "pounce"))
1955 (confdir (string-append home "/.config/pounce"))
1956 (default-cert (string-append confdir "/" #$local-host ".pem"))
1957 (default-key (string-append confdir "/" #$local-host ".key")))
1958
1959 (define* (sanitize-permissions file #:optional (mode #o400))
1960 (guard (c (#t #t))
1961 (chown file (passwd:uid user) (passwd:gid user))
1962 (chmod file mode)))
1963
1964 ;; Create home directory for pounce user.
1965 (mkdir-p/perms home user #o755)
1966
1967 ;; Best effort at sanitizing the ownership/permissions of the
1968 ;; certificate/keys. Since a cert file may incorporate the
1969 ;; security key, keep the permissions as tight as possible (owner
1970 ;; read-only / #o400).
1971 (when #$(maybe-value-set? local-ca)
1972 (sanitize-permissions #$local-ca))
1973 (if #$(maybe-value-set? local-cert)
1974 (sanitize-permissions #$local-cert)
1975 (sanitize-permissions default-cert))
1976 (if #$(maybe-value-set? local-priv)
1977 (sanitize-permissions #$local-priv)
1978 (sanitize-permissions default-key))
1979 (when #$(maybe-value-set? trust)
1980 (sanitize-permissions #$trust))
1981 (when #$(maybe-value-set? client-cert)
1982 (sanitize-permissions #$client-cert))
1983 (when #$(maybe-value-set? client-priv)
1984 (sanitize-permissions #$client-priv))
1985
1986 ;; Generate a default self-signed TLS certificate and private key
1987 ;; unless explicitly provided.
1988 (unless #$(maybe-value-set? local-cert)
1989 (unless (file-exists? default-cert)
1990 (mkdir-p/perms confdir user #o755)
1991 (let ((openssl #$(file-append openssl "/bin/openssl"))
1992 (args `("req" "-newkey" "rsa" "-x509" "-days" "3650"
1993 "-noenc" "-subj" "/C=CA/CN=Pounce Certificate"
1994 ,@(if #$(maybe-value-set? local-priv)
1995 '() ;XXX: likely bogus case
1996 (list "-keyout" default-key))
1997 "-out" ,default-cert)))
1998
1999 ;; XXX: Manually guard against and report exceptions until
2000 ;; bug#77365 is addressed.
2001 (guard (c ((invoke-error? c)
2002 (format (current-error-port)
2003 "pounce: error generating pounce tls \
2004certificate: ~a~%" c)))
2005 (apply invoke openssl args))
2006 (sanitize-permissions default-cert #o444)
2007 (unless #$(maybe-value-set? local-priv)
2008 (sanitize-permissions default-key #o400))))))))))
2009
2010(define (serialize-pounce-configuration config)
2011 "Return a file-like object corresponding to the serialized CONFIG
2012<pounce-configuration> record."
2013 (mixed-text-file "pounce.conf"
2014 (serialize-configuration config
2015 pounce-configuration-fields)))
2016
2017(define (pounce-wrapper config)
2018 "Take CONFIG, a <pounce-configuration> object, and provide a least-authority
2019wrapper for the 'ngircd' command."
2020 (match-record config <pounce-configuration>
2021 (local-ca local-cert local-priv trust client-cert client-priv)
2022 (let* ((pounce.conf (serialize-pounce-configuration config)))
2023 (least-authority-wrapper
2024 (file-append (pounce-configuration-pounce config) "/bin/pounce")
2025 #:name "pounce-pola-wrapper"
2026 ;; Expose all needed files, such as options corresponding to string
2027 ;; file names.
2028 #:mappings
2029 (append
2030 (list (file-system-mapping
2031 (source pounce.conf)
2032 (target source))
2033 (file-system-mapping
2034 (source "/var/lib/pounce")
2035 (target source)
2036 (writable? #t))
2037 (file-system-mapping
2038 (source "/var/log/pounce.log")
2039 (target source)
2040 (writable? #t)))
2041 (filter-map (lambda (value)
2042 (if (maybe-value-set? value)
2043 (file-system-mapping
2044 (source value)
2045 (target source))
2046 #f))
2047 (list local-ca local-cert local-priv
2048 trust client-cert client-priv)))
2049 #:user "pounce"
2050 #:group "pounce"
2051 #:preserved-environment-variables
2052 (cons "HOME" %default-preserved-environment-variables)
2053 ;; Without preserving the user namespace, pounce fails to access the
2054 ;; provisioned TLS certificates due to permission errors.
2055 #:namespaces (fold delq %namespaces '(net user))))))
2056
2057(define (pounce-shepherd-service config)
2058 (let ((pounce.cfg (serialize-pounce-configuration config)))
2059 (list (shepherd-service
2060 (provision (pounce-configuration-shepherd-provision config))
2061 (requirement (pounce-configuration-shepherd-requirement config))
2062 (actions (list (shepherd-configuration-action pounce.cfg)))
2063 (start #~(make-forkexec-constructor
2064 (list #$(pounce-wrapper config) #$pounce.cfg)
2065 #:environment-variables (list "HOME=/var/lib/pounce")
2066 #:log-file #$(pounce-configuration-log-file config)))
2067 (stop #~(make-kill-destructor))))))
2068
2069(define pounce-service-type
2070 (service-type
2071 (name 'pounce)
2072 (extensions
2073 (list (service-extension shepherd-root-service-type
2074 pounce-shepherd-service)
2075 (service-extension profile-service-type
2076 (compose list pounce-configuration-pounce))
2077 (service-extension account-service-type
2078 (const %pounce-account))
2079 (service-extension activation-service-type
2080 pounce-activation)))
2081 (description
2082 "Run @url{https://git.causal.agency/pounce/about/, pounce},
2083the IRC bouncer.")))
2084
2085
2086;;;
2087;;; Quassel.
2088;;;
2089
2090(define-record-type* <quassel-configuration>
2091 quassel-configuration make-quassel-configuration
2092 quassel-configuration?
2093 (quassel quassel-configuration-quassel
2094 (default quassel))
2095 (interface quassel-configuration-interface
2096 (default "::,0.0.0.0"))
2097 (port quassel-configuration-port
2098 (default 4242))
2099 (loglevel quassel-configuration-loglevel
2100 (default "Info")))
2101
2102(define quassel-shepherd-service
2103 (match-lambda
2104 (($ <quassel-configuration> quassel interface port loglevel)
2105 (let ((quassel (least-authority-wrapper
2106 (file-append quassel "/bin/quasselcore")
2107 #:name "quasselcore"
2108 #:mappings (list (file-system-mapping
2109 (source "/var/lib/quassel")
2110 (target source)
2111 (writable? #t))
2112 (file-system-mapping
2113 (source "/var/log/quassel")
2114 (target source)
2115 (writable? #t)))
2116 ;; XXX: The daemon needs to live in the main user
2117 ;; namespace, as root, so it can access /var/lib/quassel
2118 ;; owned by "quasselcore".
2119 #:namespaces (fold delq %namespaces '(net user)))))
2120 (list (shepherd-service
2121 (provision '(quassel))
2122 (requirement '(user-processes networking))
2123 (start #~(make-forkexec-constructor
2124 (list #$quassel
2125 "--configdir=/var/lib/quassel"
2126 "--logfile=/var/log/quassel/core.log"
2127 (string-append "--loglevel=" #$loglevel)
2128 (string-append "--port=" (number->string #$port))
2129 (string-append "--listen=" #$interface))))
2130 (stop #~(make-kill-destructor))))))))
2131
2132(define %quassel-account
2133 (list (user-group (name "quassel") (system? #t))
2134 (user-account
2135 (name "quasselcore")
2136 (group "quassel")
2137 (system? #t)
2138 (comment "Quassel daemon user")
2139 (home-directory "/var/lib/quassel")
2140 (shell (file-append shadow "/sbin/nologin")))))
2141
2142(define %quassel-activation
2143 #~(begin
2144 (use-modules (guix build utils))
2145 (mkdir-p "/var/lib/quassel")
2146 (mkdir-p "/var/log/quassel")
2147 (let ((cert "/var/lib/quassel/quasselCert.pem"))
2148 (unless (file-exists? cert)
2149 (invoke #$(file-append openssl "/bin/openssl")
2150 "req" "-x509" "-nodes" "-batch" "-days" "680" "-newkey"
2151 "rsa" "-keyout" cert "-out" cert)))))
2152
2153(define quassel-service-type
2154 (service-type (name 'quassel)
2155 (extensions
2156 (list (service-extension shepherd-root-service-type
2157 quassel-shepherd-service)
2158 (service-extension profile-service-type
2159 (compose list quassel-configuration-quassel))
2160 (service-extension account-service-type
2161 (const %quassel-account))
2162 (service-extension activation-service-type
2163 (const %quassel-activation))))
2164 (default-value (quassel-configuration))
2165 (description
2166 "Run @url{https://quassel-irc.org/,quasselcore}, the backend
2167for the distributed IRC client quassel, which allows you to connect from
2168multiple machines simultaneously.")))
2169
2170
2171;;;
2172;;; Mosquitto.
2173;;;
2174
2175(define-record-type* <mosquitto-configuration>
2176 mosquitto-configuration
2177 make-mosquitto-configuration
2178 mosquitto-configuration?
2179 (package mosquitto-configuration-package
2180 (default mosquitto))
2181 (config-file mosquitto-configuration-config-file
2182 (default #f))
2183 (user mosquitto-configuration-user
2184 (default "mosquitto"))
2185 (group mosquitto-configuration-group
2186 (default "mosquitto")))
2187
2188(define (mosquitto-accounts config)
2189 (match-record config <mosquitto-configuration>
2190 (user group)
2191 (filter identity
2192 (list
2193 (and (equal? group "mosquitto")
2194 (user-group
2195 (name "mosquitto")
2196 (system? #t)))
2197 (and (equal? user "mosquitto")
2198 (user-account
2199 (name "mosquitto")
2200 (group group)
2201 (system? #t)
2202 (comment "bzzz")
2203 (home-directory "/var/empty")
2204 (shell (file-append shadow "/sbin/nologin"))))))))
2205
2206(define (mosquitto-shepherd-service config)
2207 (match-record config <mosquitto-configuration>
2208 (package config-file user group)
2209 (list (shepherd-service
2210 (documentation "Run the Mosquitto MQTT broker.")
2211 (provision '(mosquitto))
2212 (requirement '(networking syslogd user-processes))
2213 (start #~(make-forkexec-constructor
2214 (list #$(file-append package "/sbin/mosquitto")
2215 #$@(if config-file
2216 (list "-c" config-file)
2217 '()))
2218 #:user #$user
2219 #:group #$group))
2220 (stop #~(make-kill-destructor))))))
2221
2222(define mosquitto-service-type
2223 (service-type
2224 (description "Run the Mosquitto MQTT broker.")
2225 (name 'mosquitto)
2226 (extensions
2227 (list (service-extension account-service-type mosquitto-accounts)
2228 (service-extension shepherd-root-service-type mosquitto-shepherd-service)))
2229 (default-value (mosquitto-configuration))))
2230
2231
2232;;;
2233;;; Snuik.
2234;;;
2235(define-maybe integer (no-serialization))
2236(define-configuration/no-serialization snuik-configuration
2237 (snuik (package snuik) "The snuik package to use.")
2238 (server maybe-string "The IRC server to connect to.")
2239 (port maybe-integer "The port used by the IRC server.")
2240 (nick maybe-string "The nickname for snuik to use.")
2241 (password maybe-string "The password to use when logging in.")
2242 (password-file maybe-string "The file to read the password from.")
2243 (channels (list-of-strings '()) "The channels for snuik to join.")
2244 (extra-options (list-of-strings '()) "Extra options to be passed to snuik.")
2245 (home-service? (boolean for-home?) "Running as home service?"))
2246
2247(define (snuik-services config)
2248 "Return a <shepherd-service> for snuik with CONFIG."
2249 (match-record config
2250 <snuik-configuration>
2251 (snuik server port nick password password-file channels extra-options
2252 home-service?)
2253 (let* ((password-file (snuik-configuration-password-file config))
2254 (mappings `(,@(if home-service?
2255 '()
2256 `(,(file-system-mapping
2257 (source "/var/run/snuik")
2258 (target source)
2259 (writable? #t))
2260 ,@(if password-file
2261 (list (file-system-mapping
2262 (source password-file)
2263 (target source)))
2264 '())))))
2265 (snuik (least-authority-wrapper
2266 (file-append snuik "/bin/snuik")
2267 #:name "snuik"
2268 #:mappings mappings
2269 #:namespaces (delq 'net %namespaces)))
2270 (command
2271 #~'(#$snuik
2272 #$@(if (and server (not (eq? server %unset-value)))
2273 (list (string-append "--server=" server))
2274 #~())
2275 #$@(if (and port (not (eq? port %unset-value)))
2276 (list (string-append "--port=" (number->string port)))
2277 #~())
2278 #$@(if (and nick (not (eq? nick %unset-value)))
2279 (list (string-append "--nick=" nick))
2280 #~())
2281 #$@(if (and password (not (eq? password %unset-value)))
2282 (list (string-append "--password=" password))
2283 #~())
2284 #$@(if (and password-file (not (eq? password-file %unset-value)))
2285 (list (string-append "--password-file=" password-file))
2286 #~())
2287 #$@(if (pair? channels)
2288 (list (string-append "--channels=" (string-join channels ",")))
2289 #~())
2290 #$@extra-options))
2291 (log-file #~(string-append
2292 #$(if home-service? #~%user-log-dir "/var/log")
2293 "/snuik.log")))
2294 (list (shepherd-service
2295 (documentation "Run the snuik IRC bot.")
2296 (provision '(snuik))
2297 (requirement (if home-service? '() '(user-processes networking)))
2298 (modules (if home-service?
2299 '((shepherd support)) ;for '%user-log-dir'
2300 '()))
2301 (start #~(make-forkexec-constructor
2302 #$command
2303 #:log-file #$log-file
2304 #:user #$(and (not home-service?) "snuik")
2305 #:group #$(and (not home-service?) "snuik")))
2306 (stop #~(make-kill-destructor)))))))
2307
2308(define snuik-activation
2309 (with-imported-modules '((guix build utils))
2310 #~(begin
2311 (use-modules (guix build utils))
2312 (let* ((user (getpw "snuik"))
2313 (directory "/var/run/snuik"))
2314 (mkdir-p directory)
2315 (chown directory (passwd:uid user) (passwd:gid user))))))
2316
2317(define %snuik-accounts
2318 (list (user-group (name "snuik") (system? #t))
2319 (user-account
2320 (name "snuik")
2321 (group "snuik")
2322 (system? #t)
2323 (comment "Snuik IRC bot user")
2324 (home-directory "/var/run/snuik")
2325 (shell (file-append shadow "/sbin/nologin")))))
2326
2327(define snuik-service-type
2328 (service-type
2329 (name 'home-snuik)
2330 (description "Run the Snuik IRC bot.")
2331 (default-value (snuik-configuration))
2332 (extensions
2333 (list (service-extension activation-service-type
2334 (const snuik-activation))
2335 (service-extension account-service-type
2336 (const %snuik-accounts))
2337 (service-extension shepherd-root-service-type
2338 snuik-services)))))
2339
2340
2341;;;
2342;;; Mollysocket.
2343;;;
2344(define (ms-format label rhs)
2345 (let* ((uglify (match-lambda (#\- #\_) (x x)))
2346 (lhs (string-map uglify (symbol->string label))))
2347 (format #f "~a = ~a~%" lhs rhs)))
2348(define (ms-serialize-string label val)
2349 (ms-format label (string-append "'" val "'")))
2350(define (ms-serialize-integer label val)
2351 (ms-format label (number->string val)))
2352(define (ms-serialize-boolean label val)
2353 (ms-format label (if val "true" "false")))
2354(define (ms-serialize-list-of-strings label val)
2355 (ms-format label (format #f "[ ~{'~a'~^, ~} ]" val)))
2356
2357(define-configuration mollysocket-configuration
2358 (package (file-like mollysocket) "Mollysocket package to use."
2359 (serializer empty-serializer))
2360 (host (string "127.0.0.1") "Listening address. It is recommended to connect
2361to Mollysocket through a TLS-supporting reverse proxy.")
2362 (port (integer 8020) "Listening port.")
2363 (webserver (boolean #t) "Enable webserver. If disabled, clients must use
2364airgapped mode.")
2365 (allowed-endpoints (list-of-strings '("*")) "Allowlist of UnifiedPush
2366distributor endpoints, represented as IP addresses or domain names. Addresses
2367on the local network must be specified explicitly.")
2368 (allowed-uuids (list-of-strings '("*")) "Allowlist of Signal account UUIDs.")
2369 (db (string "/var/lib/mollysocket/db.sqlite") "Path to the database. Will be
2370created if it does not exist.")
2371 (vapid-key-file (string "/var/lib/mollysocket/vapid.key") "Path to the VAPID
2372key used to authorize requests to the UnifiedPush distributor. Will be created
2373if it does not exist.")
2374 (prefix ms-))
2375
2376(define (mollysocket-shepherd-service config)
2377 (list (shepherd-service
2378 (documentation "UnifiedPush provider for the Signal client Molly.")
2379 (provision '(mollysocket))
2380 (requirement '(networking syslogd user-processes))
2381 (start #~(make-forkexec-constructor
2382 (list #$(file-append mollysocket "/bin/mollysocket")
2383 "-c" #$(mixed-text-file "mollysocket.toml"
2384 (serialize-configuration config
2385 mollysocket-configuration-fields))
2386 "server")
2387 #:user "mollysocket" #:group "mollysocket"
2388 #:log-file "/var/log/mollysocket.log"))
2389 (stop #~(make-kill-destructor SIGINT)))))
2390
2391(define (mollysocket-account-service config)
2392 (list (user-group (name "mollysocket") (system? #t))
2393 (user-account
2394 (name "mollysocket")
2395 (group "mollysocket")
2396 (system? #t)
2397 (comment "Mollysocket daemon user")
2398 (home-directory "/var/empty")
2399 (shell (file-append shadow "/sbin/nologin")))))
2400
2401(define (mollysocket-activation-service config)
2402 #~(let* ((mollysocket #$(file-append
2403 (mollysocket-configuration-package config)
2404 "/bin/mollysocket"))
2405 (user (getpwnam "mollysocket"))
2406 (key #$(mollysocket-configuration-vapid-key-file config))
2407 (dbdir (dirname #$(mollysocket-configuration-db config)))
2408 (keydir (dirname key)))
2409 (define (create file proc mode)
2410 (let ((ret (proc file)))
2411 (chmod file mode)
2412 (chown file (passwd:uid user) (passwd:gid user))
2413 ret))
2414 (unless (file-exists? dbdir) (create dbdir mkdir-p #o700))
2415 (unless (file-exists? keydir) (create keydir mkdir-p #o700))
2416 (unless (file-exists? key)
2417 (let ((p (create key open-output-file #o600))) ; restrict then write
2418 (with-output-to-port p (lambda () (invoke mollysocket "vapid" "gen")))
2419 (close-port p)))))
2420
2421(define mollysocket-service-type
2422 (service-type
2423 (name 'mollysocket)
2424 (extensions (list (service-extension shepherd-root-service-type
2425 mollysocket-shepherd-service)
2426 (service-extension account-service-type
2427 mollysocket-account-service)
2428 (service-extension activation-service-type
2429 mollysocket-activation-service)))
2430 (default-value (mollysocket-configuration))
2431 (description "UnifiedPush provider for the Signal client Molly.")))
2432
2433
2434;;;
2435;;; Soju
2436;;;
2437
2438(define %default-soju-shepherd-requirement
2439 '(user-processes loopback))
2440
2441(define-configuration soju-ssl
2442 (certificate
2443 (string)
2444 "Where to find the certificate for secure connections."
2445 (serializer empty-serializer))
2446 (key
2447 (string)
2448 "Where to find the private key for secure connections."
2449 (serializer empty-serializer)))
2450
2451(define (soju-serialize-soju-ssl name value)
2452 #~(string-append "tls "
2453 #$(soju-ssl-certificate value)
2454 " "
2455 #$(soju-ssl-key value)
2456 "\n"))
2457
2458(define-maybe soju-ssl (prefix soju-))
2459
2460(define (soju-sanitize-db-driver value)
2461 (if (or (eq? value 'sqlite3)
2462 (eq? value 'postgres))
2463 value
2464 (raise
2465 (formatted-message
2466 (G_ "db-driver can be either 'sqlite3 or 'postgres but ~a was found")
2467 value))))
2468
2469(define (soju-serialize-symbol name value) (symbol->string value))
2470
2471(define (soju-serialize-string name value)
2472 (define quoted-value
2473 #~(if (string-contains #$value " ")
2474 (string-append "\"" #$value "\"")
2475 #$value))
2476 #~(string-append (symbol->string '#$name) " " #$quoted-value "\n"))
2477
2478(define soju-serialize-package serialize-package)
2479
2480(define-maybe string (prefix soju-))
2481
2482(define-configuration soju-database
2483 (datadir
2484 (string "/var/lib/soju")
2485 "The name of the directory where soju will write its state.")
2486 (driver
2487 (symbol 'sqlite3)
2488 "Set the database driver for user, network and channel storage.
2489
2490Supported drivers:
2491
2492@itemize
2493@item @code{'sqlite3}
2494@item @code{'postgres}
2495@end itemize"
2496 (sanitizer soju-sanitize-db-driver)
2497 (serializer soju-serialize-symbol))
2498 (source
2499 (maybe-string)
2500 "Set the database location for user, network and channel storage. By
2501default, a sqlite3 database is opened in the directory specified in the
2502@code{datadir} field.
2503
2504In general the driver expect the following:
2505
2506@itemize
2507@item @code{'sqlite3} expects source to be a path to the SQLite file
2508@item @code{'postgres} expects source to be a space-separated list of
2509@code{key=value} parameters, e.g. @code{\"host=/run/postgresql dbname=soju\"}.
2510Note that @code{sslmode defaults} to @code{require}. For more information on
2511connection strings, see
2512@url{https://pkg.go.dev/github.com/lib/pq#hdr-Connection_String_Parameters,
2513upstream}'s documentation.
2514@end itemize"
2515 (serializer soju-serialize-maybe-string)))
2516
2517(define (soju-db-source driver source datadir)
2518 (if (not (string=? "" source))
2519 source
2520 (if (string=? driver "sqlite3")
2521 (string-append datadir "/soju.db")
2522 (raise
2523 (G_ "db-source can't be empty when db-driver is set to 'postgres.
2524Make sure to pass a connection string")))))
2525
2526(define (soju-serialize-soju-database name config)
2527 (define fields
2528 (filter-configuration-fields
2529 soju-database-fields
2530 '(driver source)))
2531 (define getters
2532 (map configuration-field-getter fields))
2533 (define names
2534 (map configuration-field-name fields))
2535 (define serializers
2536 (map configuration-field-serializer fields))
2537 (define values
2538 (map (match-lambda ((serializer name getter)
2539 (serializer name (getter config))))
2540 (zip serializers names getters)))
2541
2542 #~(string-append "db " #$(first values)
2543 " " #$(soju-db-source
2544 (first values)
2545 (second values)
2546 (soju-database-datadir config))
2547 "\n"))
2548
2549(define (soju-serialize-list-of-strings name value)
2550 #~(string-append
2551 (string-join (map (lambda (l) (string-append "listen " l))
2552 (list #$@value))
2553 "\n")
2554 "\n"))
2555
2556
2557(define soju-serialize-text-config serialize-text-config)
2558
2559(define-configuration soju-configuration
2560 (soju
2561 (package soju)
2562 "Soju package to use for the service."
2563 (serializer empty-serializer))
2564 (debug?
2565 (boolean #f)
2566 "Enable debug logging (this will leak sensitive information such as
2567passwords). This can be overriden at run time with the service command
2568@code{server debug}."
2569 (serializer empty-serializer))
2570 (listen
2571 (list-of-strings '(":6697"))
2572 "Listening URI. The following URIs are supported:
2573
2574@itemize
2575
2576@item @code{[ircs://][host][:port]} listens with TLS over TCP (default port if
2577omitted: 6697)
2578@item @code{irc://localhost[:port]} listens with plain-text over TCP (default
2579port if omitted: 6667, host must be @code{\"localhost\"})
2580@item @code{irc+insecure://[host][:port]} listens with plain-text over TCP
2581(default port if omitted: 6667)
2582@item @code{unix://<path>} listens on a Unix domain socket
2583@item @code{https://[host][:port]} listens for HTTPS connections (default port:
2584443) and handles the following requests: @code{/socket} for WebSocket and
2585@code{/uploads} (and subdirectories) for file uploads
2586@item @code{http://localhost[:port]} listens for plain-text HTTP connections
2587(default port: 80, host must be @code{\"localhost\"}) and handles requests like
2588@code{https://} does
2589@item @code{http+insecure://[host][:port]} listens for plain-text HTTP
2590connections (default port: 80) and handles requests like @code{https://} does
2591@item @code{http+unix://<path>} listens for plain-text HTTP connections on a
2592Unix domain socket and handles requests like @code{https://} does
2593@item @code{wss://[host][:port]} listens for WebSocket connections over TLS
2594(default port: 443)
2595@item @code{ws://localhost[:port]} listens for plain-text WebSocket connections
2596(default port: 80, host must be @code{\"localhost\"})
2597@item @code{ws+insecure://[host][:port]} listens for plain-text WebSocket
2598connections (default port: 80)
2599@item @code{ws+unix://<path>} listens for plain-text WebSocket connections on a
2600Unix domain socket
2601@item @code{ident://[host][:port]} listens for plain-text ident connections
2602(default port: 113)
2603@item @code{http+prometheus://localhost:<port>} listens for plain-text HTTP
2604connections and serves Prometheus metrics (host must be @code{\"localhost\"})
2605@item @code{http+pprof://localhost:<port>} listens for plain-text HTTP
2606connections and serves pprof runtime profiling data (host must be
2607@code{\"localhost\"}). For more information, see
2608@url{https://pkg.go.dev/net/http/pprof,upstream} documentation
2609@item @code{unix+admin://[path]} listens on a Unix domain socket for
2610administrative connections, such as sojuctl (default path:
2611@code{/run/soju/admin})
2612
2613@end itemize
2614
2615If the scheme is omitted, @code{ircs} is assumed. If multiple @code{listen}
2616values are specified, soju will listen on each of them.")
2617 (hostname
2618 (maybe-string)
2619 "Server hostname, it defaults to the system hostname. This should be set to
2620a fully qualified domain name.")
2621 (title
2622 (string)
2623 "Server title. This will be sent as the @code{ISUPPORT NETWORK} value when
2624clients don't select a specific network.")
2625 (ssl-certificate
2626 (maybe-soju-ssl)
2627 "Where to find the private key for secure connections. If set, this field
2628will have the service run under root privileges.")
2629 (shepherd-requirement
2630 (list %default-soju-shepherd-requirement)
2631 "A list of Shepherd services to use. Add extra dependencies to
2632@code{%default-soju-shepherd-requirement} to extend its value."
2633 (serializer empty-serializer))
2634 (log-file
2635 (string "/var/log/soju.log")
2636 "The name of the file where soju will write its logs."
2637 (serializer empty-serializer))
2638 (db
2639 (soju-database (soju-database))
2640 "The database where soju will write its state.")
2641 (extra-content
2642 (text-config '())
2643 "Extra content to append to the configuration as-is.")
2644 (prefix soju-))
2645
2646(define (soju-needs-privileges? config)
2647 ;; NOTE: Certificates on the Guix System are only readable by root. In case a
2648 ;; certificate and a private key are passed no unprivileged users will be
2649 ;; added to the system.
2650 (maybe-value-set?
2651 (soju-configuration-ssl-certificate config)))
2652
2653(define (serialize-soju-configuration config)
2654 (mixed-text-file "soju.conf"
2655 (serialize-configuration
2656 config
2657 (filter-configuration-fields
2658 soju-configuration-fields
2659 '(soju debug? shepherd-requirement log-file)
2660 #t))))
2661
2662(define (soju-activation config)
2663 (let ((datadir (soju-database-datadir
2664 (soju-configuration-db config)))
2665 (user-name
2666 (if (soju-needs-privileges? config) "root" "soju")))
2667 #~(let* ((user (getpwnam #$user-name))
2668 (uid (passwd:uid user))
2669 (gid (passwd:gid user))
2670 (datadir #$datadir))
2671 ;; Setup datadir
2672 (mkdir-p datadir)
2673 (chown datadir uid gid)
2674 (for-each (lambda (f) (chown f uid gid))
2675 (find-files datadir ".*")))))
2676
2677(define (soju-accounts config)
2678 (if (soju-needs-privileges? config)
2679 '()
2680 (list (user-group (name "soju") (system? #t))
2681 (user-account
2682 (name "soju")
2683 (group "soju")
2684 (system? #t)
2685 (comment "soju server user")
2686 (home-directory "/var/empty")
2687 (shell (file-append shadow "/sbin/nologin"))))))
2688
2689(define (soju-shepherd-services config)
2690 (match-record config <soju-configuration>
2691 (soju debug? log-file shepherd-requirement)
2692 (let ((user-name (if (soju-needs-privileges? config) "root" "soju"))
2693 (soju-binary (file-append soju "/bin/soju"))
2694 (config-file (serialize-soju-configuration config)))
2695 (list (shepherd-service
2696 (provision '(soju))
2697 (documentation "Run the soju daemon.")
2698 (requirement shepherd-requirement)
2699 (start #~(make-forkexec-constructor
2700 (list #$soju-binary
2701 #$@(if debug? '("-debug") '())
2702 "-config" #$config-file)
2703 #:log-file #$log-file
2704 #:user #$user-name
2705 #:group #$user-name))
2706 (stop #~(make-kill-destructor))
2707 (actions
2708 (list
2709 (shepherd-action
2710 (name 'reload)
2711 (documentation "Reload soju configuration file and restart
2712it. It is useful for situations where the same soju configuration file can
2713point to different things after a reload, such as renewed TLS certificates.")
2714 (procedure
2715 #~(lambda (process . args)
2716 (kill (process-id process) SIGHUP))))
2717 (shepherd-configuration-action config-file))))))))
2718
2719(define soju-service-type
2720 (service-type (name 'soju)
2721 (extensions
2722 (list (service-extension shepherd-root-service-type
2723 soju-shepherd-services)
2724 (service-extension log-rotation-service-type
2725 (compose
2726 list soju-configuration-log-file))
2727 (service-extension activation-service-type
2728 soju-activation)
2729 (service-extension account-service-type
2730 soju-accounts)))
2731 (description "Run the soju IRC bouncer.")))
2732
2733
2734;;;
2735;;; Zulip.
2736;;;
2737
2738(define-configuration/no-serialization zulip-irc-bridge-configuration
2739 (irc-mirror
2740 (file-like
2741 (file-append python-zulip "/bin/zulip-irc-bridge"))
2742 "Path to IRC mirror integration to use for the service.")
2743 (irc-server
2744 string
2745 "The IRC server where the channel to mirror is hosted.")
2746 (channel
2747 string
2748 "The IRC room to mirror.")
2749 (nick-prefix
2750 string
2751 "Bot nickname.")
2752 (stream
2753 string
2754 "The Zulip stream where the mirroring takes place.")
2755 (topic
2756 maybe-string
2757 "The Zulip topic to mirror the IRC room under. Defaults to IRC if not
2758specified.")
2759 (site
2760 string
2761 "The Zulip server that the IRC bridge integration should operate on.")
2762 (user
2763 string
2764 "The Zulip bot email that the IRC integration service should use.")
2765 (api-key
2766 string
2767 "The API key of the Zulip bot that will send the mirrored messages."))
2768
2769(define %zulip-accounts
2770 (list (user-group
2771 (name "zulip")
2772 (system? #t))
2773 (user-account
2774 (name "zulip")
2775 (group "zulip")
2776 (system? #t)
2777 (comment "Kanata daemon user")
2778 (home-directory "/var/empty")
2779 (create-home-directory? #f)
2780 (shell (file-append shadow "/sbin/nologin")))))
2781
2782(define (zulip-irc-bridge-services config)
2783 "Return a <shepherd-service> for Zulip irc-mirror with CONFIG."
2784 (match-record config <zulip-irc-bridge-configuration>
2785 (irc-mirror irc-server channel nick-prefix stream topic site user api-key)
2786 (let* ((command (cons* irc-mirror
2787 (string-append "--irc-server=" irc-server)
2788 (string-append "--channel=" channel)
2789 (string-append "--nick-prefix=" nick-prefix)
2790 (string-append "--stream=" stream)
2791 (string-append "--site=" site)
2792 (string-append "--user=" user)
2793 (string-append "--api-key=" api-key)
2794 (if (maybe-value-set? topic)
2795 (list (string-append "--topic=" topic))
2796 '())))
2797 (log-file "/var/log/zulip-irc-bridge.log"))
2798 (list (shepherd-service
2799 (documentation "Run the Zulip IRC mirror.")
2800 (requirement '(user-processes networking))
2801 (provision '(zulip-irc-bridge))
2802
2803 ;; The bridge attempts to connect to IRC but might fail if
2804 ;; networking is not up. To work around that, retry slowly upon
2805 ;; failure and adjust the respawn limit accordingly.
2806 (respawn-delay 5)
2807 (respawn-limit #~'(5 . 60))
2808
2809 (start #~(make-forkexec-constructor '#$command
2810 #:log-file #$log-file
2811 #:user "zulip"
2812 #:group "zulip"))
2813 (stop #~(make-kill-destructor)))))))
2814
2815(define zulip-irc-bridge-service-type
2816 (service-type
2817 (name 'zulip)
2818 (extensions
2819 (list (service-extension account-service-type
2820 (const %zulip-accounts))
2821 (service-extension shepherd-root-service-type
2822 zulip-irc-bridge-services)))
2823 (description
2824 "Install and configure the Zulip @acronym{IRC, Internet Relay Chat} bridge
2825as a Shepherd service.")))