gnu/services/messaging.scm

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