gnu/services/messaging.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
   3 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  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
  44             %default-modules-enabled
  45             prosody-configuration-pidfile))
  46
  47 ;;; Commentary:
  48 ;;;
  49 ;;; Messaging services.
  50 ;;;
  51 ;;; Code:
  52
  53 (define-syntax define-all-configurations
  54   (lambda (stx)
  55     (define-syntax-rule (id ctx parts ...)
  56       "Assemble PARTS into a raw (unhygienic) identifier."
  57       (datum->syntax ctx (symbol-append (syntax->datum parts) ...)))
  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
  83              (define #,(id #'stem #'common-fields)
  84                '(#,@(filter-map (make-pred #f) #'(field ...) #'(target ...))))
  85              (define-configuration #,(id #'stem #'prosody-configuration)
  86                #,@(filter-map (make-pred 'global)
  87                               #'((field (field-type def) doc) ...)
  88                               #'(target ...)))
  89              (define-configuration #,(id #'stem #'virtualhost-configuration)
  90                #,@(filter-map (make-pred 'virtualhost)
  91                               #'((field (new-field-type new-def) new-doc) ...)
  92                               #'(target ...)))
  93              (define-configuration #,(id #'stem #'int-component-configuration)
  94                #,@(filter-map (make-pred 'int-component)
  95                               #'((field (new-field-type new-def) new-doc) ...)
  96                               #'(target ...)))
  97              (define-configuration #,(id #'stem #'ext-component-configuration)
  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)
 163   (serialize-string-list field-name val))
 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
 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
 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
 212    (maybe-file-name 'disabled)
 213    "Path to your private key file.")
 214
 215   (certificate
 216    (maybe-file-name 'disabled)
 217    "Path to your certificate file.")
 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"
 280     "carbons"
 281     "private"
 282     "blocklist"
 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
 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
 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:
 358 @url{http://prosody.im/doc/modules}."
 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     (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
 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
 451     (http-max-content-size
 452      (maybe-non-negative-integer 'disabled)
 453      "Maximum allowed size of the HTTP body (in bytes)."
 454      common)
 455
 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
 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."
 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)))
 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")
 621            (provision '(prosody xmpp-daemon))
 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
 650         (use-modules (guix build utils))
 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)
 725               (or (string? val) (number? val) (boolean? val)
 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"))