gnu/services/messaging.scm

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