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