Commit | Line | Data |
---|---|---|
78cef99b CL |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> | |
e7c797f3 | 3 | ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> |
78cef99b CL |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (gnu services messaging) | |
21 | #:use-module (gnu packages messaging) | |
22 | #:use-module (gnu packages admin) | |
23 | #:use-module (gnu services) | |
24 | #:use-module (gnu services shepherd) | |
25 | #:use-module (gnu services configuration) | |
26 | #:use-module (gnu system shadow) | |
27 | #:use-module (guix gexp) | |
28 | #:use-module (guix records) | |
29 | #:use-module (guix packages) | |
30 | #:use-module (srfi srfi-1) | |
31 | #:use-module (srfi srfi-35) | |
32 | #:use-module (ice-9 match) | |
33 | #:export (prosody-service-type | |
34 | prosody-configuration | |
35 | opaque-prosody-configuration | |
36 | ||
37 | virtualhost-configuration | |
38 | int-component-configuration | |
39 | ext-component-configuration | |
40 | ||
41 | mod-muc-configuration | |
42 | ssl-configuration | |
43 | ||
533bc514 CL |
44 | %default-modules-enabled |
45 | prosody-configuration-pidfile)) | |
78cef99b CL |
46 | |
47 | ;;; Commentary: | |
48 | ;;; | |
49 | ;;; Messaging services. | |
50 | ;;; | |
51 | ;;; Code: | |
52 | ||
78cef99b CL |
53 | (define-syntax define-all-configurations |
54 | (lambda (stx) | |
e7c797f3 MO |
55 | (define-syntax-rule (id ctx parts ...) |
56 | "Assemble PARTS into a raw (unhygienic) identifier." | |
57 | (datum->syntax ctx (symbol-append (syntax->datum parts) ...))) | |
78cef99b CL |
58 | (define (make-pred arg) |
59 | (lambda (field target) | |
60 | (and (memq (syntax->datum target) `(common ,arg)) field))) | |
61 | (syntax-case stx () | |
62 | ((_ stem (field (field-type def) doc target) ...) | |
63 | (with-syntax (((new-field-type ...) | |
64 | (map (lambda (field-type target) | |
65 | (if (and (eq? 'common (syntax->datum target)) | |
66 | (not (string-prefix? | |
67 | "maybe-" | |
68 | (symbol->string | |
69 | (syntax->datum field-type))))) | |
70 | (id #'stem #'maybe- field-type) field-type)) | |
71 | #'(field-type ...) #'(target ...))) | |
72 | ((new-def ...) | |
73 | (map (lambda (def target) | |
74 | (if (eq? 'common (syntax->datum target)) | |
75 | #''disabled def)) | |
76 | #'(def ...) #'(target ...))) | |
77 | ((new-doc ...) | |
78 | (map (lambda (doc target) | |
79 | (if (eq? 'common (syntax->datum target)) | |
80 | "" doc)) | |
81 | #'(doc ...) #'(target ...)))) | |
82 | #`(begin | |
10999889 | 83 | (define #,(id #'stem #'common-fields) |
78cef99b | 84 | '(#,@(filter-map (make-pred #f) #'(field ...) #'(target ...)))) |
10999889 | 85 | (define-configuration #,(id #'stem #'prosody-configuration) |
78cef99b CL |
86 | #,@(filter-map (make-pred 'global) |
87 | #'((field (field-type def) doc) ...) | |
88 | #'(target ...))) | |
10999889 | 89 | (define-configuration #,(id #'stem #'virtualhost-configuration) |
78cef99b CL |
90 | #,@(filter-map (make-pred 'virtualhost) |
91 | #'((field (new-field-type new-def) new-doc) ...) | |
92 | #'(target ...))) | |
10999889 | 93 | (define-configuration #,(id #'stem #'int-component-configuration) |
78cef99b CL |
94 | #,@(filter-map (make-pred 'int-component) |
95 | #'((field (new-field-type new-def) new-doc) ...) | |
96 | #'(target ...))) | |
10999889 | 97 | (define-configuration #,(id #'stem #'ext-component-configuration) |
78cef99b CL |
98 | #,@(filter-map (make-pred 'ext-component) |
99 | #'((field (new-field-type new-def) new-doc) ...) | |
100 | #'(target ...))))))))) | |
101 | ||
102 | (define (uglify-field-name field-name) | |
103 | (let ((str (symbol->string field-name))) | |
104 | (string-join (string-split (if (string-suffix? "?" str) | |
105 | (substring str 0 (1- (string-length str))) | |
106 | str) | |
107 | #\-) | |
108 | "_"))) | |
109 | ||
110 | (define (serialize-field field-name val) | |
111 | (format #t "~a = ~a;\n" (uglify-field-name field-name) val)) | |
112 | (define (serialize-field-list field-name val) | |
113 | (serialize-field field-name | |
114 | (with-output-to-string | |
115 | (lambda () | |
116 | (format #t "{\n") | |
117 | (for-each (lambda (x) | |
118 | (format #t "~a;\n" x)) | |
119 | val) | |
120 | (format #t "}"))))) | |
121 | ||
122 | (define (serialize-boolean field-name val) | |
123 | (serialize-field field-name (if val "true" "false"))) | |
124 | (define-maybe boolean) | |
125 | ||
126 | (define (string-or-boolean? val) | |
127 | (or (string? val) (boolean? val))) | |
128 | (define (serialize-string-or-boolean field-name val) | |
129 | (if (string? val) | |
130 | (serialize-string field-name val) | |
131 | (serialize-boolean field-name val))) | |
132 | ||
133 | (define (non-negative-integer? val) | |
134 | (and (exact-integer? val) (not (negative? val)))) | |
135 | (define (serialize-non-negative-integer field-name val) | |
136 | (serialize-field field-name val)) | |
137 | (define-maybe non-negative-integer) | |
138 | ||
139 | (define (non-negative-integer-list? val) | |
140 | (and (list? val) (and-map non-negative-integer? val))) | |
141 | (define (serialize-non-negative-integer-list field-name val) | |
142 | (serialize-field-list field-name val)) | |
143 | (define-maybe non-negative-integer-list) | |
144 | ||
145 | (define (enclose-quotes s) | |
146 | (format #f "\"~a\"" s)) | |
147 | (define (serialize-string field-name val) | |
148 | (serialize-field field-name (enclose-quotes val))) | |
149 | (define-maybe string) | |
150 | ||
151 | (define (string-list? val) | |
152 | (and (list? val) | |
153 | (and-map (lambda (x) | |
154 | (and (string? x) (not (string-index x #\,)))) | |
155 | val))) | |
156 | (define (serialize-string-list field-name val) | |
157 | (serialize-field-list field-name (map enclose-quotes val))) | |
158 | (define-maybe string-list) | |
159 | ||
160 | (define (module-list? val) | |
161 | (string-list? val)) | |
162 | (define (serialize-module-list field-name val) | |
5cc6dcd7 | 163 | (serialize-string-list field-name val)) |
78cef99b CL |
164 | (define-maybe module-list) |
165 | ||
166 | (define (file-name? val) | |
167 | (and (string? val) | |
168 | (string-prefix? "/" val))) | |
169 | (define (serialize-file-name field-name val) | |
170 | (serialize-string field-name val)) | |
171 | (define-maybe file-name) | |
172 | ||
173 | (define (file-name-list? val) | |
174 | (and (list? val) (and-map file-name? val))) | |
175 | (define (serialize-file-name-list field-name val) | |
176 | (serialize-string-list field-name val)) | |
177 | (define-maybe file-name) | |
178 | ||
274b9500 CL |
179 | (define (raw-content? val) |
180 | (not (eq? val 'disabled))) | |
181 | (define (serialize-raw-content field-name val) | |
182 | (format #t "~a" val)) | |
183 | (define-maybe raw-content) | |
184 | ||
78cef99b CL |
185 | (define-configuration mod-muc-configuration |
186 | (name | |
187 | (string "Prosody Chatrooms") | |
188 | "The name to return in service discovery responses.") | |
189 | ||
190 | (restrict-room-creation | |
191 | (string-or-boolean #f) | |
192 | "If @samp{#t}, this will only allow admins to create new chatrooms. | |
193 | Otherwise anyone can create a room. The value @samp{\"local\"} restricts room | |
194 | creation to users on the service's parent domain. E.g. @samp{user@@example.com} | |
195 | can create rooms on @samp{rooms.example.com}. The value @samp{\"admin\"} | |
196 | restricts to service administrators only.") | |
197 | ||
198 | (max-history-messages | |
199 | (non-negative-integer 20) | |
200 | "Maximum number of history messages that will be sent to the member that has | |
201 | just joined the room.")) | |
202 | (define (serialize-mod-muc-configuration field-name val) | |
203 | (serialize-configuration val mod-muc-configuration-fields)) | |
204 | (define-maybe mod-muc-configuration) | |
205 | ||
206 | (define-configuration ssl-configuration | |
207 | (protocol | |
208 | (maybe-string 'disabled) | |
209 | "This determines what handshake to use.") | |
210 | ||
211 | (key | |
5cc6dcd7 CL |
212 | (maybe-file-name 'disabled) |
213 | "Path to your private key file.") | |
78cef99b CL |
214 | |
215 | (certificate | |
5cc6dcd7 CL |
216 | (maybe-file-name 'disabled) |
217 | "Path to your certificate file.") | |
78cef99b CL |
218 | |
219 | (capath | |
220 | (file-name "/etc/ssl/certs") | |
221 | "Path to directory containing root certificates that you wish Prosody to | |
222 | trust when verifying the certificates of remote servers.") | |
223 | ||
224 | (cafile | |
225 | (maybe-file-name 'disabled) | |
226 | "Path to a file containing root certificates that you wish Prosody to trust. | |
227 | Similar to @code{capath} but with all certificates concatenated together.") | |
228 | ||
229 | (verify | |
230 | (maybe-string-list 'disabled) | |
231 | "A list of verification options (these mostly map to OpenSSL's | |
232 | @code{set_verify()} flags).") | |
233 | ||
234 | (options | |
235 | (maybe-string-list 'disabled) | |
236 | "A list of general options relating to SSL/TLS. These map to OpenSSL's | |
237 | @code{set_options()}. For a full list of options available in LuaSec, see the | |
238 | LuaSec source.") | |
239 | ||
240 | (depth | |
241 | (maybe-non-negative-integer 'disabled) | |
242 | "How long a chain of certificate authorities to check when looking for a | |
243 | trusted root certificate.") | |
244 | ||
245 | (ciphers | |
246 | (maybe-string 'disabled) | |
247 | "An OpenSSL cipher string. This selects what ciphers Prosody will offer to | |
248 | clients, and in what order.") | |
249 | ||
250 | (dhparam | |
251 | (maybe-file-name 'disabled) | |
252 | "A path to a file containing parameters for Diffie-Hellman key exchange. You | |
253 | can create such a file with: | |
254 | @code{openssl dhparam -out /etc/prosody/certs/dh-2048.pem 2048}") | |
255 | ||
256 | (curve | |
257 | (maybe-string 'disabled) | |
258 | "Curve for Elliptic curve Diffie-Hellman. Prosody's default is | |
259 | @samp{\"secp384r1\"}.") | |
260 | ||
261 | (verifyext | |
262 | (maybe-string-list 'disabled) | |
263 | "A list of \"extra\" verification options.") | |
264 | ||
265 | (password | |
266 | (maybe-string 'disabled) | |
267 | "Password for encrypted private keys.")) | |
268 | (define (serialize-ssl-configuration field-name val) | |
269 | (format #t "ssl = {\n") | |
270 | (serialize-configuration val ssl-configuration-fields) | |
271 | (format #t "};\n")) | |
272 | (define-maybe ssl-configuration) | |
273 | ||
274 | (define %default-modules-enabled | |
275 | '("roster" | |
276 | "saslauth" | |
277 | "tls" | |
278 | "dialback" | |
279 | "disco" | |
5cc6dcd7 | 280 | "carbons" |
78cef99b | 281 | "private" |
5cc6dcd7 | 282 | "blocklist" |
78cef99b CL |
283 | "vcard" |
284 | "version" | |
285 | "uptime" | |
286 | "time" | |
287 | "ping" | |
288 | "pep" | |
289 | "register" | |
290 | "admin_adhoc")) | |
291 | ||
292 | ;; Guile bug. Use begin wrapper, because otherwise virtualhost-configuration | |
293 | ;; is assumed to be a function. See | |
294 | ;; https://www.gnu.org/software/guile/manual/html_node/R6RS-Incompatibilities.html | |
295 | (begin | |
296 | (define (virtualhost-configuration-list? val) | |
297 | (and (list? val) (and-map virtualhost-configuration? val))) | |
298 | (define (serialize-virtualhost-configuration-list l) | |
299 | (for-each | |
300 | (lambda (val) (serialize-virtualhost-configuration val)) l)) | |
301 | ||
302 | (define (int-component-configuration-list? val) | |
303 | (and (list? val) (and-map int-component-configuration? val))) | |
304 | (define (serialize-int-component-configuration-list l) | |
305 | (for-each | |
306 | (lambda (val) (serialize-int-component-configuration val)) l)) | |
307 | ||
308 | (define (ext-component-configuration-list? val) | |
309 | (and (list? val) (and-map ext-component-configuration? val))) | |
310 | (define (serialize-ext-component-configuration-list l) | |
311 | (for-each | |
312 | (lambda (val) (serialize-ext-component-configuration val)) l)) | |
313 | ||
314 | (define-all-configurations prosody-configuration | |
315 | (prosody | |
316 | (package prosody) | |
317 | "The Prosody package." | |
318 | global) | |
319 | ||
320 | (data-path | |
321 | (file-name "/var/lib/prosody") | |
322 | "Location of the Prosody data storage directory. See | |
323 | @url{http://prosody.im/doc/configure}." | |
324 | global) | |
325 | ||
326 | (plugin-paths | |
327 | (file-name-list '()) | |
328 | "Additional plugin directories. They are searched in all the specified | |
329 | paths in order. See @url{http://prosody.im/doc/plugins_directory}." | |
330 | global) | |
331 | ||
5cc6dcd7 CL |
332 | (certificates |
333 | (file-name "/etc/prosody/certs") | |
334 | "Every virtual host and component needs a certificate so that clients and | |
335 | servers can securely verify its identity. Prosody will automatically load | |
336 | certificates/keys from the directory specified here." | |
337 | global) | |
338 | ||
78cef99b CL |
339 | (admins |
340 | (string-list '()) | |
341 | "This is a list of accounts that are admins for the server. Note that you | |
342 | must create the accounts separately. See @url{http://prosody.im/doc/admins} and | |
343 | @url{http://prosody.im/doc/creating_accounts}. | |
344 | Example: @code{(admins '(\"user1@@example.com\" \"user2@@example.net\"))}" | |
345 | common) | |
346 | ||
347 | (use-libevent? | |
348 | (boolean #f) | |
349 | "Enable use of libevent for better performance under high load. See | |
350 | @url{http://prosody.im/doc/libevent}." | |
351 | common) | |
352 | ||
353 | (modules-enabled | |
354 | (module-list %default-modules-enabled) | |
355 | "This is the list of modules Prosody will load on startup. It looks for | |
356 | @code{mod_modulename.lua} in the plugins folder, so make sure that exists too. | |
19ff1f26 CL |
357 | Documentation on modules can be found at: |
358 | @url{http://prosody.im/doc/modules}." | |
78cef99b CL |
359 | common) |
360 | ||
361 | (modules-disabled | |
362 | (string-list '()) | |
363 | "@samp{\"offline\"}, @samp{\"c2s\"} and @samp{\"s2s\"} are auto-loaded, but | |
364 | should you want to disable them then add them to this list." | |
365 | common) | |
366 | ||
367 | (groups-file | |
368 | (file-name "/var/lib/prosody/sharedgroups.txt") | |
369 | "Path to a text file where the shared groups are defined. If this path is | |
370 | empty then @samp{mod_groups} does nothing. See | |
371 | @url{http://prosody.im/doc/modules/mod_groups}." | |
372 | common) | |
373 | ||
374 | (allow-registration? | |
375 | (boolean #f) | |
376 | "Disable account creation by default, for security. See | |
377 | @url{http://prosody.im/doc/creating_accounts}." | |
378 | common) | |
379 | ||
380 | (ssl | |
381 | (maybe-ssl-configuration (ssl-configuration)) | |
382 | "These are the SSL/TLS-related settings. Most of them are disabled so to | |
383 | use Prosody's defaults. If you do not completely understand these options, do | |
384 | not add them to your config, it is easy to lower the security of your server | |
385 | using them. See @url{http://prosody.im/doc/advanced_ssl_config}." | |
386 | common) | |
387 | ||
388 | (c2s-require-encryption? | |
389 | (boolean #f) | |
390 | "Whether to force all client-to-server connections to be encrypted or not. | |
391 | See @url{http://prosody.im/doc/modules/mod_tls}." | |
392 | common) | |
393 | ||
e30038da CL |
394 | (disable-sasl-mechanisms |
395 | (string-list '("DIGEST-MD5")) | |
396 | "Set of mechanisms that will never be offered. See | |
397 | @url{https://prosody.im/doc/modules/mod_saslauth}." | |
398 | common) | |
399 | ||
78cef99b CL |
400 | (s2s-require-encryption? |
401 | (boolean #f) | |
402 | "Whether to force all server-to-server connections to be encrypted or not. | |
403 | See @url{http://prosody.im/doc/modules/mod_tls}." | |
404 | common) | |
405 | ||
406 | (s2s-secure-auth? | |
407 | (boolean #f) | |
408 | "Whether to require encryption and certificate authentication. This | |
409 | provides ideal security, but requires servers you communicate with to support | |
410 | encryption AND present valid, trusted certificates. See | |
411 | @url{http://prosody.im/doc/s2s#security}." | |
412 | common) | |
413 | ||
414 | (s2s-insecure-domains | |
415 | (string-list '()) | |
416 | "Many servers don't support encryption or have invalid or self-signed | |
417 | certificates. You can list domains here that will not be required to | |
418 | authenticate using certificates. They will be authenticated using DNS. See | |
419 | @url{http://prosody.im/doc/s2s#security}." | |
420 | common) | |
421 | ||
422 | (s2s-secure-domains | |
423 | (string-list '()) | |
424 | "Even if you leave @code{s2s-secure-auth?} disabled, you can still require | |
425 | valid certificates for some domains by specifying a list here. See | |
426 | @url{http://prosody.im/doc/s2s#security}." | |
427 | common) | |
428 | ||
429 | (authentication | |
430 | (string "internal_plain") | |
431 | "Select the authentication backend to use. The default provider stores | |
432 | passwords in plaintext and uses Prosody's configured data storage to store the | |
433 | authentication data. If you do not trust your server please see | |
434 | @url{http://prosody.im/doc/modules/mod_auth_internal_hashed} for information | |
435 | about using the hashed backend. See also | |
436 | @url{http://prosody.im/doc/authentication}" | |
437 | common) | |
438 | ||
439 | ;; TODO: Handle more complicated log structures. | |
440 | (log | |
441 | (maybe-string "*syslog") | |
442 | "Set logging options. Advanced logging configuration is not yet supported | |
443 | by the GuixSD Prosody Service. See @url{http://prosody.im/doc/logging}." | |
444 | common) | |
445 | ||
446 | (pidfile | |
447 | (file-name "/var/run/prosody/prosody.pid") | |
448 | "File to write pid in. See @url{http://prosody.im/doc/modules/mod_posix}." | |
449 | global) | |
450 | ||
1f6f1a07 CL |
451 | (http-max-content-size |
452 | (maybe-non-negative-integer 'disabled) | |
453 | "Maximum allowed size of the HTTP body (in bytes)." | |
454 | common) | |
455 | ||
f59de6be CL |
456 | (http-external-url |
457 | (maybe-string 'disabled) | |
458 | "Some modules expose their own URL in various ways. This URL is built | |
459 | from the protocol, host and port used. If Prosody sits behind a proxy, the | |
460 | public URL will be @code{http-external-url} instead. See | |
461 | @url{https://prosody.im/doc/http#external_url}." | |
462 | common) | |
463 | ||
78cef99b CL |
464 | (virtualhosts |
465 | (virtualhost-configuration-list | |
466 | (list (virtualhost-configuration | |
467 | (domain "localhost")))) | |
468 | "A host in Prosody is a domain on which user accounts can be created. For | |
469 | example if you want your users to have addresses like | |
470 | @samp{\"john.smith@@example.com\"} then you need to add a host | |
471 | @samp{\"example.com\"}. All options in this list will apply only to this host. | |
472 | ||
473 | Note: the name \"virtual\" host is used in configuration to avoid confusion with | |
474 | the actual physical host that Prosody is installed on. A single Prosody | |
475 | instance can serve many domains, each one defined as a VirtualHost entry in | |
476 | Prosody's configuration. Conversely a server that hosts a single domain would | |
477 | have just one VirtualHost entry. | |
478 | ||
479 | See @url{http://prosody.im/doc/configure#virtual_host_settings}." | |
480 | global) | |
481 | ||
482 | (int-components | |
483 | (int-component-configuration-list '()) | |
484 | "Components are extra services on a server which are available to clients, | |
485 | usually on a subdomain of the main server (such as | |
486 | @samp{\"mycomponent.example.com\"}). Example components might be chatroom | |
487 | servers, user directories, or gateways to other protocols. | |
488 | ||
489 | Internal components are implemented with Prosody-specific plugins. To add an | |
490 | internal component, you simply fill the hostname field, and the plugin you wish | |
491 | to use for the component. | |
492 | ||
493 | See @url{http://prosody.im/doc/components}." | |
494 | global) | |
495 | ||
496 | (ext-components | |
497 | (ext-component-configuration-list '()) | |
498 | "External components use XEP-0114, which most standalone components | |
499 | support. To add an external component, you simply fill the hostname field. See | |
500 | @url{http://prosody.im/doc/components}." | |
501 | global) | |
502 | ||
503 | (component-secret | |
504 | (string (configuration-missing-field 'ext-component 'component-secret)) | |
505 | "Password which the component will use to log in." | |
506 | ext-component) | |
507 | ||
508 | (component-ports | |
509 | (non-negative-integer-list '(5347)) | |
510 | "Port(s) Prosody listens on for component connections." | |
511 | global) | |
512 | ||
513 | (component-interface | |
514 | (string "127.0.0.1") | |
515 | "Interface Prosody listens on for component connections." | |
516 | global) | |
517 | ||
518 | (domain | |
519 | (string (configuration-missing-field 'virtualhost 'domain)) | |
520 | "Domain you wish Prosody to serve." | |
521 | virtualhost) | |
522 | ||
523 | (hostname | |
524 | (string (configuration-missing-field 'int-component 'hostname)) | |
525 | "Hostname of the component." | |
526 | int-component) | |
527 | ||
528 | (plugin | |
529 | (string (configuration-missing-field 'int-component 'plugin)) | |
530 | "Plugin you wish to use for the component." | |
531 | int-component) | |
532 | ||
533 | (mod-muc | |
534 | (maybe-mod-muc-configuration 'disabled) | |
535 | "Multi-user chat (MUC) is Prosody's module for allowing you to create | |
536 | hosted chatrooms/conferences for XMPP users. | |
537 | ||
538 | General information on setting up and using multi-user chatrooms can be found | |
539 | in the \"Chatrooms\" documentation (@url{http://prosody.im/doc/chatrooms}), | |
540 | which you should read if you are new to XMPP chatrooms. | |
541 | ||
542 | See also @url{http://prosody.im/doc/modules/mod_muc}." | |
543 | int-component) | |
544 | ||
545 | (hostname | |
546 | (string (configuration-missing-field 'ext-component 'hostname)) | |
547 | "Hostname of the component." | |
274b9500 CL |
548 | ext-component) |
549 | ||
550 | (raw-content | |
551 | (maybe-raw-content 'disabled) | |
552 | "Raw content that will be added to the configuration file." | |
553 | common))) | |
78cef99b CL |
554 | |
555 | ;; Serialize Virtualhost line first. | |
556 | (define (serialize-virtualhost-configuration config) | |
557 | (define (rest? field) | |
558 | (not (memq (configuration-field-name field) | |
559 | '(domain)))) | |
560 | (let ((domain (virtualhost-configuration-domain config)) | |
561 | (rest (filter rest? virtualhost-configuration-fields))) | |
562 | (format #t "VirtualHost \"~a\"\n" domain) | |
563 | (serialize-configuration config rest))) | |
564 | ||
565 | ;; Serialize Component line first. | |
566 | (define (serialize-int-component-configuration config) | |
567 | (define (rest? field) | |
568 | (not (memq (configuration-field-name field) | |
569 | '(hostname plugin)))) | |
570 | (let ((hostname (int-component-configuration-hostname config)) | |
571 | (plugin (int-component-configuration-plugin config)) | |
572 | (rest (filter rest? int-component-configuration-fields))) | |
573 | (format #t "Component \"~a\" \"~a\"\n" hostname plugin) | |
574 | (serialize-configuration config rest))) | |
575 | ||
576 | ;; Serialize Component line first. | |
577 | (define (serialize-ext-component-configuration config) | |
578 | (define (rest? field) | |
579 | (not (memq (configuration-field-name field) | |
580 | '(hostname)))) | |
581 | (let ((hostname (ext-component-configuration-hostname config)) | |
582 | (rest (filter rest? ext-component-configuration-fields))) | |
583 | (format #t "Component \"~a\"\n" hostname) | |
584 | (serialize-configuration config rest))) | |
585 | ||
586 | ;; Serialize virtualhosts and components last. | |
587 | (define (serialize-prosody-configuration config) | |
588 | (define (rest? field) | |
589 | (not (memq (configuration-field-name field) | |
590 | '(virtualhosts int-components ext-components)))) | |
591 | (let ((rest (filter rest? prosody-configuration-fields))) | |
592 | (serialize-configuration config rest)) | |
593 | (serialize-virtualhost-configuration-list | |
594 | (prosody-configuration-virtualhosts config)) | |
595 | (serialize-int-component-configuration-list | |
596 | (prosody-configuration-int-components config)) | |
597 | (serialize-ext-component-configuration-list | |
598 | (prosody-configuration-ext-components config))) | |
599 | ||
600 | (define-configuration opaque-prosody-configuration | |
601 | (prosody | |
602 | (package prosody) | |
603 | "The prosody package.") | |
604 | ||
605 | (prosody.cfg.lua | |
606 | (string (configuration-missing-field 'opaque-prosody-configuration | |
607 | 'prosody.cfg.lua)) | |
608 | "The contents of the @code{prosody.cfg.lua} to use.")) | |
609 | ||
610 | (define (prosody-shepherd-service config) | |
611 | "Return a <shepherd-service> for Prosody with CONFIG." | |
612 | (let* ((prosody (if (opaque-prosody-configuration? config) | |
613 | (opaque-prosody-configuration-prosody config) | |
614 | (prosody-configuration-prosody config))) | |
615 | (prosodyctl-bin (file-append prosody "/bin/prosodyctl")) | |
616 | (prosodyctl-action (lambda args | |
617 | #~(lambda _ | |
618 | (zero? (system* #$prosodyctl-bin #$@args)))))) | |
619 | (list (shepherd-service | |
620 | (documentation "Run the Prosody XMPP server") | |
533bc514 | 621 | (provision '(prosody xmpp-daemon)) |
78cef99b CL |
622 | (requirement '(networking syslogd user-processes)) |
623 | (start (prosodyctl-action "start")) | |
624 | (stop (prosodyctl-action "stop")))))) | |
625 | ||
626 | (define %prosody-accounts | |
627 | (list (user-group (name "prosody") (system? #t)) | |
628 | (user-account | |
629 | (name "prosody") | |
630 | (group "prosody") | |
631 | (system? #t) | |
632 | (comment "Prosody daemon user") | |
633 | (home-directory "/var/empty") | |
634 | (shell (file-append shadow "/sbin/nologin"))))) | |
635 | ||
636 | (define (prosody-activation config) | |
637 | "Return the activation gexp for CONFIG." | |
638 | (let* ((config-dir "/etc/prosody") | |
639 | (default-certs-dir "/etc/prosody/certs") | |
640 | (data-path (prosody-configuration-data-path config)) | |
641 | (pidfile-dir (dirname (prosody-configuration-pidfile config))) | |
642 | (config-str | |
643 | (if (opaque-prosody-configuration? config) | |
644 | (opaque-prosody-configuration-prosody.cfg.lua config) | |
645 | (with-output-to-string | |
646 | (lambda () | |
647 | (serialize-prosody-configuration config))))) | |
648 | (config-file (plain-file "prosody.cfg.lua" config-str))) | |
649 | #~(begin | |
87508d9a | 650 | (use-modules (guix build utils)) |
78cef99b CL |
651 | (define %user (getpw "prosody")) |
652 | ||
653 | (mkdir-p #$config-dir) | |
654 | (chown #$config-dir (passwd:uid %user) (passwd:gid %user)) | |
655 | (copy-file #$config-file (string-append #$config-dir | |
656 | "/prosody.cfg.lua")) | |
657 | ||
658 | (mkdir-p #$default-certs-dir) | |
659 | (chown #$default-certs-dir (passwd:uid %user) (passwd:gid %user)) | |
660 | (chmod #$default-certs-dir #o750) | |
661 | ||
662 | (mkdir-p #$data-path) | |
663 | (chown #$data-path (passwd:uid %user) (passwd:gid %user)) | |
664 | (chmod #$data-path #o750) | |
665 | ||
666 | (mkdir-p #$pidfile-dir) | |
667 | (chown #$pidfile-dir (passwd:uid %user) (passwd:gid %user))))) | |
668 | ||
669 | (define prosody-service-type | |
670 | (service-type (name 'prosody) | |
671 | (extensions | |
672 | (list (service-extension shepherd-root-service-type | |
673 | prosody-shepherd-service) | |
674 | (service-extension account-service-type | |
675 | (const %prosody-accounts)) | |
676 | (service-extension activation-service-type | |
677 | prosody-activation))))) | |
678 | ||
679 | ;; A little helper to make it easier to document all those fields. | |
680 | (define (generate-documentation) | |
681 | (define documentation | |
682 | `((prosody-configuration | |
683 | ,prosody-configuration-fields | |
684 | (ssl ssl-configuration) | |
685 | (virtualhosts virtualhost-configuration) | |
686 | (int-components int-component-configuration) | |
687 | (ext-components ext-component-configuration)) | |
688 | (ssl-configuration ,ssl-configuration-fields) | |
689 | (int-component-configuration ,int-component-configuration-fields | |
690 | (mod-muc mod-muc-configuration)) | |
691 | (ext-component-configuration ,ext-component-configuration-fields) | |
692 | (mod-muc-configuration ,mod-muc-configuration-fields) | |
693 | (virtualhost-configuration ,virtualhost-configuration-fields) | |
694 | (opaque-prosody-configuration ,opaque-prosody-configuration-fields))) | |
695 | (define (generate configuration-name) | |
696 | (match (assq-ref documentation configuration-name) | |
697 | ((fields . sub-documentation) | |
698 | (format #t "\nAvailable @code{~a} fields are:\n\n" configuration-name) | |
699 | (when (memq configuration-name | |
700 | '(virtualhost-configuration | |
701 | int-component-configuration | |
702 | ext-component-configuration)) | |
703 | (format #t "all these @code{prosody-configuration} fields: ~a, plus:\n" | |
704 | (string-join (map (lambda (s) | |
705 | (format #f "@code{~a}" s)) common-fields) | |
706 | ", "))) | |
707 | (for-each | |
708 | (lambda (f) | |
709 | (let ((field-name (configuration-field-name f)) | |
710 | (field-type (configuration-field-type f)) | |
711 | (field-docs (string-trim-both | |
712 | (configuration-field-documentation f))) | |
713 | (default (catch #t | |
714 | (configuration-field-default-value-thunk f) | |
715 | (lambda _ 'nope)))) | |
716 | (define (escape-chars str chars escape) | |
717 | (with-output-to-string | |
718 | (lambda () | |
719 | (string-for-each (lambda (c) | |
720 | (when (char-set-contains? chars c) | |
721 | (display escape)) | |
722 | (display c)) | |
723 | str)))) | |
724 | (define (show-default? val) | |
19ff1f26 | 725 | (or (string? val) (number? val) (boolean? val) |
78cef99b CL |
726 | (and (list? val) (and-map show-default? val)))) |
727 | (format #t "@deftypevr {@code{~a} parameter} ~a ~a\n~a\n" | |
728 | configuration-name field-type field-name field-docs) | |
729 | (when (show-default? default) | |
730 | (format #t "Defaults to @samp{~a}.\n" | |
731 | (escape-chars (format #f "~s" default) | |
732 | (char-set #\@ #\{ #\}) | |
733 | #\@))) | |
734 | (for-each generate (or (assq-ref sub-documentation field-name) '())) | |
735 | (format #t "@end deftypevr\n\n"))) | |
736 | (filter (lambda (f) | |
737 | (not (string=? "" (configuration-field-documentation f)))) | |
738 | fields))))) | |
739 | (generate 'prosody-configuration) | |
740 | (format #t "It could be that you just want to get a @code{prosody.cfg.lua} | |
741 | up and running. In that case, you can pass an | |
742 | @code{opaque-prosody-configuration} record as the value of | |
743 | @code{prosody-service-type}. As its name indicates, an opaque configuration | |
744 | does not have easy reflective capabilities.") | |
745 | (generate 'opaque-prosody-configuration) | |
746 | (format #t "For example, if your @code{prosody.cfg.lua} is just the empty | |
747 | string, you could instantiate a prosody service like this: | |
748 | ||
749 | @example | |
750 | (service prosody-service-type | |
751 | (opaque-prosody-configuration | |
752 | (prosody.cfg.lua \"\"))) | |
753 | @end example")) |