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