gnu/services/messaging.scm

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