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