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