;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2017, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Kristofer Buffington <kristoferbuffington@gmail.com>
;;; Copyright © 2020 Jonathan Brielmaier <jonathan.brielmaier@web.de>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
;;;
;;; Some of the help text was taken from the default dovecot.conf files.

(define-module (gnu services mail)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system pam)
  #:use-module (gnu system shadow)
  #:use-module (gnu system setuid)
  #:use-module (gnu packages mail)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages dav)
  #:use-module (gnu packages tls)
  #:use-module (guix records)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:use-module (srfi srfi-1)
  #:export (dovecot-service
            dovecot-service-type
            dovecot-configuration
            opaque-dovecot-configuration

            dict-configuration
            passdb-configuration
            userdb-configuration
            unix-listener-configuration
            fifo-listener-configuration
            inet-listener-configuration
            service-configuration
            protocol-configuration
            plugin-configuration
            mailbox-configuration
            namespace-configuration

            opensmtpd-table
            opensmtpd-table?
            opensmtpd-table-name
            opensmtpd-table-file-db
            opensmtpd-table-data

            opensmtpd-ca
            opensmtpd-ca?
            opensmtpd-ca-name
            opensmtpd-ca-file

            opensmtpd-pki
            opensmtpd-pki?
            opensmtpd-pki-domain
            opensmtpd-pki-cert
            opensmtpd-pki-key
            opensmtpd-pki-dhe

            opensmtpd-local-delivery
            opensmtpd-local-delivery?
            opensmtpd-local-delivery-method
            opensmtpd-local-delivery-alias
            opensmtpd-local-delivery-ttl
            opensmtpd-local-delivery-user
            opensmtpd-local-delivery-userbase
            opensmtpd-local-delivery-virtual
            opensmtpd-local-delivery-wrapper

            opensmtpd-maildir
            opensmtpd-maildir?
            opensmtpd-maildir-pathname
            opensmtpd-maildir-junk

            opensmtpd-mda
            opensmtpd-mda-name
            opensmtpd-mda-command

            opensmtpd-lmtp
            opensmtpd-lmtp-destination
            opensmtpd-lmtp-rcpt

            opensmtpd-relay
            opensmtpd-relay?
            opensmtpd-relay-backup
            opensmtpd-relay-backup-mx
            opensmtpd-relay-helo
            opensmtpd-relay-domain
            opensmtpd-relay-host
            opensmtpd-relay-pki
            opensmtpd-relay-srs
            opensmtpd-relay-tls
            opensmtpd-relay-auth
            opensmtpd-relay-mail-from
            opensmtpd-relay-src

            opensmtpd-option
            opensmtpd-option?
            opensmtpd-option-option
            opensmtpd-option-not
            opensmtpd-option-regex
            opensmtpd-option-data

            opensmtpd-filter-phase
            opensmtpd-filter-phase?
            opensmtpd-filter-phase-name
            opensmtpd-filter-phase-phase-name
            opensmtpd-filter-phase-options
            opensmtpd-filter-phase-decision
            opensmtpd-filter-phase-message
            opensmtpd-filter-phase-value

            opensmtpd-filter
            opensmtpd-filter?
            opensmtpd-filter-name
            opensmtpd-filter-proc

            opensmtpd-interface
            opensmtpd-interface?
            opensmtpd-interface-interface
            opensmtpd-interface-family
            opensmtpd-interface-auth
            opensmtpd-interface-auth-optional
            opensmtpd-interface-filters
            opensmtpd-interface-hostname
            opensmtpd-interface-hostnames
            opensmtpd-interface-mask-src
            opensmtpd-interface-disable-dsn
            opensmtpd-interface-pki
            opensmtpd-interface-port
            opensmtpd-interface-proxy-v2
            opensmtpd-interface-received-auth
            opensmtpd-interface-senders
            opensmtpd-interface-secure-connection
            opensmtpd-interface-tag

            opensmtpd-socket
            opensmtpd-socket?
            opensmtpd-socket-filters
            opensmtpd-socket-mask-src
            opensmtpd-socket-tag

            opensmtpd-match
            opensmtpd-match?
            opensmtpd-match-action
            opensmtpd-match-options

            opensmtpd-smtp
            opensmtpd-smtp?
            opensmtpd-smtp-ciphers
            opensmtpd-smtp-limit-max-mails
            opensmtpd-smtp-limit-max-rcpt
            opensmtpd-smtp-max-message-size
            opensmtpd-smtp-sub-addr-delim character

            opensmtpd-srs
            opensmtpd-srs?
            opensmtpd-srs-key
            opensmtpd-srs-backup-key
            opensmtpd-srs-ttl-delay

            opensmtpd-queue
            opensmtpd-queue?
            opensmtpd-queue-compression
            opensmtpd-queue-encryption
            opensmtpd-queue-ttl-delay

            opensmtpd-configuration
            opensmtpd-configuration?
            opensmtpd-package
            opensmtpd-config-file
            opensmtpd-configuration-bounce
            opensmtpd-configuration-listen-ons
            opensmtpd-configuration-listen-on-socket
            opensmtpd-configuration-includes
            opensmtpd-configuration-matches
            opensmtpd-configuration-mda-wrappers
            opensmtpd-configuration-mta-max-deferred
            opensmtpd-configuration-srs
            opensmtpd-configuration-smtp
            opensmtpd-configuration-queue

            mail-aliases-service-type

            exim-configuration
            exim-configuration?
            exim-service-type
            %default-exim-config-file

            imap4d-configuration
            imap4d-configuration?
            imap4d-service-type
            %default-imap4d-config-file

            radicale-configuration
            radicale-configuration?
            radicale-service-type
            %default-radicale-config-file))

;;; Commentary:
;;;
;;; This module provides service definitions for the Dovecot POP3 and IMAP
;;; mail server.
;;;
;;; Code:

(define (uglify-field-name field-name)
  (let ((str (symbol->string field-name)))
    (string-join (string-split (if (string-suffix? "?" str)
                                   (substring str 0 (1- (string-length str)))
                                   str)
                               #\-)
                 "_")))

(define (serialize-field field-name val)
  (format #t "~a=~a\n" (uglify-field-name field-name) val))

(define (serialize-string field-name val)
  (serialize-field field-name val))

(define (space-separated-string-list? val)
  (and (list? val)
       (and-map (lambda (x)
                  (and (string? x) (not (string-index x #\space))))
                val)))
(define (serialize-space-separated-string-list field-name val)
  (match val
    (() #f)
    (_ (serialize-field field-name (string-join val " ")))))

(define (comma-separated-string-list? val)
  (and (list? val)
       (and-map (lambda (x)
                  (and (string? x) (not (string-index x #\,))))
                val)))
(define (serialize-comma-separated-string-list field-name val)
  (serialize-field field-name (string-join val ",")))

(define (file-name? val)
  (and (string? val)
       (string-prefix? "/" val)))
(define (serialize-file-name field-name val)
  (serialize-string field-name val))

(define (colon-separated-file-name-list? val)
  (and (list? val)
       ;; Trailing slashes not needed and not
       (and-map file-name? val)))
(define (serialize-colon-separated-file-name-list field-name val)
  (serialize-field field-name (string-join val ":")))

(define (serialize-boolean field-name val)
  (serialize-string field-name (if val "yes" "no")))

(define (non-negative-integer? val)
  (and (exact-integer? val) (not (negative? val))))
(define (serialize-non-negative-integer field-name val)
  (serialize-field field-name val))

(define (hours? val) (non-negative-integer? val))
(define (serialize-hours field-name val)
  (serialize-field field-name (format #f "~a hours" val)))

(define (free-form-fields? val)
  (match val
    (() #t)
    ((((? symbol?) . (? string?)) . val) (free-form-fields? val))
    (_ #f)))
(define (serialize-free-form-fields field-name val)
  (for-each (match-lambda ((k . v) (serialize-field k v))) val))

(define (free-form-args? val)
  (match val
    (() #t)
    ((((? symbol?) . (? string?)) . val) (free-form-args? val))
    (_ #f)))
(define (serialize-free-form-args field-name val)
  (serialize-field field-name
                   (string-join
                    (map (match-lambda ((k . v) (format #f "~a=~a" k v))) val)
                    " ")))

(define-configuration dict-configuration
  (entries
   (free-form-fields '())
   "A list of key-value pairs that this dict should hold."))

(define (serialize-dict-configuration field-name val)
  (format #t "dict {\n")
  (serialize-configuration val dict-configuration-fields)
  (format #t "}\n"))

(define-configuration passdb-configuration
  (driver
   (string "pam")
   "The driver that the passdb should use.  Valid values include
@samp{pam}, @samp{passwd}, @samp{shadow}, @samp{bsdauth}, and
@samp{static}.")
  (args
   (space-separated-string-list '())
   "Space separated list of arguments to the passdb driver."))

(define (serialize-passdb-configuration field-name val)
  (format #t "passdb {\n")
  (serialize-configuration val passdb-configuration-fields)
  (format #t "}\n"))
(define (passdb-configuration-list? val)
  (and (list? val) (and-map passdb-configuration? val)))
(define (serialize-passdb-configuration-list field-name val)
  (for-each (lambda (val) (serialize-passdb-configuration field-name val)) val))

(define-configuration userdb-configuration
  (driver
   (string "passwd")
   "The driver that the userdb should use.  Valid values include
@samp{passwd} and @samp{static}.")
  (args
   (space-separated-string-list '())
   "Space separated list of arguments to the userdb driver.")
  (override-fields
   (free-form-args '())
   "Override fields from passwd."))

(define (serialize-userdb-configuration field-name val)
  (format #t "userdb {\n")
  (serialize-configuration val userdb-configuration-fields)
  (format #t "}\n"))
(define (userdb-configuration-list? val)
  (and (list? val) (and-map userdb-configuration? val)))
(define (serialize-userdb-configuration-list field-name val)
  (for-each (lambda (val) (serialize-userdb-configuration field-name val)) val))

(define-configuration unix-listener-configuration
  (path
   (string (configuration-missing-field 'unix-listener 'path))
   "Path to the file, relative to @code{base-dir} field.  This is also used as
the section name.")
  (mode
   (string "0600")
   "The access mode for the socket.")
  (user
   (string "")
   "The user to own the the socket.")
  (group
   (string "")
   "The group to own the socket."))

(define (serialize-unix-listener-configuration field-name val)
  (format #t "unix_listener ~a {\n" (unix-listener-configuration-path val))
  (serialize-configuration val (cdr unix-listener-configuration-fields))
  (format #t "}\n"))

(define-configuration fifo-listener-configuration
  (path
   (string (configuration-missing-field 'fifo-listener 'path))
   "Path to the file, relative to @code{base-dir} field.  This is also used as
the section name.")
  (mode
   (string "0600")
   "The access mode for the socket.")
  (user
   (string "")
   "The user to own the the socket.")
  (group
   (string "")
   "The group to own the socket."))

(define (serialize-fifo-listener-configuration field-name val)
  (format #t "fifo_listener ~a {\n" (fifo-listener-configuration-path val))
  (serialize-configuration val (cdr fifo-listener-configuration-fields))
  (format #t "}\n"))

(define-configuration inet-listener-configuration
  (protocol
   (string (configuration-missing-field 'inet-listener 'protocol))
   "The protocol to listen for.")
  (address
   (string "")
   "The address on which to listen, or empty for all addresses.")
  (port
   (non-negative-integer
    (configuration-missing-field 'inet-listener 'port))
   "The port on which to listen.")
  (ssl?
   (boolean #t)
   "Whether to use SSL for this service; @samp{yes}, @samp{no}, or
@samp{required}."))

(define (serialize-inet-listener-configuration field-name val)
  (format #t "inet_listener ~a {\n" (inet-listener-configuration-protocol val))
  (serialize-configuration val (cdr inet-listener-configuration-fields))
  (format #t "}\n"))

(define (listener-configuration? val)
  (or (unix-listener-configuration? val)
      (fifo-listener-configuration? val)
      (inet-listener-configuration? val)))
(define (serialize-listener-configuration field-name val)
  (cond
   ((unix-listener-configuration? val)
    (serialize-unix-listener-configuration field-name val))
   ((fifo-listener-configuration? val)
    (serialize-fifo-listener-configuration field-name val))
   ((inet-listener-configuration? val)
    (serialize-inet-listener-configuration field-name val))
   (else (configuration-field-error #f field-name val))))
(define (listener-configuration-list? val)
  (and (list? val) (and-map listener-configuration? val)))
(define (serialize-listener-configuration-list field-name val)
  (for-each (lambda (val)
              (serialize-listener-configuration field-name val))
            val))

(define-configuration service-configuration
  (kind
   (string (configuration-missing-field 'service 'kind))
   "The service kind.  Valid values include @code{director},
@code{imap-login}, @code{pop3-login}, @code{lmtp}, @code{imap},
@code{pop3}, @code{auth}, @code{auth-worker}, @code{dict},
@code{tcpwrap}, @code{quota-warning}, or anything else.")
  (listeners
   (listener-configuration-list '())
   "Listeners for the service.  A listener is either an
@code{unix-listener-configuration}, a @code{fifo-listener-configuration}, or
an @code{inet-listener-configuration}.")
  (client-limit
   (non-negative-integer 0)
   "Maximum number of simultaneous client connections per process.  Once this
number of connections is received, the next incoming connection will prompt
Dovecot to spawn another process.  If set to 0, @code{default-client-limit} is
used instead.")
  (service-count
   (non-negative-integer 1)
   "Number of connections to handle before starting a new process.
Typically the only useful values are 0 (unlimited) or 1.  1 is more
secure, but 0 is faster.  <doc/wiki/LoginProcess.txt>.")
  (process-limit
   (non-negative-integer 0)
   "Maximum number of processes that can exist for this service.  If set to 0,
@code{default-process-limit} is used instead.")
  (process-min-avail
   (non-negative-integer 0)
   "Number of processes to always keep waiting for more connections.")
  ;; FIXME: Need to be able to take the default for this value from other
  ;; parts of the config.
  (vsz-limit
   (non-negative-integer #e256e6)
   "If you set @samp{service-count 0}, you probably need to grow
this."))

(define (serialize-service-configuration field-name val)
  (format #t "service ~a {\n" (service-configuration-kind val))
  (serialize-configuration val (cdr service-configuration-fields))
  (format #t "}\n"))
(define (service-configuration-list? val)
  (and (list? val) (and-map service-configuration? val)))
(define (serialize-service-configuration-list field-name val)
  (for-each (lambda (val)
              (serialize-service-configuration field-name val))
            val))

(define-configuration protocol-configuration
  (name
   (string (configuration-missing-field 'protocol 'name))
   "The name of the protocol.")
  (auth-socket-path
   (string "/var/run/dovecot/auth-userdb")
   "UNIX socket path to master authentication server to find users.
This is used by imap (for shared users) and lda.")
  (mail-plugins
   (space-separated-string-list '("$mail_plugins"))
   "Space separated list of plugins to load.")
  (mail-max-userip-connections
   (non-negative-integer 10)
   "Maximum number of IMAP connections allowed for a user from each IP
address.  NOTE: The username is compared case-sensitively.")
  (imap-metadata?
   (boolean #f)
   "Whether to enable the @code{IMAP METADATA} extension as defined in
@uref{https://tools.ietf.org/html/rfc5464, RFC@tie{}5464}, which provides
a means for clients to set and retrieve per-mailbox, per-user metadata
and annotations over IMAP.

If this is @samp{#t}, you must also specify a dictionary @i{via} the
@code{mail-attribute-dict} setting.")
  (managesieve-notify-capability
   (space-separated-string-list '())
   "Which NOTIFY capabilities to report to clients that first connect to
the ManageSieve service, before authentication.  These may differ from the
capabilities offered to authenticated users.  If this field is left empty,
report what the Sieve interpreter supports by default.")
  (managesieve-sieve-capability
   (space-separated-string-list '())
   "Which SIEVE capabilities to report to clients that first connect to
the ManageSieve service, before authentication.  These may differ from the
capabilities offered to authenticated users.  If this field is left empty,
report what the Sieve interpreter supports by default."))

(define (serialize-protocol-configuration field-name val)
  (format #t "protocol ~a {\n" (protocol-configuration-name val))
  (serialize-configuration val (cdr protocol-configuration-fields))
  (format #t "}\n"))
(define (protocol-configuration-list? val)
  (and (list? val) (and-map protocol-configuration? val)))
(define (serialize-protocol-configuration-list field-name val)
  (serialize-field 'protocols
                   (string-join (map protocol-configuration-name val) " "))
  (for-each (lambda (val)
              (serialize-protocol-configuration field-name val))
            val))

(define-configuration plugin-configuration
  (entries
   (free-form-fields '())
   "A list of key-value pairs that this dict should hold."))

(define (serialize-plugin-configuration field-name val)
  (format #t "plugin {\n")
  (serialize-configuration val plugin-configuration-fields)
  (format #t "}\n"))

(define-configuration mailbox-configuration
  (name
   (string (error "mailbox name is required"))
   "Name for this mailbox.")

  (auto
   (string "no")
   "@samp{create} will automatically create this mailbox.
@samp{subscribe} will both create and subscribe to the mailbox.")

  (special-use
   (space-separated-string-list '())
   "List of IMAP @code{SPECIAL-USE} attributes as specified by RFC 6154.
Valid values are @code{\\All}, @code{\\Archive}, @code{\\Drafts},
@code{\\Flagged}, @code{\\Junk}, @code{\\Sent}, and @code{\\Trash}."))

(define (serialize-mailbox-configuration field-name val)
  (format #t "mailbox \"~a\" {\n" (mailbox-configuration-name val))
  (serialize-configuration val (cdr mailbox-configuration-fields))
  (format #t "}\n"))
(define (mailbox-configuration-list? val)
  (and (list? val) (and-map mailbox-configuration? val)))
(define (serialize-mailbox-configuration-list field-name val)
  (for-each (lambda (val)
              (serialize-mailbox-configuration field-name val))
            val))

(define-configuration namespace-configuration
  (name
   (string (error "namespace name is required"))
   "Name for this namespace.")

  (type
   (string "private")
   "Namespace type: @samp{private}, @samp{shared} or @samp{public}.")

  (separator
   (string "")
   "Hierarchy separator to use. You should use the same separator for
all namespaces or some clients get confused.  @samp{/} is usually a good
one.  The default however depends on the underlying mail storage
format.")

  (prefix
   (string "")
   "Prefix required to access this namespace.  This needs to be
different for all namespaces. For example @samp{Public/}.")

  (location
   (string "")
   "Physical location of the mailbox. This is in same format as
mail_location, which is also the default for it.")

  (inbox?
   (boolean #f)
   "There can be only one INBOX, and this setting defines which
namespace has it.")

  (hidden?
   (boolean #f)
   "If namespace is hidden, it's not advertised to clients via NAMESPACE
extension. You'll most likely also want to set @samp{list? #f}.  This is mostly
useful when converting from another server with different namespaces
which you want to deprecate but still keep working.  For example you can
create hidden namespaces with prefixes @samp{~/mail/}, @samp{~%u/mail/}
and @samp{mail/}.")

  (list?
   (boolean #t)
   "Show the mailboxes under this namespace with LIST command. This
makes the namespace visible for clients that don't support NAMESPACE
extension.  The special @code{children} value lists child mailboxes, but
hides the namespace prefix.")

  (subscriptions?
   (boolean #t)
   "Namespace handles its own subscriptions.  If set to @code{#f}, the
parent namespace handles them.  The empty prefix should always have this
as @code{#t}.)")

  (mailboxes
   (mailbox-configuration-list '())
   "List of predefined mailboxes in this namespace."))

(define (serialize-namespace-configuration field-name val)
  (format #t "namespace ~a {\n" (namespace-configuration-name val))
  (serialize-configuration val (cdr namespace-configuration-fields))
  (format #t "}\n"))
(define (list-of-namespace-configuration? val)
  (and (list? val) (and-map namespace-configuration? val)))
(define (serialize-list-of-namespace-configuration field-name val)
  (for-each (lambda (val)
              (serialize-namespace-configuration field-name val))
            val))

(define-configuration dovecot-configuration
  (dovecot
   (file-like dovecot)
   "The dovecot package.")

  (listen
   (comma-separated-string-list '("*" "::"))
   "A list of IPs or hosts where to listen in for connections.  @samp{*}
listens in all IPv4 interfaces, @samp{::} listens in all IPv6
interfaces.  If you want to specify non-default ports or anything more
complex, customize the address and port fields of the
@samp{inet-listener} of the specific services you are interested in.")

  (dict
   (dict-configuration (dict-configuration))
   "Dict configuration, as created by the @code{dict-configuration}
constructor.")

  (passdbs
   (passdb-configuration-list (list (passdb-configuration (driver "pam"))))
   "List of passdb configurations, each one created by the
@code{passdb-configuration} constructor.")

  (userdbs
   (userdb-configuration-list (list (userdb-configuration (driver "passwd"))))
   "List of userdb configurations, each one created by the
@code{userdb-configuration} constructor.")

  (plugin-configuration
   (plugin-configuration (plugin-configuration))
   "Plug-in configuration, created by the @code{plugin-configuration}
constructor.")

  (namespaces
   (list-of-namespace-configuration
    (list
     (namespace-configuration
      (name "inbox")
      (prefix "")
      (inbox? #t)
      (mailboxes
       (list
        (mailbox-configuration (name "Drafts") (special-use '("\\Drafts")))
        (mailbox-configuration (name "Junk") (special-use '("\\Junk")))
        (mailbox-configuration (name "Trash") (special-use '("\\Trash")))
        (mailbox-configuration (name "Sent") (special-use '("\\Sent")))
        (mailbox-configuration (name "Sent Messages") (special-use '("\\Sent")))
        (mailbox-configuration (name "Drafts") (special-use '("\\Drafts"))))))))
   "List of namespaces.  Each item in the list is created by the
@code{namespace-configuration} constructor.")

  (base-dir
   (file-name "/var/run/dovecot/")
   "Base directory where to store runtime data.")

  (login-greeting
   (string "Dovecot ready.")
   "Greeting message for clients.")

  (login-trusted-networks
   (space-separated-string-list '())
   "List of trusted network ranges.  Connections from these IPs are
allowed to override their IP addresses and ports (for logging and for
authentication checks).  @samp{disable-plaintext-auth} is also ignored
for these networks.  Typically you'd specify your IMAP proxy servers
here.")

  (login-access-sockets
   (space-separated-string-list '())
   "List of login access check sockets (e.g. tcpwrap).")

  (verbose-proctitle?
   (boolean #f)
   "Show more verbose process titles (in ps).  Currently shows user name
and IP address.  Useful for seeing who are actually using the IMAP
processes (e.g. shared mailboxes or if same uid is used for multiple
accounts).")

  (shutdown-clients?
   (boolean #t)
   "Should all processes be killed when Dovecot master process shuts down.
Setting this to @code{#f} means that Dovecot can be upgraded without
forcing existing client connections to close (although that could also
be a problem if the upgrade is e.g. because of a security fix).")

  (doveadm-worker-count
   (non-negative-integer 0)
   "If non-zero, run mail commands via this many connections to doveadm
server, instead of running them directly in the same process.")

  (doveadm-socket-path
   (string "doveadm-server")
   "UNIX socket or host:port used for connecting to doveadm server.")

  (import-environment
   (space-separated-string-list '("TZ"))
   "List of environment variables that are preserved on Dovecot startup
and passed down to all of its child processes.  You can also give
key=value pairs to always set specific settings.")

;;; Authentication processes

  (disable-plaintext-auth?
   (boolean #t)
   "Disable LOGIN command and all other plaintext authentications unless
SSL/TLS is used (LOGINDISABLED capability).  Note that if the remote IP
matches the local IP (i.e. you're connecting from the same computer),
the connection is considered secure and plaintext authentication is
allowed.  See also ssl=required setting.")

  (auth-cache-size
   (non-negative-integer 0)
   "Authentication cache size (e.g. @samp{#e10e6}).  0 means it's disabled.
Note that bsdauth, PAM and vpopmail require @samp{cache-key} to be set
for caching to be used.")

  (auth-cache-ttl
   (string "1 hour")
   "Time to live for cached data.  After TTL expires the cached record
is no longer used, *except* if the main database lookup returns internal
failure.  We also try to handle password changes automatically: If
user's previous authentication was successful, but this one wasn't, the
cache isn't used.  For now this works only with plaintext
authentication.")

  (auth-cache-negative-ttl
   (string "1 hour")
   "TTL for negative hits (user not found, password mismatch).
0 disables caching them completely.")

  (auth-realms
   (space-separated-string-list '())
   "List of realms for SASL authentication mechanisms that need them.
You can leave it empty if you don't want to support multiple realms.
Many clients simply use the first one listed here, so keep the default
realm first.")

  (auth-default-realm
   (string "")
   "Default realm/domain to use if none was specified.  This is used for
both SASL realms and appending @@domain to username in plaintext
logins.")

  (auth-username-chars
   (string
    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890.-_@")
   "List of allowed characters in username.  If the user-given username
contains a character not listed in here, the login automatically fails.
This is just an extra check to make sure user can't exploit any
potential quote escaping vulnerabilities with SQL/LDAP databases.  If
you want to allow all characters, set this value to empty.")

  (auth-username-translation
   (string "")
   "Username character translations before it's looked up from
databases.  The value contains series of from -> to characters.  For
example @samp{#@@/@@} means that @samp{#} and @samp{/} characters are
translated to @samp{@@}.")

  (auth-username-format
   (string "%Lu")
   "Username formatting before it's looked up from databases.  You can
use the standard variables here, e.g. %Lu would lowercase the username,
%n would drop away the domain if it was given, or @samp{%n-AT-%d} would
change the @samp{@@} into @samp{-AT-}.  This translation is done after
@samp{auth-username-translation} changes.")

  (auth-master-user-separator
   (string "")
   "If you want to allow master users to log in by specifying the master
username within the normal username string (i.e. not using SASL
mechanism's support for it), you can specify the separator character
here.  The format is then <username><separator><master username>.
UW-IMAP uses @samp{*} as the separator, so that could be a good
choice.")

  (auth-anonymous-username
   (string "anonymous")
   "Username to use for users logging in with ANONYMOUS SASL
mechanism.")

  (auth-worker-max-count
   (non-negative-integer 30)
   "Maximum number of dovecot-auth worker processes.  They're used to
execute blocking passdb and userdb queries (e.g. MySQL and PAM).
They're automatically created and destroyed as needed.")

  (auth-gssapi-hostname
   (string "")
   "Host name to use in GSSAPI principal names.  The default is to use
the name returned by gethostname().  Use @samp{$ALL} (with quotes) to
allow all keytab entries.")

  (auth-krb5-keytab
   (string "")
   "Kerberos keytab to use for the GSSAPI mechanism.  Will use the
system default (usually /etc/krb5.keytab) if not specified.  You may
need to change the auth service to run as root to be able to read this
file.")

  (auth-use-winbind?
   (boolean #f)
   "Do NTLM and GSS-SPNEGO authentication using Samba's winbind daemon
and @samp{ntlm-auth} helper.
<doc/wiki/Authentication/Mechanisms/Winbind.txt>.")

  (auth-winbind-helper-path
   (file-name "/usr/bin/ntlm_auth")
   "Path for Samba's @samp{ntlm-auth} helper binary.")

  (auth-failure-delay
   (string "2 secs")
   "Time to delay before replying to failed authentications.")

  (auth-ssl-require-client-cert?
   (boolean #f)
   "Require a valid SSL client certificate or the authentication
fails.")

  (auth-ssl-username-from-cert?
   (boolean #f)
   "Take the username from client's SSL certificate, using
@code{X509_NAME_get_text_by_NID()} which returns the subject's DN's
CommonName.")

  (auth-mechanisms
   (space-separated-string-list '("plain"))
   "List of wanted authentication mechanisms.  Supported mechanisms are:
@samp{plain}, @samp{login}, @samp{digest-md5}, @samp{cram-md5},
@samp{ntlm}, @samp{rpa}, @samp{apop}, @samp{anonymous}, @samp{gssapi},
@samp{otp}, @samp{skey}, and @samp{gss-spnego}.  NOTE: See also
@samp{disable-plaintext-auth} setting.")

  (director-servers
   (space-separated-string-list '())
   "List of IPs or hostnames to all director servers, including ourself.
Ports can be specified as ip:port.  The default port is the same as what
director service's @samp{inet-listener} is using.")

  (director-mail-servers
   (space-separated-string-list '())
   "List of IPs or hostnames to all backend mail servers.  Ranges are
allowed too, like 10.0.0.10-10.0.0.30.")

  (director-user-expire
   (string "15 min")
   "How long to redirect users to a specific server after it no longer
has any connections.")

  (director-username-hash
   (string "%Lu")
   "How the username is translated before being hashed.  Useful values
include %Ln if user can log in with or without @@domain, %Ld if mailboxes
are shared within domain.")

;;; Log destination.

  (log-path
   (string "syslog")
   "Log file to use for error messages.  @samp{syslog} logs to syslog,
@samp{/dev/stderr} logs to stderr.")

  (info-log-path
   (string "")
   "Log file to use for informational messages.  Defaults to
@samp{log-path}.")

  (debug-log-path
   (string "")
   "Log file to use for debug messages.  Defaults to
@samp{info-log-path}.")

  (syslog-facility
   (string "mail")
   "Syslog facility to use if you're logging to syslog.  Usually if you
don't want to use @samp{mail}, you'll use local0..local7.  Also other
standard facilities are supported.")

  (auth-verbose?
   (boolean #f)
   "Log unsuccessful authentication attempts and the reasons why they
failed.")

  (auth-verbose-passwords
   (string "no")
   "In case of password mismatches, log the attempted password.  Valid
values are no, plain and sha1.  sha1 can be useful for detecting brute
force password attempts vs.  user simply trying the same password over
and over again.  You can also truncate the value to n chars by appending
\":n\" (e.g. sha1:6).")

  (auth-debug?
   (boolean #f)
   "Even more verbose logging for debugging purposes.  Shows for example
SQL queries.")

  (auth-debug-passwords?
   (boolean #f)
   "In case of password mismatches, log the passwords and used scheme so
the problem can be debugged.  Enabling this also enables
@samp{auth-debug}.")

  (mail-debug?
   (boolean #f)
   "Enable mail process debugging.  This can help you figure out why
Dovecot isn't finding your mails.")

  (verbose-ssl?
   (boolean #f)
   "Show protocol level SSL errors.")

  (log-timestamp
   (string "\"%b %d %H:%M:%S \"")
   "Prefix for each line written to log file.  % codes are in
strftime(3) format.")

  (login-log-format-elements
   (space-separated-string-list
    '("user=<%u>" "method=%m" "rip=%r" "lip=%l" "mpid=%e" "%c"))
   "List of elements we want to log.  The elements which have a
non-empty variable value are joined together to form a comma-separated
string.")

  (login-log-format
   (string "%$: %s")
   "Login log format.  %s contains @samp{login-log-format-elements}
string, %$ contains the data we want to log.")

  (mail-log-prefix
   (string "\"%s(%u)<%{pid}><%{session}>: \"")
   "Log prefix for mail processes.  See doc/wiki/Variables.txt for list
of possible variables you can use.")

  (deliver-log-format
   (string "msgid=%m: %$")
   "Format to use for logging mail deliveries.  You can use variables:
@table @code
@item %$
Delivery status message (e.g. @samp{saved to INBOX})
@item %m
Message-ID
@item %s
Subject
@item %f
From address
@item %p
Physical size
@item %w
Virtual size.
@end table")

;;; Mailbox locations and namespaces

  (mail-location
   (string "")
   "Location for users' mailboxes.  The default is empty, which means
that Dovecot tries to find the mailboxes automatically.  This won't work
if the user doesn't yet have any mail, so you should explicitly tell
Dovecot the full location.

If you're using mbox, giving a path to the INBOX
file (e.g. /var/mail/%u) isn't enough.  You'll also need to tell Dovecot
where the other mailboxes are kept.  This is called the \"root mail
directory\", and it must be the first path given in the
@samp{mail-location} setting.

There are a few special variables you can use, eg.:

@table @samp
@item %u
username
@item %n
user part in user@@domain, same as %u if there's no domain
@item %d
domain part in user@@domain, empty if there's no domain
@item %h
home director
@end table

See doc/wiki/Variables.txt for full list.  Some examples:
@table @samp
@item maildir:~/Maildir
@item mbox:~/mail:INBOX=/var/mail/%u
@item mbox:/var/mail/%d/%1n/%n:INDEX=/var/indexes/%d/%1n/%
@end table")

  (mail-uid
   (string "")
   "System user and group used to access mails.  If you use multiple,
userdb can override these by returning uid or gid fields.  You can use
either numbers or names.  <doc/wiki/UserIds.txt>.")

  (mail-gid
   (string "")
   "")

  (mail-privileged-group
   (string "")
   "Group to enable temporarily for privileged operations.  Currently
this is used only with INBOX when either its initial creation or
dotlocking fails.  Typically this is set to \"mail\" to give access to
/var/mail.")

  (mail-access-groups
   (string "")
   "Grant access to these supplementary groups for mail processes.
Typically these are used to set up access to shared mailboxes.  Note
that it may be dangerous to set these if users can create
symlinks (e.g. if \"mail\" group is set here, ln -s /var/mail ~/mail/var
could allow a user to delete others' mailboxes, or ln -s
/secret/shared/box ~/mail/mybox would allow reading it).")

  (mail-full-filesystem-access?
   (boolean #f)
   "Allow full file system access to clients.  There's no access checks
other than what the operating system does for the active UID/GID.  It
works with both maildir and mboxes, allowing you to prefix mailboxes
names with e.g. /path/ or ~user/.")

;;; Mail processes

  (mmap-disable?
   (boolean #f)
   "Don't use mmap() at all.  This is required if you store indexes to
shared file systems (NFS or clustered file system).")

  (dotlock-use-excl?
   (boolean #t)
   "Rely on @samp{O_EXCL} to work when creating dotlock files.  NFS
supports @samp{O_EXCL} since version 3, so this should be safe to use
nowadays by default.")

  (mail-fsync
   (string "optimized")
   "When to use fsync() or fdatasync() calls:
@table @code
@item optimized
Whenever necessary to avoid losing important data
@item always
Useful with e.g. NFS when write()s are delayed
@item never
Never use it (best performance, but crashes can lose data).
@end table")

  (mail-nfs-storage?
   (boolean #f)
   "Mail storage exists in NFS.  Set this to yes to make Dovecot flush
NFS caches whenever needed.  If you're using only a single mail server
this isn't needed.")

  (mail-nfs-index?
   (boolean #f)
   "Mail index files also exist in NFS.  Setting this to yes requires
@samp{mmap-disable? #t} and @samp{fsync-disable? #f}.")

  (lock-method
   (string "fcntl")
   "Locking method for index files.  Alternatives are fcntl, flock and
dotlock.  Dotlocking uses some tricks which may create more disk I/O
than other locking methods.  NFS users: flock doesn't work, remember to
change @samp{mmap-disable}.")

  (mail-temp-dir
   (file-name "/tmp")
   "Directory in which LDA/LMTP temporarily stores incoming mails >128
kB.")

  (first-valid-uid
   (non-negative-integer 500)
   "Valid UID range for users.  This is mostly to make sure that users can't
log in as daemons or other system users.  Note that denying root logins is
hardcoded to dovecot binary and can't be done even if @samp{first-valid-uid}
is set to 0.")

  (last-valid-uid
   (non-negative-integer 0)
   "")

  (first-valid-gid
   (non-negative-integer 1)
   "Valid GID range for users.  Users having non-valid GID as primary group ID
aren't allowed to log in.  If user belongs to supplementary groups with
non-valid GIDs, those groups are not set.")

  (last-valid-gid
   (non-negative-integer 0)
   "")

  (mail-max-keyword-length
   (non-negative-integer 50)
   "Maximum allowed length for mail keyword name.  It's only forced when
trying to create new keywords.")

  (valid-chroot-dirs
   (colon-separated-file-name-list '())
   "List of directories under which chrooting is allowed for mail
processes (i.e. /var/mail will allow chrooting to /var/mail/foo/bar
too).  This setting doesn't affect @samp{login-chroot}
@samp{mail-chroot} or auth chroot settings.  If this setting is empty,
\"/./\" in home dirs are ignored.  WARNING: Never add directories here
which local users can modify, that may lead to root exploit.  Usually
this should be done only if you don't allow shell access for users.
<doc/wiki/Chrooting.txt>.")

  (mail-chroot
   (string "")
   "Default chroot directory for mail processes.  This can be overridden
for specific users in user database by giving /./ in user's home
directory (e.g. /home/./user chroots into /home).  Note that usually
there is no real need to do chrooting, Dovecot doesn't allow users to
access files outside their mail directory anyway.  If your home
directories are prefixed with the chroot directory, append \"/.\" to
@samp{mail-chroot}.  <doc/wiki/Chrooting.txt>.")

  (auth-socket-path
   (file-name "/var/run/dovecot/auth-userdb")
   "UNIX socket path to master authentication server to find users.
This is used by imap (for shared users) and lda.")

  (mail-plugin-dir
   (file-name "/usr/lib/dovecot")
   "Directory where to look up mail plugins.")

  (mail-plugins
   (space-separated-string-list '())
   "List of plugins to load for all services.  Plugins specific to IMAP,
LDA, etc. are added to this list in their own .conf files.")


  (mail-cache-min-mail-count
   (non-negative-integer 0)
   "The minimum number of mails in a mailbox before updates are done to
cache file.  This allows optimizing Dovecot's behavior to do less disk
writes at the cost of more disk reads.")

  (mailbox-idle-check-interval
   (string "30 secs")
   "When IDLE command is running, mailbox is checked once in a while to
see if there are any new mails or other changes.  This setting defines
the minimum time to wait between those checks.  Dovecot can also use
dnotify, inotify and kqueue to find out immediately when changes
occur.")

  (mail-save-crlf?
   (boolean #f)
   "Save mails with CR+LF instead of plain LF.  This makes sending those
mails take less CPU, especially with sendfile() syscall with Linux and
FreeBSD.  But it also creates a bit more disk I/O which may just make it
slower.  Also note that if other software reads the mboxes/maildirs,
they may handle the extra CRs wrong and cause problems.")

  (maildir-stat-dirs?
   (boolean #f)
   "By default LIST command returns all entries in maildir beginning
with a dot.  Enabling this option makes Dovecot return only entries
which are directories.  This is done by stat()ing each entry, so it
causes more disk I/O.
 (For systems setting struct @samp{dirent->d_type} this check is free
and it's done always regardless of this setting).")

  (maildir-copy-with-hardlinks?
   (boolean #t)
   "When copying a message, do it with hard links whenever possible.
This makes the performance much better, and it's unlikely to have any
side effects.")

  (maildir-very-dirty-syncs?
   (boolean #f)
   "Assume Dovecot is the only MUA accessing Maildir: Scan cur/
directory only when its mtime changes unexpectedly or when we can't find
the mail otherwise.")

  (mbox-read-locks
   (space-separated-string-list '("fcntl"))
   "Which locking methods to use for locking mbox.  There are four
available:

@table @code
@item dotlock
Create <mailbox>.lock file.  This is the oldest and most NFS-safe
solution.  If you want to use /var/mail/ like directory, the users will
need write access to that directory.
@item dotlock-try
Same as dotlock, but if it fails because of permissions or because there
isn't enough disk space, just skip it.
@item fcntl
Use this if possible.  Works with NFS too if lockd is used.
@item flock
May not exist in all systems.  Doesn't work with NFS. 
@item lockf
May not exist in all systems.  Doesn't work with NFS.
@end table

You can use multiple locking methods; if you do the order they're declared
in is important to avoid deadlocks if other MTAs/MUAs are using multiple
locking methods as well.  Some operating systems don't allow using some of
them simultaneously.")

  (mbox-write-locks
   (space-separated-string-list '("dotlock" "fcntl"))
   "")

  (mbox-lock-timeout
   (string "5 mins")
   "Maximum time to wait for lock (all of them) before aborting.")

  (mbox-dotlock-change-timeout
   (string "2 mins")
   "If dotlock exists but the mailbox isn't modified in any way,
override the lock file after this much time.")

  (mbox-dirty-syncs?
   (boolean #t)
   "When mbox changes unexpectedly we have to fully read it to find out
what changed.  If the mbox is large this can take a long time.  Since
the change is usually just a newly appended mail, it'd be faster to
simply read the new mails.  If this setting is enabled, Dovecot does
this but still safely fallbacks to re-reading the whole mbox file
whenever something in mbox isn't how it's expected to be.  The only real
downside to this setting is that if some other MUA changes message
flags, Dovecot doesn't notice it immediately.  Note that a full sync is
done with SELECT, EXAMINE, EXPUNGE and CHECK commands.")

  (mbox-very-dirty-syncs?
   (boolean #f)
   "Like @samp{mbox-dirty-syncs}, but don't do full syncs even with SELECT,
EXAMINE, EXPUNGE or CHECK commands.  If this is set,
@samp{mbox-dirty-syncs} is ignored.")

  (mbox-lazy-writes?
   (boolean #t)
   "Delay writing mbox headers until doing a full write sync (EXPUNGE
and CHECK commands and when closing the mailbox).  This is especially
useful for POP3 where clients often delete all mails.  The downside is
that our changes aren't immediately visible to other MUAs.")

  (mbox-min-index-size
   (non-negative-integer 0)
   "If mbox size is smaller than this (e.g. 100k), don't write index
files.  If an index file already exists it's still read, just not
updated.")

  (mdbox-rotate-size
   (non-negative-integer #e10e6)
   "Maximum dbox file size until it's rotated.")

  (mdbox-rotate-interval
   (string "1d")
   "Maximum dbox file age until it's rotated.  Typically in days.  Day
begins from midnight, so 1d = today, 2d = yesterday, etc.  0 = check
disabled.")

  (mdbox-preallocate-space?
   (boolean #f)
   "When creating new mdbox files, immediately preallocate their size to
@samp{mdbox-rotate-size}.  This setting currently works only in Linux
with some file systems (ext4, xfs).")

  (mail-attribute-dict
   (string "")
   "The location of a dictionary used to store @code{IMAP METADATA}
as defined by @uref{https://tools.ietf.org/html/rfc5464, RFC@tie{}5464}.

The IMAP METADATA commands are available only if the ``imap''
protocol configuration's @code{imap-metadata?} field is @samp{#t}.")

  (mail-attachment-dir
   (string "")
   "sdbox and mdbox support saving mail attachments to external files,
which also allows single instance storage for them.  Other backends
don't support this for now.

WARNING: This feature hasn't been tested much yet.  Use at your own risk.

Directory root where to store mail attachments.  Disabled, if empty.")

  (mail-attachment-min-size
   (non-negative-integer #e128e3)
   "Attachments smaller than this aren't saved externally.  It's also
possible to write a plugin to disable saving specific attachments
externally.")

  (mail-attachment-fs
   (string "sis posix")
   "File system backend to use for saving attachments:
@table @code
@item posix
No SiS done by Dovecot (but this might help FS's own deduplication)
@item sis posix
SiS with immediate byte-by-byte comparison during saving
@item sis-queue posix
SiS with delayed comparison and deduplication.
@end table")

  (mail-attachment-hash
   (string "%{sha1}")
   "Hash format to use in attachment filenames.  You can add any text and
variables: @code{%@{md4@}}, @code{%@{md5@}}, @code{%@{sha1@}},
@code{%@{sha256@}}, @code{%@{sha512@}}, @code{%@{size@}}.  Variables can be
truncated, e.g. @code{%@{sha256:80@}} returns only first 80 bits.")

  (default-process-limit
    (non-negative-integer 100)
    "")

  (default-client-limit
    (non-negative-integer 1000)
    "")

  (default-vsz-limit
    (non-negative-integer #e256e6)
    "Default VSZ (virtual memory size) limit for service processes.
This is mainly intended to catch and kill processes that leak memory
before they eat up everything.")

  (default-login-user
    (string "dovenull")
    "Login user is internally used by login processes.  This is the most
untrusted user in Dovecot system.  It shouldn't have access to anything
at all.")

  (default-internal-user
    (string "dovecot")
    "Internal user is used by unprivileged processes.  It should be
separate from login user, so that login processes can't disturb other
processes.")

  (ssl?
   (string "required")
   "SSL/TLS support: yes, no, required.  <doc/wiki/SSL.txt>.")

  (ssl-cert
   (string "</etc/dovecot/default.pem")
   "PEM encoded X.509 SSL/TLS certificate (public key).")

  (ssl-key
   (string "</etc/dovecot/private/default.pem")
   "PEM encoded SSL/TLS private key.  The key is opened before
dropping root privileges, so keep the key file unreadable by anyone but
root.")

  (ssl-key-password
   (string "")
   "If key file is password protected, give the password here.
Alternatively give it when starting dovecot with -p parameter.  Since
this file is often world-readable, you may want to place this setting
instead to a different.")

  (ssl-ca
   (string "")
   "PEM encoded trusted certificate authority.  Set this only if you
intend to use @samp{ssl-verify-client-cert? #t}.  The file should
contain the CA certificate(s) followed by the matching
CRL(s).  (e.g. @samp{ssl-ca </etc/ssl/certs/ca.pem}).")
  (ssl-require-crl?
   (boolean #t)
   "Require that CRL check succeeds for client certificates.")
  (ssl-verify-client-cert?
   (boolean #f)
   "Request client to send a certificate.  If you also want to require
it, set @samp{auth-ssl-require-client-cert? #t} in auth section.")

  (ssl-cert-username-field
   (string "commonName")
   "Which field from certificate to use for username.  commonName and
x500UniqueIdentifier are the usual choices.  You'll also need to set
@samp{auth-ssl-username-from-cert? #t}.")

  (ssl-min-protocol
   (string "TLSv1")
   "Minimum SSL protocol version to accept.")

  (ssl-cipher-list
   (string "ALL:!kRSA:!SRP:!kDHd:!DSS:!aNULL:!eNULL:!EXPORT:!DES:!3DES:!MD5:!PSK:!RC4:!ADH:!LOW@STRENGTH")
   "SSL ciphers to use.")

  (ssl-crypto-device
   (string "")
   "SSL crypto device to use, for valid values run \"openssl engine\".")

  (postmaster-address
   (string "postmaster@%d")
   "Address to use when sending rejection mails.
Default is postmaster@@<your domain>.  %d expands to recipient domain.")

  (hostname
   (string "")
   "Hostname to use in various parts of sent mails (e.g. in Message-Id)
and in LMTP replies.  Default is the system's real hostname@@domain.")

  (quota-full-tempfail?
   (boolean #f)
   "If user is over quota, return with temporary failure instead of
bouncing the mail.")

  (sendmail-path
   (file-name "/usr/sbin/sendmail")
   "Binary to use for sending mails.")

  (submission-host
   (string "")
   "If non-empty, send mails via this SMTP host[:port] instead of
sendmail.")

  (rejection-subject
   (string "Rejected: %s")
   "Subject: header to use for rejection mails.  You can use the same
variables as for @samp{rejection-reason} below.")

  (rejection-reason
   (string "Your message to <%t> was automatically rejected:%n%r")
   "Human readable error message for rejection mails.  You can use
variables:

@table @code
@item %n
CRLF
@item %r
reason
@item %s
original subject
@item %t
recipient
@end table")

  (recipient-delimiter
   (string "+")
   "Delimiter character between local-part and detail in email
address.")

  (lda-original-recipient-header
   (string "")
   "Header where the original recipient address (SMTP's RCPT TO:
address) is taken from if not available elsewhere.  With dovecot-lda -a
parameter overrides this.  A commonly used header for this is
X-Original-To.")

  (lda-mailbox-autocreate?
   (boolean #f)
   "Should saving a mail to a nonexistent mailbox automatically create
it?.")

  (lda-mailbox-autosubscribe?
   (boolean #f)
   "Should automatically created mailboxes be also automatically
subscribed?.")


  (imap-max-line-length
   (non-negative-integer #e64e3)
   "Maximum IMAP command line length.  Some clients generate very long
command lines with huge mailboxes, so you may need to raise this if you
get \"Too long argument\" or \"IMAP command line too large\" errors
often.")

  (imap-logout-format
   (string "in=%i out=%o deleted=%{deleted} expunged=%{expunged} trashed=%{trashed} hdr_count=%{fetch_hdr_count} hdr_bytes=%{fetch_hdr_bytes} body_count=%{fetch_body_count} body_bytes=%{fetch_body_bytes}")
   "IMAP logout format string:
@table @code
@item %i
total number of bytes read from client
@item %o
total number of bytes sent to client.
@end table
See @file{doc/wiki/Variables.txt} for a list of all the variables you can use.")

  (imap-capability
   (string "")
   "Override the IMAP CAPABILITY response.  If the value begins with '+',
add the given capabilities on top of the defaults (e.g. +XFOO XBAR).")

  (imap-idle-notify-interval
   (string "2 mins")
   "How long to wait between \"OK Still here\" notifications when client
is IDLEing.")

  (imap-id-send
   (string "")
   "ID field names and values to send to clients.  Using * as the value
makes Dovecot use the default value.  The following fields have default
values currently: name, version, os, os-version, support-url,
support-email.")

  (imap-id-log
   (string "")
   "ID fields sent by client to log.  * means everything.")

  (imap-client-workarounds
   (space-separated-string-list '())
   "Workarounds for various client bugs:

@table @code
@item delay-newmail
Send EXISTS/RECENT new mail notifications only when replying to NOOP and
CHECK commands.  Some clients ignore them otherwise, for example OSX
Mail (<v2.1).  Outlook Express breaks more badly though, without this it
may show user \"Message no longer in server\" errors.  Note that OE6
still breaks even with this workaround if synchronization is set to
\"Headers Only\".

@item tb-extra-mailbox-sep
Thunderbird gets somehow confused with LAYOUT=fs (mbox and dbox) and
adds extra @samp{/} suffixes to mailbox names.  This option causes Dovecot to
ignore the extra @samp{/} instead of treating it as invalid mailbox name.

@item tb-lsub-flags
Show \\Noselect flags for LSUB replies with LAYOUT=fs (e.g. mbox).
This makes Thunderbird realize they aren't selectable and show them
greyed out, instead of only later giving \"not selectable\" popup error.
@end table
")

  (imap-urlauth-host
   (string "")
   "Host allowed in URLAUTH URLs sent by client.  \"*\" allows all.")

  (protocols
   (protocol-configuration-list
    (list (protocol-configuration
           (name "imap"))))
   "List of protocols we want to serve.  Available protocols include
@samp{imap}, @samp{pop3}, and @samp{lmtp}.")

  (services
   (service-configuration-list
    (list
     (service-configuration
      (kind "imap-login")
      (client-limit 0)
      (process-limit 0)
      (listeners
       (list
        (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f))
        (inet-listener-configuration (protocol "imaps") (port 993) (ssl? #t)))))
     (service-configuration
      (kind "pop3-login")
      (listeners
       (list
        (inet-listener-configuration (protocol "pop3") (port 110) (ssl? #f))
        (inet-listener-configuration (protocol "pop3s") (port 995) (ssl? #t)))))
     (service-configuration
      (kind "lmtp")
      (client-limit 1)
      (process-limit 0)
      (listeners
       (list (unix-listener-configuration (path "lmtp") (mode "0666")))))
     (service-configuration
      (kind "imap")
      (client-limit 1)
      (process-limit 1024))
     (service-configuration
      (kind "pop3")
      (client-limit 1)
      (process-limit 1024))
     (service-configuration
      (kind "auth")
      (service-count 0)
      (client-limit 0)
      (process-limit 1)
      (listeners
       (list (unix-listener-configuration (path "auth-userdb")))))
     (service-configuration
      (kind "auth-worker")
      (client-limit 1)
      (process-limit 0))
     (service-configuration
      (kind "dict")
      (client-limit 1)
      (process-limit 0)
      (listeners (list (unix-listener-configuration (path "dict")))))))
   "List of services to enable.  Available services include @samp{imap},
@samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and
@samp{lmtp}."))

(define-configuration opaque-dovecot-configuration
  (dovecot
   (file-like dovecot)
   "The dovecot package.")

  (string
   (string (configuration-missing-field 'opaque-dovecot-configuration
                                        'string))
   "The contents of the @code{dovecot.conf} to use."))

(define %dovecot-accounts
  ;; Account and group for the Dovecot daemon.
  (list (user-group (name "dovecot") (system? #t))
        (user-account
         (name "dovecot")
         (group "dovecot")
         (system? #t)
         (comment "Dovecot daemon user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))

        (user-group (name "dovenull") (system? #t))
        (user-account
         (name "dovenull")
         (group "dovenull")
         (system? #t)
         (comment "Dovecot daemon login user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define (%dovecot-activation config)
  ;; Activation gexp.
  (let ((config-str
         (cond
          ((opaque-dovecot-configuration? config)
           (opaque-dovecot-configuration-string config))
          (else
           (with-output-to-string
             (lambda ()
               (serialize-configuration config
                                        dovecot-configuration-fields)))))))
    #~(begin
        (use-modules (guix build utils))
        (define (mkdir-p/perms directory owner perms)
          (mkdir-p directory)
          (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner))
          (chmod directory perms))
        (define (build-subject parameters)
          (string-concatenate
           (map (lambda (pair)
                  (let ((k (car pair)) (v (cdr pair)))
                    (define (escape-char str chr)
                      (string-join (string-split str chr) (string #\\ chr)))
                    (string-append "/" k "="
                                   (escape-char (escape-char v #\=) #\/))))
                (filter (lambda (pair) (cdr pair)) parameters))))
        (define* (create-self-signed-certificate-if-absent
                  #:key private-key public-key (owner (getpwnam "root"))
                  (common-name (gethostname))
                  (organization-name "Guix")
                  (organization-unit-name "Default Self-Signed Certificate")
                  (subject-parameters `(("CN" . ,common-name)
                                        ("O" . ,organization-name)
                                        ("OU" . ,organization-unit-name)))
                  (subject (build-subject subject-parameters)))
          ;; Note that by default, OpenSSL outputs keys in PEM format.  This
          ;; is what we want.
          (unless (file-exists? private-key)
            (cond
             ((zero? (system* (string-append #$openssl "/bin/openssl")
                              "genrsa" "-out" private-key "2048"))
              (chown private-key (passwd:uid owner) (passwd:gid owner))
              (chmod private-key #o400))
             (else
              (format (current-error-port)
                      "Failed to create private key at ~a.\n" private-key))))
          (unless (file-exists? public-key)
            (cond
             ((zero? (system* (string-append #$openssl "/bin/openssl")
                              "req" "-new" "-x509" "-key" private-key
                              "-out" public-key "-days" "3650"
                              "-batch" "-subj" subject))
              (chown public-key (passwd:uid owner) (passwd:gid owner))
              (chmod public-key #o444))
             (else
              (format (current-error-port)
                      "Failed to create public key at ~a.\n" public-key)))))
        (let ((user (getpwnam "dovecot")))
          (mkdir-p/perms "/var/run/dovecot" user #o755)
          (mkdir-p/perms "/var/lib/dovecot" user #o755)
          (mkdir-p/perms "/etc/dovecot" user #o755)
          (copy-file #$(plain-file "dovecot.conf" config-str)
                     "/etc/dovecot/dovecot.conf")
          (mkdir-p/perms "/etc/dovecot/private" user #o700)
          (create-self-signed-certificate-if-absent
           #:private-key "/etc/dovecot/private/default.pem"
           #:public-key "/etc/dovecot/default.pem"
           #:owner (getpwnam "root")
           #:common-name (format #f "Dovecot service on ~a" (gethostname)))))))

(define (dovecot-shepherd-service config)
  "Return a list of <shepherd-service> for CONFIG."
  (let ((dovecot (if (opaque-dovecot-configuration? config)
                     (opaque-dovecot-configuration-dovecot config)
                     (dovecot-configuration-dovecot config))))
    (list (shepherd-service
           (documentation "Run the Dovecot POP3/IMAP mail server.")
           (provision '(dovecot))
           (requirement '(networking))
           (start #~(make-forkexec-constructor
                     (list (string-append #$dovecot "/sbin/dovecot")
                           "-F")))
           (stop #~(lambda _
                     (invoke #$(file-append dovecot "/sbin/dovecot")
                             "stop")
                     #f))))))

(define %dovecot-pam-services
  (list (unix-pam-service "dovecot")))

(define dovecot-service-type
  (service-type (name 'dovecot)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          dovecot-shepherd-service)
                       (service-extension account-service-type
                                          (const %dovecot-accounts))
                       (service-extension pam-root-service-type
                                          (const %dovecot-pam-services))
                       (service-extension activation-service-type
                                          %dovecot-activation)))
                (description "Run Dovecot, a mail server that can run POP3,
IMAP, and LMTP.")))

(define* (dovecot-service #:key (config (dovecot-configuration)))
  "Return a service that runs @command{dovecot}, a mail server that can run
POP3, IMAP, and LMTP.  @var{config} should be a configuration object created
by @code{dovecot-configuration}.  @var{config} may also be created by
@code{opaque-dovecot-configuration}, which allows specification of the
@code{dovecot.conf} as a string."
  (service dovecot-service-type config))

;; A little helper to make it easier to document all those fields.
(define (generate-dovecot-documentation)
  (generate-documentation
    `((dovecot-configuration
       ,dovecot-configuration-fields
       (dict dict-configuration)
       (namespaces namespace-configuration)
       (plugin plugin-configuration)
       (passdbs passdb-configuration)
       (userdbs userdb-configuration)
       (services service-configuration)
       (protocols protocol-configuration))
      (dict-configuration ,dict-configuration-fields)
      (plugin-configuration ,plugin-configuration-fields)
      (passdb-configuration ,passdb-configuration-fields)
      (userdb-configuration ,userdb-configuration-fields)
      (unix-listener-configuration ,unix-listener-configuration-fields)
      (fifo-listener-configuration ,fifo-listener-configuration-fields)
      (inet-listener-configuration ,inet-listener-configuration-fields)
      (namespace-configuration
       ,namespace-configuration-fields
       (mailboxes mailbox-configuration))
      (mailbox-configuration ,mailbox-configuration-fields)
      (service-configuration
       ,service-configuration-fields
       (listeners unix-listener-configuration fifo-listener-configuration
                  inet-listener-configuration))
      (protocol-configuration ,protocol-configuration-fields))
   'dovecot-configuration))

\f
;;;
;;; OpenSMTPD.
;;;

;; file-exists? is in the guile standard library.  BUT I errors if its arg
;; is a list.  eg:  (file-exists? (list "hello" "hello"))
;; TODO I need to find a way to remove this definition and rewrite my code.
(define (file-exists? file)
  (if (string? file)
      (access? file F_OK)
      #f))

;; some fieldnames have a default value of #f, which is ok.  They cannot have a value of #t.
;; for example opensmtpd-table-data can be #f, BUT NOT true.
;; my/sanitize procedure tests values to see if they are of the right kind.
;; procedure false? is needed to allow fields like 'values' to be blank, (empty), or #f BUT also
;; have a value like a list of strings.
(define (false? var)
  (eq? #f var))

;; this procedure takes in a var and a list of procedures.  It loops through list of procedures passing in var to each.
;; if one procedure returns #t, the function returns true.  Otherwise #f.
;; TODO for fun rewrite this using map
;; If I rewrote it in map, then it may help with sanitizing.
;; eg: I could then potentially easily sanitize vars with lambda procedures.
(define (is-value-right-type? var list-of-procedures record fieldname)
  (if (null? list-of-procedures)
      #f
      (if ((car list-of-procedures) var)
          #t
          (is-value-right-type? var (cdr list-of-procedures) record fieldname))))

;; converts strings like this:
;; "apple, ham, cherry" -> "apple, ham, or cherry"
;; "pineapple" -> "pinneapple".
;; "cheese, grapefruit, or jam" -> "cheese, grapefruit, or jam"
(define (add-comma-or string)
  (define last-comma-location (string-rindex string #\,))
  (if last-comma-location
      (if (string-contains string ", or" last-comma-location)
          string
          (string-replace string ", or" last-comma-location
                          (+ 1 last-comma-location)))
      string))

(define (list-of-procedures->string procedures)
  (define string
    (let loop ((procedures procedures))
      (if (null? procedures)
          ""
          (begin
            (string-append
             (cond ((eq? false? (car procedures))
                    "#f , ")
                   ((eq? boolean? (car procedures))
                    "boolean, ")
                   ((eq? string? (car procedures))
                    "string, ")
                   ((eq? integer? (car procedures))
                    "integer, ")
                   ((eq? list-of-strings? (car procedures))
                    "list of strings, ")
                   ((eq? assoc-list? (car procedures))
                    "an association list, ")
                   ((eq? opensmtpd-pki? (car procedures))
                    "an <opensmtpd-pki> record, ")
                   ((eq? opensmtpd-table? (car procedures))
                    "an <opensmtpd-table> record, ")
                   ((eq? list-of-unique-opensmtpd-match? (car procedures))
                    "a list of unique <opensmtpd-match> records, ")
                   ((eq? list-of-strings-or-gexps? (car procedures))
                    "a list of strings or gexps, ")
                   ((eq? table-whose-data-are-assoc-list? (car procedures))
                    (string-append
                     "an <opensmtpd-table> record whose fieldname 'data' are an assoc-list \n"
                     "(eg: (opensmtpd-table (name \"hostnames\") (data '((\"124.394.23.1\" . \"gnu.org\"))))), "))
                   ((eq? file-exists? (car procedures))
                    "file, ")
                   (else "has an incorrect value, "))
             (loop (cdr procedures)))))))
  (add-comma-or (string-append (string-drop-right string 2) ".\n")))

(define (string-in-list? string list)
  (member string list))

(define (list-of-strings-or-gexps? list)
  (and (list? list)
       (cond ((null? list)
              #t)
             ((or (string? (car list))
                  (gexp? (car list))
                  (local-file? (car list))
                  (file-append? (car list))
                  (plain-file? (car list))
                  (computed-file? (car list))
                  (program-file? (car list)))
              (list-of-strings-or-gexps? (cdr list)))
             (else #f))))

(define (my/sanitize var record fieldname list-of-procedures)
  (if (is-value-right-type? var list-of-procedures record fieldname)
      var
      (begin
        (display (string-append "<" record "> fieldname: '" fieldname "' is of type "
                                (list-of-procedures->string list-of-procedures) "\n"))
        (throw 'bad! var))))

;; Some example opensmtpd-tables:
;;
;;  (opensmtpd-table (name "root accounts") (data '(("joshua" . "root@dismail.de") ("joshua" . "postmaster@dismail.de"))))
;;  (opensmtpd-table (name "root accounts") (data (list "mysite.me" "your-site.com")))
;;  TODO should <opensmtpd-table> support have a fieldname 'file'?
;;  Or should I change name to name-or-file ?
(define-record-type* <opensmtpd-table>
  opensmtpd-table make-opensmtpd-table
  opensmtpd-table?
  this-record
  (name opensmtpd-table-name ;; string
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-table" "name" (list string?)))))
  (file-db opensmtpd-table-file-db
           (default #f)
           (sanitize (lambda (var)
                       (my/sanitize var "opensmtpd-table" "file-db"
                                    (list boolean?)))))
  ;; FIXME support an aliasing table as described here:
  ;; https://man.openbsd.org/table.5
  ;; One may have to use the record file for this.  I don't think tables support a table like this:
  ;; table "name" { joshua = joshua@gnucode.me,joshua@gnu-hurd.com,joshua@propernaming.org, root = root@gnucode.me }
  ;; If values is an absolute filename, then it will use said filename to house the table info.
  ;; filename must be an absolute filename.
  (data opensmtpd-table-data
          (default #f)
          (sanitize (lambda (var)
                      (my/sanitize var "opensmtpd-table" "values"
                                   (list list-of-strings? assoc-list? file-exists?)))))
  ;; is a list of values or key values
  ;; eg: (list "mysite.me" "your-site.com")
  ;; eg: (list ("joshua" . "joshua@gnu.org") ("james" . "james@gnu.org"))
  ;; I am currently making these values be as assocation list of strings only.
  ;; FIXME should I allow a var like this?
  ;; (list (cons "gnucode.me" 234.949.392.23))
  ;; can be of type: (quote list-of-strings) or (quote assoc-list)
  ;; (opensmtpd-table-type record) returns the values' type.  The user SHOULD NEVER set the type.
  ;; TODO jpoiret: on irc reccomends that I just use an outside function to determine fieldname 'values', type.
  ;; it would be "simpler" and possibly easier for the next person working on this code to understand what is happening.
  (type opensmtpd-table-type
        (default #f)
        (thunked)
        (sanitize (lambda (var)
                    (cond ((opensmtpd-table-data this-record)
                           (if (list-of-strings? (opensmtpd-table-data this-record))
                               (quote list-of-strings)
                               (quote assoc-list)))
                          ((file-exists? (opensmtpd-table-data this-record))
                           (if (opensmtpd-table-file-db this-record)
                               (quote db)
                               (quote file)))
                          (else
                           (display "opensmtpd-table-type is broke\n")
                           (throw 'bad! var)))))))

(define-record-type* <opensmtpd-ca>
  opensmtpd-ca make-opensmtpd-ca
  opensmtpd-ca?
  (name opensmtpd-ca-name
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-ca" "name" (list string?)))))
  (file opensmtpd-ca-file
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-ca" "file" (list file-exists?))))))

(define-record-type* <opensmtpd-pki>
  opensmtpd-pki make-opensmtpd-pki
  opensmtpd-pki?
  (domain opensmtpd-pki-domain
          (default #f)
          (sanitize (lambda (var)
                      (my/sanitize var "opensmtpd-pki" "domain" (list string?)))))
  ;; TODO/FIXME this should probably be a list of files.  The opensmtpd documentation says
  ;; that you could have a list of files:
  ;;
  ;; pki pkiname cert certfile
  ;; Associate certificate file certfile with host pkiname, and use that file to prove
  ;; the identity of the mail server to clients.  pkiname is the server's name, de‐
  ;; rived from the default hostname or set using either
  ;; /gnu/store/2d13sdz76ldq8zgwv4wif0zx7hkr3mh2-opensmtpd-6.8.0p2/etc/mailname or us‐
  ;; ing the hostname directive.  If a fallback certificate or SNI is wanted, the ‘*’
  ;; wildcard may be used as pkiname.

  ;; A certificate chain may be created by appending one or many certificates, includ‐
  ;; ing a Certificate Authority certificate, to certfile.  The creation of certifi‐
  ;; cates is documented in starttls(8).
  (cert opensmtpd-pki-cert
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-pki" "cert" (list file-exists?)))))
  (key opensmtpd-pki-key
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-pki" "key" (list file-exists?)))))
  ; todo sanitize this. valid parameters are "none", "legacy", or "auto".
  (dhe opensmtpd-pki-dhe
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-dhe" "dhe" (list false? string?))))))

(define-record-type* <opensmtpd-lmtp>
  opensmtpd-lmtp make-opensmtpd-lmtp
  opensmtpd-lmtp?
  (destination opensmtpd-lmtp-destination
               (default #f)
               (sanitize (lambda (var)
                           (my/sanitize var "opensmtpd-lmtp" "destination"
                                        (list string?)))))
  (rcpt-to opensmtpd-lmtp-rcpt-to
           (default #f)
           (sanitize (lambda (var)
                       (my/sanitize var "opensmtpd-lmtp" "rcpt-to"
                                    (list false? string?))))))

(define-record-type* <opensmtpd-mda>
  opensmtpd-mda make-opensmtpd-mda
  opensmtpd-mda?
  (name opensmtpd-mda-name
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-mda" "name"
                                 (list string?)))))
  ;; TODO should I allow this command to be a gexp?
  (command opensmtpd-mda-command
           (default #f)
           (sanitize (lambda (var)
                       (my/sanitize var "opensmtpd-mda" "command"
                                    (list string?))))))

(define-record-type* <opensmtpd-maildir>
  opensmtpd-maildir make-opensmtpd-maildir
  opensmtpd-maildir?
  (pathname opensmtpd-maildir-pathname
            (default #f)
            (sanitize (lambda (var)
                        (my/sanitize var "opensmtpd-maildir" "pathname"
                                     (list false? string?)))))
  (junk opensmtpd-maildir-junk
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-maildir" "junk"
                                 (list boolean?))))))

(define-record-type* <opensmtpd-local-delivery>
  opensmtpd-local-delivery make-opensmtpd-local-delivery
  opensmtpd-local-delivery?
  (name opensmtpd-local-delivery-name
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-local-delivery" "name"
                                 (list string?)))))
  (method opensmtpd-local-delivery-method
          (default "mbox")
          (sanitize (lambda (var)
                      (cond
                       ((or (opensmtpd-lmtp? var)
                            (opensmtpd-maildir? var)
                            (opensmtpd-mda? var)
                            (string=? var "mbox")
                            (string=? var "expand-only")
                            (string=? var "forward-only"))
                        var)
                       (else
                        (begin
                          (display (string-append "<opensmtpd-local-delivery> fieldname 'method' must be of type \n"
                                                  "\"mbox\", \"expand-only\", \"forward-only\" \n"
                                                  "<opensmtpd-lmtp>, <opensmtpd-maildir>, \n"
                                                  "or <opensmtpd-mda>.\n"))
                          (throw 'bad! var)))))))
  (alias opensmtpd-local-delivery-alias
         (default #f)
         (sanitize (lambda (var)
                     (my/sanitize var "opensmtpd-local-delivery" "alias"
                                  (list false? opensmtpd-table?)))))
  (ttl opensmtpd-local-delivery-ttl
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-local-delivery" "ttl"
                                (list false? string?)))))
  (user opensmtpd-local-delivery-user
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-local-delivery" "user"
                                 (list false? string?)))))
  (userbase opensmtpd-local-delivery-userbase
            (default #f)
            (sanitize (lambda (var)
                        (my/sanitize var "opensmtpd-local-delivery" "userbase"
                                     (list false? opensmtpd-table?)))))
  (virtual opensmtpd-local-delivery-virtual
           (default #f)
           (sanitize (lambda (var)
                       (my/sanitize var "opensmtpd-local-delivery" "virtual"
                                    (list false? opensmtpd-table?)))))
  (wrapper opensmtpd-local-delivery-wrapper
           (default #f)
           (sanitize (lambda (var)
                       (my/sanitize var "opensmtpd-local-delivery" "wrapper"
                                    (list false? string?))))))

;; FIXME/TODO this is a valid opensmtpd-relay record
;; (opensmtpd-relay
;;  (pki (opensmtpd-pki
;;        (domain "gnucode.me")
;;        (cert "opensmtpd.scm")
;;        (key "opensmtpd.scm"))))
;; BUT how does it relay the email?  What host does it use?
;; I think opensmtpd-relay-configuration needs "method" field.
;; the method field might need to be another record...BUT basically the relay has to have a 'backup', 'backup-mx',
;; or 'domain', or 'host' defined.
(define-record-type* <opensmtpd-relay>
  opensmtpd-relay make-opensmtpd-relay
  opensmtpd-relay?
  (name opensmtpd-relay-name
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-relay" "name"
                                 (list string?))))
        (default #f))
  (backup opensmtpd-relay-backup ;; boolean
          (default #f)
          (sanitize (lambda (var)
                      (my/sanitize var "opensmtpd-relay" "backup"
                                   (list boolean?)))))
  (backup-mx opensmtpd-relay-backup-mx ;; string mx name
             (default #f)
             (sanitize (lambda (var)
                         (my/sanitize var "opensmtpd-relay" "backup-mx"
                                      (list false? string?)))))
  (helo opensmtpd-relay-helo
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-relay" "helo"
                                 (list false? string? opensmtpd-table?))))
        (default #f))
  (helo-src opensmtpd-relay-helo-src
        (sanitize (lambda (var)
                      (my/sanitize var "opensmtpd-relay" "helo-src"
                                   (list false? string? opensmtpd-table?))))
        (default #f))
  (domain opensmtpd-relay-domain
          (sanitize (lambda (var)
                      (my/sanitize var "opensmtpd-relay" "domain"
                                   (list false? opensmtpd-table?))))
          (default #f))
  (host opensmtpd-relay-host
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-relay" "host"
                                 (list false? string?))))
        (default #f))
  (pki opensmtpd-relay-pki
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-relay" "pki"
                                (list false? opensmtpd-pki?)))))
  (srs opensmtpd-relay-srs
       (default #f)
       (lambda (var)
         (my/sanitize var "opensmtpd-relay" "srs"
                      (list boolean?))))
  (tls opensmtpd-relay-tls
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-relay" "tls"
                                (list false? string?)))))
  (auth opensmtpd-relay-auth
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-relay" "auth"
                                 (list false? opensmtpd-table?))))
        (default #f))
  (mail-from opensmtpd-relay-mail-from
             (default #f))
  ;; string "127.0.0.1" or "<interface>" or "<table of IP addresses>"
  ;; TODO should I do some sanitizing to make sure that the string? here is actually an IP address or a valid interface?
  (src opensmtpd-relay-src
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-relay" "src"
                                (list false? string? opensmtpd-table?))))
       (default #f)))

;; this record is used by <opensmtpd-filter-phase> &
;; <opensmtpd-match>
(define-record-type* <opensmtpd-option>
  opensmtpd-option make-opensmtpd-option
  opensmtpd-option?
  (option opensmtpd-option-option
          (default #f)
          (sanitize (lambda (var)
                      (if (and (string? var)
                               (or (string-in-list? var (list "fcrdns" "rdns"
                                                          "src" "helo"
                                                          "auth" "mail-from"
                                                          "rcpt-to"
                                                          "for"
                                                          "for any" "for local"
                                                          "for domain" "for rcpt-to"
                                                          "from any" "from auth"
                                                          "from local" "from mail-from"
                                                          "from rdns" "from socket"
                                                          "from src" "auth"
                                                          "helo" "mail-from"
                                                          "rcpt-to" "tag" "tls"))))
                                                          
                          var
                          (begin
                            (display (string-append "<opensmtpd-option> fieldname: 'option' is of type \n"
                                                    "string.  The string can be either 'fcrdns', \n"
                                                    " 'rdns', 'src', 'helo', 'auth', 'mail-from', or 'rcpt-to', \n"
                                                    "'for', 'for any', 'for local', 'for domain', 'for rcpt-to', \n"
                                                    "'from any', 'from auth', 'from local', 'from mail-from', 'from rdns', 'from socket', \n"
                                                    "'from src', 'auth helo', 'mail-from', 'rcpt-to', 'tag', or 'tls' \n"))
                                                    
                            (throw 'bad! var))))))
  (not opensmtpd-option-not
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-option" "not"
                                (list boolean?)))))
  (regex opensmtpd-option-regex
         (default #f)
         (sanitize (lambda (var)
                     (my/sanitize var "opensmtpd-option" "regex"
                                  (list boolean?)))))
  (data opensmtpd-option-data
         (default #f)
         (sanitize (lambda (var)
                     (my/sanitize var "opensmtpd-option" "data"
                                  (list false? string? opensmtpd-table?))))))

(define-record-type* <opensmtpd-filter-phase>
  opensmtpd-filter-phase make-opensmtpd-filter-phase
  opensmtpd-filter-phase?
  (name opensmtpd-filter-phase-name ;; string chain-name
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-filter-phase" "name"
                                 (list string?)))))
  (phase opensmtpd-filter-phase-phase ;; string
              (default #f)
              (sanitize (lambda (var)
                          (if (and (string? var)
                                   (string-in-list? var (list "connect"
                                                              "helo"
                                                              "mail-from"
                                                              "rcpt-to"
                                                              "data"
                                                              "commit")))
                              var
                              (begin
                                (display (string-append "<opensmtpd-filter-phase> fieldname: 'phase' is of type \n"
                                                        "string.  The string can be either 'connect',"
                                                        " 'helo', 'mail-from', 'rcpt-to', 'data', or 'commit.'\n "))

                                (throw 'bad! var))))))
  (options opensmtpd-filter-phase-options
           (default #f)
           (sanitize (lambda (var)
                       ;; returns #t if list is a unique list of <opensmtpd-option>
                       (define (list-of-opensmtpd-option? list)
                         (and (list-of-type? list opensmtpd-option?)
                              (not (contains-duplicate? list))))

                       (define (list-has-duplicates-or-non-opensmtpd-option list)
                         (not (list-of-opensmtpd-option? list)))

                       ;; input <opensmtpd-option>
                       ;; return #t if <opensmtpd-option> fieldname 'option'
                       ;; that needs a corresponding table has one.  Otherwise #f
                       (define (opensmtpd-option-has-table? record)
                         (define decision (opensmtpd-option-option record))
                         (and (string? decision)
                              ;; if option needs a table, check for a table
                              (if (string-in-list? decision (list "src"
                                                                  "helo"
                                                                  "mail-from"
                                                                  "rcpt-to"))
                                  (opensmtpd-table? (opensmtpd-option-data record))
                                  #t)))

                       (define (list-of-opensmtpd-option-has-table? list)
                         (list-of-type? list opensmtpd-option-has-table?))

                       (define (some-opensmtpd-option-in-list-lack-table? list)
                         (not (list-of-opensmtpd-option-has-table? list)))

                       (sanitize-options-for-filter-phase-configuration var)
                       )))
  (decision opensmtpd-filter-phase-decision
            (default #f)
            (sanitize (lambda (var)
                        (if (and (string? var)
                                 (string-in-list? var (list "bypass" "disconnect"
                                                            "reject" "rewrite" "junk")))
                            var
                            (begin
                              (display (string-append "<opensmtpd-filter-decision> fieldname: 'decision' is of type \n"
                                                      "string.  The string can be either 'bypass',"
                                                      " 'disconnect', 'reject', 'rewrite', or 'junk'.\n"))
                              (throw 'bad! var))))))
  (message opensmtpd-filter-phase-message
           (default #f)
           (sanitize (lambda (var)
                       (my/sanitize var "opensmtpd-filter-phase" "message"
                                    (list false? string?)))))
  (value opensmtpd-filter-phase-value
         (default #f)
         (sanitize (lambda (var)
                     (my/sanitize var "opensmtpd-filter-phase" "value"
                                  (list false? number?))))))

(define-record-type* <opensmtpd-filter>
  opensmtpd-filter make-opensmtpd-filter
  opensmtpd-filter?
  (name opensmtpd-filter-name
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-filter" "name"
                                 (list string?)))))
  (exec opensmtpd-filter-exec
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-filter" "exec"
                                 (list boolean?)))))
  (proc opensmtpd-filter-proc ; a string like "rspamd" or the command to start it like "/path/to/rspamd --option=arg --2nd-option=arg2"
             (default #f)
             (sanitize (lambda (var)
                         (my/sanitize var "opensmtpd-filter" "proc"
                                      (list string? list-of-strings-or-gexps?))))))

;; There is another type of filter that opensmtpd supports, which is a filter chain.
;; A filter chain is a list of <opensmtpd-filter-phase> and <opensmtpd-filter>.
;; This lets you apply several filters under one filter name.  I could have defined
;; a record type for it, but the record would only have had two fields: name and list-of-filters.
;; Why write that as a record?  That's too simple.
;; returns #t if list is a unique list of <opensmtpd-filter> or <opensmtpd-filter-phase>
;; returns # otherwise
(define (opensmtpd-filter-chain? %filters)
  (and (list-of-unique-filter-or-filter-phase? %filters)
       (< 1 (length %filters))))

(define-record-type* <opensmtpd-interface>
  opensmtpd-interface make-opensmtpd-interface
  opensmtpd-interface?
  ;; interface may be an IP address, interface group, or domain name
  (interface opensmtpd-interface-interface
             (default "lo"))
  (family opensmtpd-interface-family
          (default #f)
          (sanitize (lambda (var)
                      (cond
                       ((eq? #f var) ;; var == #f
                        var)
                       ((and (string? var)
                             (string-in-list? var (list "inet4" "inet6")))
                        var)
                       (else
                        (begin
                          (display "<opensmtpd-interface> fieldname 'family' must be string \"inet4\" or \"inet6\".\n")
                          (throw 'bad! var)))))))
  (auth opensmtpd-interface-auth
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-interface" "auth"
                                 (list boolean? table-whose-data-are-assoc-list?)))))
  (auth-optional opensmtpd-interface-auth-optional
                 (default #f)
                 (sanitize (lambda (var)
                             (my/sanitize var "opensmtpd-interface" "auth-optional"
                                          (list boolean?
                                                table-whose-data-are-assoc-list?)))))
  ;; TODO add a ca entry?
  ;; string FIXME/TODO sanitize this to support a gexp.  That way way the
  ;; includes directive can include my hacky scheme code that I use for opensmtpd-dkimsign.
  (filters opensmtpd-interface-filters
           (default #f)
           (sanitize (lambda (var)
                       (sanitize-filter-phases var))))
  (hostname opensmtpd-interface-hostname
            (default #f)
            (sanitize (lambda (var)
                        (my/sanitize var "opensmtpd-interface" "hostname"
                                     (list false? string?)))))
  (hostnames opensmtpd-interface-hostnames
             (default #f)
             (sanitize (lambda (var)
                         (my/sanitize var "opensmtpd-interface" "hostnames"
                                      (list false? table-whose-data-are-assoc-list?)))))
  (mask-src opensmtpd-interface-mask-src
            (default #f)
            (sanitize (lambda (var)
                        (my/sanitize var "opensmtpd-interface" "mask-src"
                                     (list boolean?)))))
  (disable-dsn opensmtpd-interface-disable-dsn
          (default #f))
  (pki opensmtpd-interface-pki
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-interface" "pki"
                                (list false? opensmtpd-pki?)))))
  (port opensmtpd-interface-port
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-interface" "port"
                                 (list false? integer?)))))
  (proxy-v2 opensmtpd-interface-proxy-k2
            (default #f))
  (received-auth opensmtpd-interface-received-auth
                 (default #f))
  ;; TODO add in a senders option!
  ;; string or <opensmtpd-senders> record
  ;; (senders opensmtpd-interface-senders
  ;;          (sanitize (lambda (var)
  ;;                      (my/sanitize var "opensmtpd-interface" "port" (list false? integer?))))
  ;;          (default #f))
  (secure-connection opensmtpd-interface-secure-connection
                     (default #f)
                     (sanitize (lambda (var)
                                 (cond ((boolean? var)
                                        var)
                                       ((and (string? var)
                                             (string-in-list? var
                                                              (list "smtps" "tls"
                                                                    "tls-require"
                                                                    "tls-require-verify")))
                                        var)
                                       (else
                                        (begin
                                          (display (string-append "<opensmtd-listen-on> fieldname 'secure-connection' can be \n"
                                                                  "one of the following strings: \n'smtps', 'tls', 'tls-require', \n"
                                                                  "or 'tls-require-verify'.\n"))
                                          (throw 'bad! var)))))))
  (tag opensmtpd-interface-tag
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-interface" "tag"
                                (list false? string?))))
       (default #f)))

(define-record-type* <opensmtpd-socket-configuration>
  opensmtpd-socket-configuration make-opensmtpd-socket-configuration
  opensmtpd-socket-configuration?
  ;; false or <opensmtpd-filter> or list of <opensmtpd-filter>
  (filters opensmtpd-socket-configuration-filters
           (sanitize (lambda (var)
                       (sanitize-filter-phases var)))
          (default #f))
  (mask-src opensmtpd-socket-configuration-mask-src
            (default #f))
  (tag opensmtpd-socket-configuration-tag
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-interface" "tag"
                                (list false? string?))))
       (default #f)))


(define-record-type* <opensmtpd-match>
  opensmtpd-match make-opensmtpd-match
  opensmtpd-match?
  ;;TODO? Perhaps I should add in a reject fieldname.  If reject
  ;;is #t, then the match record will be a reject match record.
  ;; (opensmtpd-match (reject #t)) vs. (opensmtpd-match (action 'reject))
  ;; To do this, I will also have to  'reject' mutually exclusive. AND an match with 'reject' can have no action defined.
  (action opensmtpd-match-action
          (default #f)
          (sanitize (lambda (var)
                      (if (or (opensmtpd-relay? var)
                              (opensmtpd-local-delivery? var)
                              (eq? (quote reject) var))
                          var
                          (begin
                            (display
                             (string-append "<opensmtpd-match> fieldname 'action' is of type <opensmtpd-relay>, \n"
                                            "<opensmtpd-local-delivery>, or (quote reject).\n"
                                            "If its var is (quote reject), then the match rejects the incoming message\n"
                                            "during the SMTP dialogue.\n"))
                            (throw 'bad! var))))))
  (options opensmtpd-match-options
           (default #f)
           (sanitize (lambda (var)
                       (cond ((not var)
                              #f)
                             ((not (list-of-unique-opensmtpd-option? var))
                              (throw-error var '("<opensmtpd-match> fieldname 'options' is a list of unique \n"
                                                 "<opensmtpd-option> records. \n")))
                           (else (sanitize-list-of-options-for-match-configuration var)))))))

(define-record-type* <opensmtpd-smtp>
  opensmtpd-smtp make-opensmtpd-smtp
  opensmtpd-smtp?
  (ciphers opensmtpd-smtp-ciphers
           (default #f)
           (sanitize (lambda (var)
                       (my/sanitize var "opensmtpd-smtp" "ciphers"
                                    (list false? string?)))))
  (limit-max-mails opensmtpd-smtp-limit-max-mails
                   (default #f)
                   (sanitize (lambda (var)
                               (my/sanitize var "opensmtpd-smtp" "limit-max-mails"
                                            (list false? integer?)))))
  (limit-max-rcpt opensmtpd-smtp-limit-max-rcpt
                  (default #f)
                  (sanitize (lambda (var)
                              (my/sanitize var "opensmtpd-smtp" "limit-max-rcpt"
                                           (list false? integer?)))))
  (max-message-size opensmtpd-smtp-max-message-size
                    (default #f)
                    (sanitize (lambda (var)
                                (my/sanitize var "opensmtpd-smtp" "max-message-size"
                                             (list false? integer? string?)))))
  ;; FIXME/TODO the sanitize function of sub-addr-delim should accept a string of length one not string?
  (sub-addr-delim opensmtpd-smtp-sub-addr-delim
                  (default #f)
                  (sanitize (lambda (var)
                              (my/sanitize var "opensmtpd-smtp" "sub-addr-delim"
                                           (list false? integer? string?))))))

(define-record-type* <opensmtpd-srs>
  opensmtpd-srs make-opensmtpd-srs
  opensmtpd-srs?
  ;; TODO should this be a file?
  (key opensmtpd-srs-key
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-srs" "key"
                                (list false? boolean? string?)))))
  ;; TODO should this also be a file?
  (backup-key opensmtpd-srs-backup-key
              (default #f)
              (sanitize (lambda (var)
                          (my/sanitize var "opensmtpd-srs" "backup-key"
                                       (list false? integer?)))))
  (ttl-delay opensmtpd-srs-ttl-delay
             (default #f)
             (sanitize (lambda (var)
                         (my/sanitize var "opensmtpd-srs" "ttl-delay"
                                      (list false? string?))))))

(define-record-type* <opensmtpd-queue>
  opensmtpd-queue make-opensmtpd-queue
  opensmtpd-queue?
  (compression opensmtpd-queue-compression
               (default #f)
               (sanitize (lambda (var)
                           (my/sanitize var "opensmtpd-queue" "compression"
                                        (list boolean?)))))
  (encryption opensmtpd-queue-encryption
              (default #f)
              (sanitize (lambda (var)
                          (my/sanitize var "opensmtpd-queue" "encryption"
                                       (list boolean? string? file-exists?)))))
  (ttl-delay opensmtpd-queue-ttl-delay
             (default #f)
             (sanitize (lambda (var)
                         (my/sanitize var "opensmtpd-queue" "ttl-delay"
                                      (list false? string?))))))

(define-record-type* <opensmtpd-configuration>
  opensmtpd-configuration make-opensmtpd-configuration
  opensmtpd-configuration?
  (package opensmtpd-configuration-package
           (default opensmtpd))
  (config-file opensmtpd-configuration-config-file
               (default #f))
  ;; FIXME/TODO should I include a admd authservid entry?

  ;; TODO sanitize this properly with perhaps a <sanitize-configuration>.
  (bounce opensmtpd-configuration-bounce
          (default #f)
          (sanitize (lambda (var)
                      (my/sanitize var "opensmtpd-configuration" "bounce"
                                   (list false? list?)))))
  (cas opensmtpd-configuration-cas
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-configuration" "cas"
                                (list false? list-of-opensmtpd-ca?)))))
  ;; list of many records of type opensmtpd-interface
  (listen-ons opensmtpd-configuration-listen-ons
              (default (list (opensmtpd-interface)))
              (sanitize (lambda (var)
                          (if (list-of-opensmtpd-interface? var)
                              var
                              (begin
                                (display "<opensmtpd-configuration> fieldname 'listen-ons' expects a list of records ")
                                (display "of one or more unique <opensmtpd-interface> records.\n")
                                (throw 'bad! var))))))
  ;; accepts type <opensmtpd-socket-configuration>
  (listen-on-socket opensmtpd-configuration-listen-on-socket
                    (default (opensmtpd-socket-configuration)))
  (includes opensmtpd-configuration-includes ;; list of strings of absolute path names
            (default #f)
            (sanitize (lambda (var)
                        (my/sanitize var "opensmtpd-configuration" "includes"
                                     (list false? list-of-strings? gexp?)))))
  (matches opensmtpd-configuration-matches
           (default (list (opensmtpd-match
                           (action (opensmtpd-local-delivery
                                    (name "local")
                                    (method "mbox")))
                           (options (list
                                     (opensmtpd-option
                                      (option "for local")))))
                          (opensmtpd-match
                           (action (opensmtpd-relay
                                    (name "outbound")))
                           (options (list
                                     (opensmtpd-option
                                      (option "from local"))
                                     (opensmtpd-option
                                      (option "for any")))))))
           ;; TODO perhaps I should sanitize this function like I sanitized the 'filters'.
           ;; I definitely should sanitize this function a bit more.  For example, you could have two different
           ;; actions, one for local delivery and one for remote, with the same name.  I should make sure that
           ;; I have no two different actions with the same name.
           (sanitize (lambda (var)
                       ;; Should we do more sanitizing here?  eg: "from socket" should NOT have a table or value
                       var
                       (my/sanitize var "opensmtpd-configuration" "matches"
                                    (list list-of-unique-opensmtpd-match?)))))
  ;; list of many records of type mda-wrapper
  ;; TODO/FIXME support using gexps here
  ;; eg (list "name" gexp)
  (mda-wrappers opensmtpd-configuration-mda-wrappers
                (default #f)
                (sanitize (lambda (var)
                            (my/sanitize var
                                         "opensmtpd-configuration"
                                         "mda-wrappers"
                                         (list false? string?)))))
  (mta-max-deferred opensmtpd-configuration-mta-max-deferred
                    (default 100)
                    (sanitize (lambda (var)
                                (my/sanitize var "opensmtpd-configuration" "mta-max-deferred"
                                             (list number?)))))

  ;; TODO should I add a fieldname proc _proc-name_ _command_ as found in the man 5 smtpd.conf ?

  (queue opensmtpd-configuration-queue
         (default #f)
         (sanitize (lambda (var)
                     (my/sanitize var "opensmtpd-configuration" "queue"
                                  (list false? opensmtpd-queue?)))))
  (smtp opensmtpd-configuration-smtp
        (default #f)
        (sanitize (lambda (var)
                    (my/sanitize var "opensmtpd-configuration" "smtp"
                                 (list false? opensmtpd-smtp?)))))
  (srs opensmtpd-configuration-srs
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-configuration" "srs"
                                (list false? opensmtpd-srs?)))))
  (setgid-commands? opensmtpd-setgid-commands? (default #t)))

;; this help procedure is used 3 or 4 times by sanitize-list-of-options-for-match-configuration
(define* (throw-error-duplicate-option option error-arg #:key (record-name "match"))
  (throw-error error-arg
               (list (string-append "<opensmtpd-" record-name ">'s fieldname 'options' has two\n")
                     (string-append "<opensmtpd-option> records with fieldname 'option' with value '" option "'. \n")
                     (string-append "You can only have one option with value '" option "' in the options list.\n"))))

;; this procedure sanitizes the fieldname opensmtpd-match-options
(define* (sanitize-list-of-options-for-match-configuration %options)
  (let loop ((%traversing-options %options)
             ;; sanitized-options is an alist that may end of looking like:
             ;; (("for" (opensmtpd-option (option "for any")))
             ;;  ("from" (opensmtpd-option (option "from any"))))
             (%sanitized-options '()))
    (if (null? %traversing-options)
        (remove false?
                (list
                 (assoc-ref %sanitized-options "for")
                 (assoc-ref %sanitized-options "from")
                 (assoc-ref %sanitized-options "auth")
                 (assoc-ref %sanitized-options "helo")
                 (assoc-ref %sanitized-options "mail-from")
                 (assoc-ref %sanitized-options "rcpt-to")
                 (assoc-ref %sanitized-options "tag")
                 (assoc-ref %sanitized-options "tls")))
        (let* ((option-record (car %traversing-options))
               (option-string (opensmtpd-option-option option-record)))
          (cond ((string=? "auth" option-string)
                 (if (assoc-ref %sanitized-options "auth")
                     (throw-error-duplicate-option "auth" %traversing-options)
                     (loop (cdr %traversing-options) (alist-cons "auth" option-record %sanitized-options))))
                ((string=? "helo" option-string)
                 (cond [(assoc-ref %sanitized-options "helo")
                        (throw-error-duplicate-option "helo" %traversing-options)]
                       [(not (opensmtpd-option-data option-record))
                        (throw-error option-record
                                     (list "<opensmtpd-option> with fieldname 'option' with value 'helo' \n"
                                           "must have a 'data' of type string or <opensmtpd-table>.\n"))]
                       [else (loop (cdr %traversing-options) (alist-cons "helo" option-record %sanitized-options))]))
                ((string=? "mail-from" option-string)
                 (cond ((assoc-ref %sanitized-options "mail-from")
                        (throw-error-duplicate-option "mail-from" %traversing-options))
                       ((not (opensmtpd-option-data option-record))
                        (throw-error option-record
                                     (list "<opensmtpd-option> with fieldname 'option' with value 'mail-from' \n"
                                           "must have a 'data' of type string or <opensmtpd-table>.\n")))
                       (else (loop (cdr %traversing-options) (alist-cons "mail-from" option-record %sanitized-options)))))
                ((string=? "rcpt-to" option-string)
                 (cond [(assoc-ref %sanitized-options "rcpt-to")
                        (throw-error-duplicate-option "rcpt-to" %traversing-options)]
                       [(not (opensmtpd-option-data option-record))
                        (throw-error option-record
                                     (list "<opensmtpd-option> with fieldname 'option' with value 'rcpt-to' \n"
                                           "must have a 'data' of type string or <opensmtpd-table>.\n"))]
                       [else (loop (cdr %traversing-options) (alist-cons "rcpt-to" option-record %sanitized-options))]))
                ((string=? "tag" option-string)
                 (cond ((assoc-ref %sanitized-options "tag")
                        (throw-error-duplicate-option "tag" %traversing-options))
                       ((not (string? (opensmtpd-option-data option-record)))
                        (throw-error option-record
                                     (list "<opensmtpd-option> with fieldname 'option' with value 'tag' \n"
                                           "must have a 'data' of type string.\n")))
                       (else (loop (cdr %traversing-options) (alist-cons "tag" option-record %sanitized-options)))))
                ((string=? "tls" option-string)
                 (cond [(assoc-ref %sanitized-options "tls")
                        (throw-error-duplicate-option "tls" %traversing-options)]
                       [(or (opensmtpd-option-data option-record)
                            (opensmtpd-option-regex option-record))
                        (throw-error option-record
                                     (list "<opensmtpd-option> with fieldname 'option' with value 'tls', then \n"
                                           "fieldname 'data' cannot be defined.\n"))]
                       [else (loop (cdr %traversing-options) (alist-cons "tls" option-record %sanitized-options))]))
                ((string=? "for" (substring option-string 0 3))
                 (cond ((assoc-ref %sanitized-options "for")
                        (throw-error %options
                                     `("<opensmtpd-match>'s fieldname 'options' can only have one 'for' option. \n"
                                       "But '" ,option-string "' and '"
                                       ,(opensmtpd-option-option (assoc-ref %sanitized-options "for")) "' are present.\n")))
                       ((and (string-in-list? option-string (list "for any" "for local")) ; for any cannot have a data field.
                             (or (opensmtpd-option-data option-record)
                                 (opensmtpd-option-regex option-record)))
                        (throw-error option-record
                                     (list "When <openmstpd-option-configuration>'s fieldname 'options' value is 'for any' \n"
                                           "or 'for local', then its 'data' and 'regex' field must be #f. \n")))
                       ((and (string-in-list? option-string (list "for domain" "for rcpt-to")) ; for domain must have a data field.
                             (not (opensmtpd-option-data option-record)))
                        (throw-error option-record
                                     (list "When <openmstpd-option-configuration>'s fieldname 'options' value is 'for domain' \n"
                                           "or 'for rcpt-to', then its 'data' field must be a string or an \n"
                                           "<opensmtpd-table> record.\n")))
                       (else (loop (cdr %traversing-options) (alist-cons "for" option-record %sanitized-options)))))
                ((string=? "from" (substring option-string 0 4))
                 (cond ((assoc-ref %sanitized-options "from")
                        (throw-error %options
                                     `("<opensmtpd-match>'s fieldname 'options' can only have one 'from' option. \n"
                                       "But '" ,option-string "' and '"
                                       ,(opensmtpd-option-option (assoc-ref %sanitized-options "from")) "' are present.\n")))
                       ((and (string-in-list? option-string (list "from any" "from local" "from socket")) ; for any cannot have a data field.
                             (or (opensmtpd-option-data option-record)
                                 (opensmtpd-option-regex option-record)))
                        (throw-error option-record
                                     (list "When <openmstpd-option-configuration>'s fieldname 'options' value is 'from any', \n"
                                           " 'from local', or 'from socket', then its 'data' and 'regex' field must be #f. \n")))
                       ((and (string-in-list? option-string (list "from mail-from" "from src")) ; for domain must have a data field.
                             (not (opensmtpd-option-data option-record)))
                        (throw-error option-record
                                     (list "When <openmstpd-option-configuration>'s fieldname 'options' value is 'from mail-from' \n"
                                           "or 'from src', then its 'data' field must be a string or an \n"
                                           "<opensmtpd-table> record.\n")))
                       (else (loop (cdr %traversing-options) (alist-cons "from" option-record %sanitized-options))))))))))

;; if the list of filters in opensmtpd-interface-filters
;; and in opensmtpd-socket-configuration-filters has two
;; filters with the same name, this will return #t
;; otherwise false
(define (duplicate-filter-name? %filters)
  (contains-duplicate?
   (let loop ((%filters %filters))
     (if (null? %filters)
         '()
         (cond
          ((opensmtpd-filter-phase? (car %filters))
           (cons (opensmtpd-filter-phase-name (car %filters))
                 (loop (cdr %filters))))
          (else
           (cons (opensmtpd-filter-name (car %filters))
                 (loop (cdr %filters)))))))))

(define (list-has-duplicates-or-non-filters? list)
  (not (list-of-unique-filter-or-filter-phase? list)))

(define (filter-phase-has-message-and-value? record)
  (and (opensmtpd-filter-phase-message record)
       (opensmtpd-filter-phase-value record)))

;; return #t if phase needs a message. Or if the message did not start with a 4xx or 5xx status code.
;; otherwise #f
(define (filter-phase-decision-lacks-proper-message? record)
  (define decision (opensmtpd-filter-phase-decision record))
  (if (string-in-list? decision (list "disconnect" "reject"))
      ;; this message needs to be RFC compliant, meaning
      ;; that it need to start with 4xx or 5xx status code
      (cond ((eq? #f (opensmtpd-filter-phase-message record))
             #t)
            ((string? (opensmtpd-filter-phase-message record))
             (let ((number (string->number
                            (substring
                             (opensmtpd-filter-phase-message record) 0 3))))
               (if (and (number? number)
                        (and (< number 600) (> number 399)))
                   #f
                   #t))))
      #f))

;; 'decision' "rewrite" requires 'value' to be a number.
(define (filter-phase-lacks-proper-value? record)
  (define decision (opensmtpd-filter-phase-decision record))
  (if (string=? "rewrite" decision)
      (if (and (number? (opensmtpd-filter-phase-value record))
               (eq? #f (opensmtpd-filter-phase-message record)))
          #f
          #t)
      #f))

;; 'decision' "junk" or "bypass" cannot have a message or a value.
(define (filter-phase-has-incorrect-junk-or-bypass? record)
  (and
   (string-in-list?
    (opensmtpd-filter-phase-decision record)
    (list "junk" "bypass"))
   (or
    (opensmtpd-filter-phase-value record)
    (opensmtpd-filter-phase-message record))))

(define (filter-phase-junks-after-commit? record)
  (and (string=? (opensmtpd-filter-phase-decision record) "junk")
       (string=? (opensmtpd-filter-phase-phase record) "commit")))

;; returns #t if list is a unique list of <opensmtpd-filter> or <opensmtpd-filter-phase>
;; returns # otherwise
(define (list-of-unique-filter-or-filter-phase? %filters)
  (and (list? %filters)
       (not (null? %filters))
       ;; this list is made up of only <opensmtpd-filter-phase> or <opensmtpd-filter>
       (primitive-eval
        (cons 'and (map (lambda (filter)
                          (or (opensmtpd-filter? filter)
                              (opensmtpd-filter-phase? filter)))
                        %filters)))
       (not (contains-duplicate? %filters))))

;; the sanitize procedures used for sanitizing <opensmtpd-interface> and
;; <opensmtpd-socket-configuration> fieldname 'filters'.
;; It primarily sanitizes <filter-phases>.  The only sanitization it does
;; for <filter>s, is no make sure there are no duplicate filter names.
(define (sanitize-filter-phases %list)
  ;; the order of the first two tests in this cond is important.
  ;; (false?) has to be 1st and (list-has-duplicates-or-non-filters?) has to be second.
  ;; You may optionally re-order the other alternates in the cond.
  (cond ((false? %list)
         #f)
        ((list-has-duplicates-or-non-filters? %list)
         (begin
           (display (string-append "<opensmtpd-interface> fieldname: 'filters' is a list, in which each unique element \n"
                                   "is of type <opensmtpd-filter> or <opensmtpd-filter-phase>.\n"))
           (throw 'bad! %list)))
        ((duplicate-filter-name? %list)
         (throw-error %list (list "has a duplicate filter name.\n")
                      #:record-name "interface"
                      #:fieldname "filters"))
        (else
         (let loop ([%traversing-list %list]
                    [%original-list %list])
           (if (null? %traversing-list)
               %original-list
               (cond [(opensmtpd-filter? (car %traversing-list))
                      (loop (cdr %traversing-list) %original-list)]
                     [(filter-phase-has-message-and-value? (car %traversing-list))
                      (begin
                        (display (string-append "<opensmtpd-filter-phase> cannot have defined fieldnames 'value' \n"
                                                "and 'message'.\n"))
                        (throw 'bad! (car %traversing-list)))]
                     [(filter-phase-decision-lacks-proper-message? (car %traversing-list))
                      (begin
                        (display (string-append "<opensmtpd-filter-phase> fieldname: 'decision' options \n"
                                                "\"disconnect\" and \"reject\" require fieldname 'message' to have an RFC \n"
                                                "compliant string, which means that the string must begin with a 4xx or 5xx status code.\n"))
                        (throw 'bad! (car %traversing-list)))]
                     [(filter-phase-lacks-proper-value? (car %traversing-list))
                      (begin
                        (display (string-append "<opensmtpd-filter-phase> fieldname: 'decision' option \n"
                                                "\"rewrite\" requires fieldname 'value' to have a number.\n"))
                        (throw 'bad! (car %traversing-list)))]
                     [(filter-phase-has-incorrect-junk-or-bypass? (car %traversing-list))
                      (begin
                        (display (string-append "<opensmtpd-filter-phase> fieldname 'decision' option \n"
                                                "\"junk\" or 'bypass' cannot have a defined fieldnames 'message' or 'value'.\n"))
                        (throw 'bad! (car %traversing-list)))]
                     [(filter-phase-junks-after-commit? (car %traversing-list))
                      (begin
                        (display (string-append "<opensmtpd-filter-phase> fieldname 'decision' option \n"
                                                "\"junk\" cannot junk an email during 'phase' \"commit\".\n"))
                        (throw 'bad! (car %traversing-list)))]
                     [else (loop (cdr %traversing-list) %original-list)]))))))

(define* (sanitize-options-for-filter-phase-configuration %options)
  (if (false? %options)
      (throw-error #f
                   (list "must have at least one opensmtpd-option record.")
                   #:record-name "filter-phase"
                   #:fieldname "options")
      (let loop ((%traversing-options %options)
                 ;; sanitized-options is an alist that may end of looking like:
                 ;; (("for" (opensmtpd-option (option "for any")))
                 ;;  ("from" (opensmtpd-option (option "from any"))))
                 (%sanitized-options '()))
        (if (null? %traversing-options)
            (remove false?
                    (list
                     (assoc-ref %sanitized-options "fcrdns")
                     (assoc-ref %sanitized-options "rdns")
                     (assoc-ref %sanitized-options "src")
                     (assoc-ref %sanitized-options "helo")
                     (assoc-ref %sanitized-options "auth")
                     (assoc-ref %sanitized-options "mail-from")
                     (assoc-ref %sanitized-options "rcpt-to")))
            (let* ((option-record (car %traversing-options))
                   (option-string (opensmtpd-option-option option-record)))
              (cond ((assoc-ref %sanitized-options option-string)
                     ;; if we see two "rdns" (for example), throw a "duplicate
                     ;; option" error.
                     (throw-error-duplicate-option option-string option-record
                                                   #:record-name "filter-phase"))
                    ;; the next 4 options must have fieldname 'data' defined.
                    ((or (string=? option-string "src")
                         (string=? option-string "helo")
                         (string=? option-string "mail-from")
                         (string=? option-string "rcpt-to"))
                     (if (not (opensmtpd-table?
                               (opensmtpd-option-data option-record)))
                         (throw-error option-record (list "must have fieldname 'data' defined.\n")
                                      #:record-name "option"
                                      #:fieldname option-string)
                         (loop (cdr %traversing-options)
                               (alist-cons option-string option-record %sanitized-options))))
                    ;;fcrdns cannot have fieldname data defined
                    ((string=? "fcrdns" option-string)
                     (if (opensmtpd-option-data option-record)
                         (throw-error option-record (list "cannot have fieldname data defined.\n")
                                      #:record-name "option"
                                      #:fieldname "rdns")
                         (loop (cdr %traversing-options)
                               (alist-cons "fcrdns" option-record %sanitized-options))))
                    ;; rdns and auth cannot be made invalidly; skip testing them.
                    ((or (string=? "rdns" option-string)
                         (string=? "auth" option-string))
                     (loop (cdr %traversing-options)
                           (alist-cons "auth" option-record
                                       %sanitized-options)))
                    (else (throw-error option-record
                                       (list "has an invalid option name.")
                                       #:record-name "filter-phase"
                                       #:fieldname option-string))))))))

(define* (throw-error var %strings
                      #:key
                      (record-name #f)
                      (fieldname #f))
  (if (and record-name fieldname)
      (begin
        (display (string-append "<opensmtpd-" record-name "> fieldname " fieldname " "
                                (apply string-append %strings)))
        (throw 'bad! var))
      (begin
        (display (apply string-append %strings))
        (throw 'bad! var))))

;; this is used for sanitizing <opensmtpd-filter-phase> fieldname 'options'
(define (contains-duplicate? list)
  (if (null? list)
      #f
      (or
      ;; check if (car list) is in (cdr list)
       (primitive-eval (cons 'or
                                (map (lambda (var) (equal? var (car list)))
                                     (cdr list))))
       ;; check if (cdr list) contains duplicate
       (contains-duplicate? (cdr list)))))

;; given a list and procedure, this tests that each element of list is of type
;; ie: (list-of-type? list string?) tests each list is of type string.
(define (list-of-type? list proc?)
  (if (and (list? list)
           (not (null? list)))
      (let loop ((list list))
        (if (null? list)
            #t
            (if (proc? (car list))
                (loop (cdr list))
                #f)))
      #f))

(define (list-of-strings? list)
  (list-of-type? list string?))

(define (list-of-unique-opensmtpd-option? list)
  (and (list-of-type?
        list opensmtpd-option?)
       (not (contains-duplicate? list))))

(define (list-of-opensmtpd-ca? list)
  (list-of-type? list opensmtpd-ca?))

(define (list-of-opensmtpd-pki? list)
  (list-of-type? list opensmtpd-pki?))

(define (list-of-opensmtpd-interface? list)
  (and (list-of-type? list opensmtpd-interface?)
       (not (contains-duplicate? list))))

(define (list-of-unique-opensmtpd-match? list)
  (and (list-of-type? list opensmtpd-match?)
       (not (contains-duplicate? list))))

(define* (list-of-strings->string list
                                  #:key
                                  (string-delimiter ", ")
                                  (postpend "")
                                  (append "")
                                  (drop-right-number 2))
  (string-drop-right
   (string-append (let loop ((list list))
                    (if (null? list)
                        ""
                        (string-append append (car list) postpend
                                       string-delimiter
                                       (loop (cdr list)))))
                  append)
   drop-right-number))

;; at the moment I cannot define this by using list-of-type?
;; the first (not (null? assoc-list)) prevents that.
(define (assoc-list? assoc-list)
  (list-of-type? assoc-list (lambda (pair)
                              (if (and (pair? pair)
                                       (string? (car pair))
                                       (string? (cdr pair)))
                                  #t
                                  #f))))

(define* (variable->string var #:key (append "") (postpend " "))
  (let ((var (if (number? var)
                 (number->string var)
                 var)))
    (if var
        (string-append append var postpend)
        "")))

;; this procedure takes in one argument.
;; if that argument is an <opensmtpd-table> whose fieldname 'values' is an assoc-list, then it returns
;; #t, #f if otherwise.
;; TODO should I remove these two functions?  And instead use the (opensmtpd-table-type) procedure?
(define (table-whose-data-are-assoc-list? table)
  (if (not (opensmtpd-table? table))
      #f
      (assoc-list? (opensmtpd-table-data table))))

;; this procedure takes in one argument
;; if that argument is an <opensmtpd-table> whose fieldname 'values' is a list of strings, then it returns
;; #t, #f if otherwise.
(define (table-whose-data-are-a-list-of-strings? table)
  (if (not (opensmtpd-table? table))
      #f
      (list-of-strings? (opensmtpd-table-data table))))

;; these next few functions help me to turn <table>s
;; into strings suitable to fit into "opensmtpd.conf".
(define (assoc-list->string assoc-list)
  (string-drop-right
   (let loop ((assoc-list assoc-list))
     (if (null? assoc-list)
         ""
         ;; pair is (cons "hello" "world") -> ("hello" . "world")
         (let ((pair (car assoc-list)))
           (string-append
            "\"" (car pair)  "\""
            " = "
            "\"" (cdr pair) "\""
            ", "
            (loop (cdr assoc-list))))))
   2))

;;  The following functions convert various records into strings.
;;
;; can be of type: (quote list-of-strings) or (quote assoc-list)
(define (opensmtpd-table->string table)
  (string-append "table " (opensmtpd-table-name table) " "
                 (let ((type (opensmtpd-table-type table)))
                   (cond ((eq? type (quote list-of-strings))
                          (string-append "{ " (list-of-strings->string (opensmtpd-table-data table)
                                                                       #:append "\""
                                                                       #:drop-right-number 3
                                                                       #:postpend "\"") " }"))
                         ((eq? type (quote assoc-list))
                          (string-append "{ " (assoc-list->string (opensmtpd-table-data table)) " }"))
                         ((eq? type (quote db))
                          (string-append "db:" (opensmtpd-table-data table)))
                         ((eq? type (quote file))
                          (string-append "file:" (opensmtpd-table-data table)))
                         (else (throw 'youMessedUp table))))
                 " \n"))

(define (opensmtpd-interface->string record)
  (string-append "listen on "
                 (opensmtpd-interface-interface record) " "
                 (let* ((hostname (opensmtpd-interface-hostname record))
                        (hostnames (if (opensmtpd-interface-hostnames record)
                                       (opensmtpd-table-name (opensmtpd-interface-hostnames record))
                                       #f))
                        (filters (opensmtpd-interface-filters record))
                        (filter-name (if filters
                                         (if (< 1 (length filters))
                                             (generate-filter-chain-name filters)
                                             (if (opensmtpd-filter? (car filters))
                                                 (opensmtpd-filter-name (car filters))
                                                 (opensmtpd-filter-phase-name (car filters))))
                                         #f))
                        (mask-src (opensmtpd-interface-mask-src record))
                        (tag (opensmtpd-interface-tag record))
                        (secure-connection (opensmtpd-interface-secure-connection record))
                        (port (opensmtpd-interface-port record))
                        (pki (opensmtpd-interface-pki record))
                        (auth (opensmtpd-interface-auth record))
                        (auth-optional (opensmtpd-interface-auth-optional record)))
                   (string-append
                    (if mask-src
                        (string-append "mask-src ")
                        "")
                    (variable->string hostname #:append "hostname ")
                    (variable->string hostnames #:append "hostnames <" #:postpend "> ")
                    (variable->string filter-name #:append "filter \"" #:postpend "\" ")
                    (variable->string tag #:append "tag \"" #:postpend "\" ")
                    (if secure-connection
                        (cond ((string=? "smtps" secure-connection)
                               "smtps ")
                              ((string=? "tls" secure-connection)
                               "tls ")
                              ((string=? "tls-require" secure-connection)
                               "tls-require ")
                              ((string=? "tls-require-verify" secure-connection)
                               "tls-require verify "))
                        "")
                    (variable->string port #:append "port " #:postpend " ")
                    (if pki
                        (variable->string (opensmtpd-pki-domain pki) #:append "pki ")
                        "")
                    (if auth
                        (string-append "auth "
                                       (if (opensmtpd-table? auth)
                                           (string-append "<" (opensmtpd-table-name auth) "> ")
                                           ""))
                        "")
                    (if auth-optional
                        (string-append "auth-optional "
                                       (if (opensmtpd-table? auth-optional)
                                           (string-append "<" (opensmtpd-table-name auth-optional) "> ")
                                           ""))
                        "")
                    "\n"))))

(define (opensmtpd-socket->string record)
  (string-append "listen on socket "
                 (let* ((filters (opensmtpd-socket-configuration-filters record))
                        (filter-name (if filters
                                         (if (< 1 (length filters))
                                             (generate-filter-chain-name filters)
                                             (if (opensmtpd-filter? (car filters))
                                                 (opensmtpd-filter-name (car filters))
                                                 (opensmtpd-filter-phase-name (car filters))))
                                         #f))
                        (mask-src (opensmtpd-socket-configuration-mask-src record))
                        (tag (opensmtpd-socket-configuration-tag record)))
                   (string-append
                    (if mask-src
                        (string-append "mask-src ")
                        "")
                    (variable->string filter-name #:append "filter \"" #:postpend "\" ")
                    (variable->string tag #:append "tag \"" #:postpend "\" ")
                    "\n"))))

(define (opensmtpd-relay->string record)
  (let ((backup (opensmtpd-relay-backup record))
        (backup-mx (opensmtpd-relay-backup-mx record))
        (helo (opensmtpd-relay-helo record))
        ;; helo-src can either be a string IP address or an <opensmtpd-table>
        (helo-src (if (opensmtpd-relay-helo-src record)
                      (if (string? (opensmtpd-relay-helo-src record))
                          (opensmtpd-relay-helo-src record)
                          (string-append "<\""
                                         (opensmtpd-table-name
                                          (opensmtpd-relay-src record))
                                         "\">"))
                      #f))
        (domain (if (opensmtpd-relay-domain record)
                    (opensmtpd-table-name
                     (opensmtpd-relay-domain record))
                    #f))
        (host (opensmtpd-relay-host record))
        (name (opensmtpd-relay-name record))
        (pki (if (opensmtpd-relay-pki record)
                 (opensmtpd-pki-domain (opensmtpd-relay-pki record))
                 #f))
        (srs (opensmtpd-relay-srs record))
        (tls (opensmtpd-relay-tls record))
        (auth (if (opensmtpd-relay-auth record)
                  (opensmtpd-table-name
                   (opensmtpd-relay-auth record))
                  #f))
        (mail-from (opensmtpd-relay-mail-from record))
        ;; src can either be a string IP address or an <opensmtpd-table>
        (src (if (opensmtpd-relay-src record)
                 (if (string? (opensmtpd-relay-src record))
                     (opensmtpd-relay-src record)
                     (string-append "<\""
                                    (opensmtpd-table-name
                                     (opensmtpd-relay-src record))
                                    "\">"))
                 #f)))
        
    (string-append
     "\""
     name
     "\" " "relay "
     ;;FIXME should I always quote the host fieldname? do I need to quote localhost via "localhost" ?
     (variable->string host #:append "host \"" #:postpend "\" ")
     (variable->string backup)
     (variable->string backup-mx #:append "backup mx ")
     (variable->string helo #:append "helo ")
     (variable->string helo-src #:append "helo-src ")
     (variable->string domain #:append "domain <\"" #:postpend "\"> ")
     (variable->string host #:append "host ")
     (variable->string pki #:append "pki ")
     (variable->string srs)
     (variable->string tls #:append "tls ")
     (variable->string auth #:append "auth <" #:postpend "> ")
     (variable->string mail-from #:append "mail-from ")
     (variable->string src #:append "src ")
     "\n")))

(define (opensmtpd-lmtp->string record)
  (string-append "lmtp "
                 (opensmtpd-lmtp-destination record)
                 (if (opensmtpd-lmtp-rcpt-to record)
                     (begin
                       " " (opensmtpd-lmtp-rcpt-to record))
                     "")))

(define (opensmtpd-mda->string record)
  (string-append "mda "
                 (opensmtpd-mda-command record) " "))

(define (opensmtpd-maildir->string record)
  (string-append "maildir "
                 "\""
                 (if (opensmtpd-maildir-pathname record)
                     (opensmtpd-maildir-pathname record)
                     "~/Maildir")
                 "\""
                 (if (opensmtpd-maildir-junk record)
                     " junk "
                     " ")))

(define (opensmtpd-local-delivery->string record)
  (let ((name (opensmtpd-local-delivery-name record))
        (method (opensmtpd-local-delivery-method record))
        (alias (if (opensmtpd-local-delivery-alias record)
                   (opensmtpd-table-name
                    (opensmtpd-local-delivery-alias record))
                   #f))
        (ttl (opensmtpd-local-delivery-ttl record))
        (user (opensmtpd-local-delivery-user record))
        (userbase (if (opensmtpd-local-delivery-userbase record)
                      (opensmtpd-table-name
                       (opensmtpd-local-delivery-userbase record))
                      #f))
        (virtual (if (opensmtpd-local-delivery-virtual record)
                     (opensmtpd-table-name
                      (opensmtpd-local-delivery-virtual record))
                     #f))
        (wrapper (opensmtpd-local-delivery-wrapper record)))
    (string-append
     "\"" name "\" "
     (cond ((string? method)
            (string-append method " "))
           ((opensmtpd-mda? method)
            (opensmtpd-mda->string method))
           ((opensmtpd-lmtp? method)
            (opensmtpd-lmtp->string method))
           ((opensmtpd-maildir? method)
            (opensmtpd-maildir->string method)))
     ;; FIXME/TODO support specifying alias file:/path/to/alias-file  ?
     ;; I do not think that is something that I can do...
     (variable->string alias #:append "alias <\"" #:postpend "\"> ")
     (variable->string ttl #:append "ttl ")
     (variable->string user #:append "user ")
     (variable->string userbase #:append "userbase <\"" #:postpend "\"> ")
     (variable->string virtual #:append "virtual <" #:postpend "> ")
     (variable->string wrapper #:append "wrapper "))))

;; this function turns both opensmtpd-local-delivery and
;; opensmtpd-relay into strings.
(define (opensmtpd-action->string record)
  (string-append "action "
                 (cond ((opensmtpd-local-delivery? record)
                        (opensmtpd-local-delivery->string record))
                       ((opensmtpd-relay? record)
                        (opensmtpd-relay->string record)))
                 " \n"))

;; this turns option records found in <opensmtpd-match> into strings.
(define* (opensmtpd-option->string record
                                                 #:key
                                                 (space-after-! #f))
  (let ((not (opensmtpd-option-not record))
        (option (opensmtpd-option-option record))
        (regex (opensmtpd-option-regex record))
        (data (opensmtpd-option-data record)))
    (string-append
     (if not
         (if space-after-!
             "! "
             "!")
         "")
     option " "
     (if regex
         "regex "
         "")
     (if data
         (if (opensmtpd-table? data)
             (string-append "<" (opensmtpd-table-name data) "> ")
             (string-append data " "))
         ""))))

(define (opensmtpd-match->string record)
  (string-append "match "
                 (let* ((action (opensmtpd-match-action record))
                        (name (cond [(opensmtpd-relay? action)
                                     (opensmtpd-relay-name action)]
                                    [(opensmtpd-local-delivery? action)
                                     (opensmtpd-local-delivery-name action)]
                                    [else 'reject]))
                        (options (opensmtpd-match-options record)))
                   (string-append
                    (if options
                        (apply string-append
                               (map opensmtpd-option->string options))
                        "")
                    (if (string? name)
                        (string-append "action " "\"" name "\" ")
                        "reject ")
                    "\n"))))

(define (opensmtpd-ca->string record)
  (string-append "ca " (opensmtpd-ca-name record) " "
                 "cert \"" (opensmtpd-ca-file record) "\"\n"))

(define (opensmtpd-pki->string record)
  (let ((domain (opensmtpd-pki-domain record))
        (cert (opensmtpd-pki-cert record))
        (key (opensmtpd-pki-key record))
        (dhe (opensmtpd-pki-dhe record)))
    (string-append "pki " domain " " "cert \"" cert "\" \n"
                   "pki " domain " " "key \"" key "\" \n"
                   (if dhe
                       (string-append
                        "pki " domain " " "dhe " dhe "\n")
                       ""))))

(define (generate-filter-chain-name list-of-filters)
  (string-drop-right (apply string-append
                            (flatten
                             (map (lambda (filter)
                                    (list
                                     (if (opensmtpd-filter? filter)
                                         (opensmtpd-filter-name filter)
                                         (opensmtpd-filter-phase-name filter))
                                     "-"))
                                  list-of-filters)))
                     1))

;; this procedure takes in a list of <opensmtpd-filter> and <opensmtpd-filter-phase>,
;; returns a string of the form:
;; filter "uniquelyGeneratedName" chain chain { "filter-name", "filter-name2" [, ...]}
(define (opensmtpd-filter-chain->string list-of-filters)
  (string-append "filter \""
                 (generate-filter-chain-name list-of-filters)
                 "\" "
                 "chain {"
                 (string-drop-right
                  (apply string-append
                         (flatten
                          (map (lambda (filter)
                                 (list
                                  "\""
                                  (if (opensmtpd-filter? filter)
                                      (opensmtpd-filter-name filter)
                                      (opensmtpd-filter-phase-name filter))
                                  "\", "))
                               list-of-filters)))
                  2)
                 "}\n"))

(define (opensmtpd-filter-phase->string record)
  (let ((name (opensmtpd-filter-phase-name record))
        (phase (opensmtpd-filter-phase-phase record))
        (decision (opensmtpd-filter-phase-decision record))
        (options (opensmtpd-filter-phase-options record))
        (message (opensmtpd-filter-phase-message record))
        (value (opensmtpd-filter-phase-value record)))
    (string-append "filter "
                   "\"" name "\" "
                   "phase " phase " "
                   "match "
                   (apply string-append ; turn the options into a string
                          (flatten
                           (map (lambda (option)
                                  (opensmtpd-option->string option #:space-after-! #f))
                                options)))
                   " "
                   decision " "
                   (if (string-in-list? decision (list "reject" "disconnect"))
                       (string-append "\"" message "\"")
                       "")
                   (if (string=? "rewrite" decision)
                       (string-append "rewrite " (number->string value))
                       "")
                   "\n")))

;; filters elements may be <opensmtpd-filter>, <opensmtpd-filter-phase>,
;; and lists that look like (list (opensmtpd-filter...) (opensmtpd-filter-phase ...)
;; ...)
;; this function converts it to a string.
;; Consider if a user passed in a valid <opensmtpd-configuration>, whose total valid filters
;; so that (get-opensmtpd-filters (opensmtpd-configuration)) returns
;; look like this: (we will call this list "total filters"):
;; (list (opensmtpd-filter
;;         (name "rspamd")
;;         (proc "rspamd"))
;;       (list (opensmtpd-filter-phase ; this is a listen-on, with a filter-chain.
;;               (name "dkimsign")
;;               ...)
;;               (opensmtpd-filter
;;                 (name "rspamd")
;;                 (proc "rspamd"))))
;;
;; did you notice that filter "rspamd" is listed twice?  How do you make sure that it is NOT
;; printed twice in smtpd.conf?
;; 1st flatten "total filters", then remove its duplicates.  Then print all of those filters.
;; 2nd now we go through "total filters", and we only print the non-filter-chains.
(define (opensmtpd-filters->list-of-strings-and-gexps filters)
  ;; first display the unique <opensmtpd-filter>s. and <opensmtpd-filter-phase>s.
  ;; to do this: flatten filters, then remove duplicates.
  (list
   (apply string-append
          (map (lambda (filter)
                 (if (opensmtpd-filter-phase? filter)
                     (opensmtpd-filter-phase->string filter)
                     ""))
               (delete-duplicates (flatten filters))))
   ;; print out the filter-configurations
   ;; would values and or call-with-values and or recieve work here?
   (list (map (lambda (filter)
                (if (opensmtpd-filter? filter)
                    (list "filter "
                          "\"" (opensmtpd-filter-name filter) "\" "
                          (if (opensmtpd-filter-exec filter)
                              "proc-exec "
                              "proc ")
                          "\"" (opensmtpd-filter-proc filter) "\""
                          "\n\n")
                    ""))
              (delete-duplicates (flatten filters))))
   ;; now we have to print the filter chains.
   (apply string-append
          (map (lambda (filter)
                 (cond ((list? filter)
                        (opensmtpd-filter-chain->string filter))
                       (else      ; you are a <opensmtpd-filter>
                        "")))
               filters))))

(define (opensmtpd-configuration-listen->string string)
  (string-append
   "include \"" string "\"\n"))

(define (opensmtpd-configuration-srs->string record)
  (let ((key (opensmtpd-srs-key record))
        (backup-key (opensmtpd-srs-backup-key record))
        (ttl-delay (opensmtpd-srs-ttl-delay record)))
    (string-append
     (variable->string key #:append "srs key " #:postpend "\n")
     (variable->string backup-key #:append "srs key backup " #:postpend "\n")
     (variable->string ttl-delay #:append "srs ttl " #:postpend "\n")
     "\n")))

;; TODO make sure all options here work!  I just fixed limit-max-rcpt!
(define (opensmtpd-smtp->string record)
  (let ((ciphers (opensmtpd-smtp-ciphers record))
        (limit-max-mails (opensmtpd-smtp-limit-max-mails record))
        (limit-max-rcpt (opensmtpd-smtp-limit-max-rcpt record))
        (max-message-size (opensmtpd-smtp-max-message-size record))
        (sub-addr-delim (opensmtpd-smtp-sub-addr-delim record)))
    (string-append
     (variable->string ciphers #:append "smtp ciphers " #:postpend "\n")
     (variable->string limit-max-mails #:append "smtp limit max-mails " #:postpend "\n")
     (variable->string limit-max-rcpt #:append "smtp limit max-rcpt " #:postpend "\n")
     (variable->string max-message-size #:append "smtp max-message-size " #:postpend "\n")
     (variable->string sub-addr-delim #:append "smtp sub-addr-delim " #:postpend "\n")
     "\n")))

(define (opensmtpd-configuration-queue->string record)
  (let ((compression (opensmtpd-queue-compression record))
        (encryption (opensmtpd-queue-encryption record))
        (ttl-delay (opensmtpd-queue-ttl-delay record)))
    (string-append
     (if compression
         "queue compression\n"
         "")
     (if encryption
         (string-append
          "queue encryption "
          (if (not (boolean? encryption))
              encryption
              "")
          "\n")
         "")
     (if ttl-delay
         (string-append "queue ttl" ttl-delay "\n")
         ""))))

;; build a list of <opensmtpd-action> from
;; opensmtpd-configuration-matches, which is a list of <opensmtpd-match>.
;; Each <opensmtpd-match> has a fieldname 'action', which accepts an <opensmtpd-action>.
(define (get-opensmtpd-actions record)
  (define opensmtpd-actions
    (let loop ((list (opensmtpd-configuration-matches record)))
      (if (null? list)
          '()
          (cons (opensmtpd-match-action (car list))
                (loop (cdr list))))))
  (delete-duplicates (append opensmtpd-actions)))

;; build a list of opensmtpd-pkis from
;; opensmtpd-configuration-listen-ons and
;; get-opensmtpd-actions
(define (get-opensmtpd-pkis record)
  ;; TODO/FIXME/maybe/wishlist could get-opensmtpd-actions -> NOT have an opensmtpd-relay?
  ;; I think so.  And if it did NOT have a relay configuration, then action-pkis would be '() when
  ;; it needs to be #f.  because if the opensmtpd-configuration has NO pkis, then this function will
  ;; return '(), when it should return #f.  If it returns '(), then opensmtpd-configuration-fieldname->string will
  ;; print the string "\n" instead of ""
  (define action-pkis
    (let loop1 ((list (get-opensmtpd-actions record)))
      (if (null? list)
          '()
          (if (and (opensmtpd-relay? (car list))
                   (opensmtpd-relay-pki (car list)))
              (cons (opensmtpd-relay-pki (car list))
                    (loop1 (cdr list)))
              (loop1 (cdr list))))))
  ;; FIXME/TODO/maybe/wishlist
  ;; this could be #f aka left blank. aka there are no listen-ons records with pkis.
  ;; aka there are no lines in the configuration like:
  ;; listen on eth0 tls pki smtp.gnucode.me in that case the smtpd.conf will have an extra "\n"
  (define listen-on-pkis
    (let loop2 ((list (opensmtpd-configuration-listen-ons record)))
      (if (null? list)
          '()
          (if (opensmtpd-interface-pki (car list))
              (cons (opensmtpd-interface-pki (car list))
                    (loop2 (cdr list)))
              (loop2 (cdr list))))))
  (delete-duplicates (append action-pkis listen-on-pkis)))

;; takes in a <opensmtpd-configuration> and returns a list whose elements are <opensmtpd-filter>,
;; <opensmtpd-filter-phase>, and a filter-chain.
;; It returns a list of <opensmtpd-filter> and/or <opensmtpd-filter-phase>
;; here's an example of what this procedure might return:
;; (list (opensmtpd-filter...) (opensmtpd-filter-phase ...)
;;       (openmstpd-filter ...) (opensmtpd-filter-phase ...)
;;       ;; this next list is a filter-chain.
;;       (list (opensmtpd-filter-phase ...) (opensmtpd-filter...)))
;;
;; This procedure handles filter chains a little odd.
(define (get-opensmtpd-filters record)
  (define list-of-listen-on-records (if (opensmtpd-configuration-listen-ons record)
                                        (opensmtpd-configuration-listen-ons record)
                                        '()))

  (define listen-on-socket-filters
    (if (opensmtpd-socket-configuration-filters (opensmtpd-configuration-listen-on-socket record))
        (opensmtpd-socket-configuration-filters (opensmtpd-configuration-listen-on-socket record))
        '()))

  (delete-duplicates
   (append (remove boolean?
                   (map-in-order (lambda (listen-on-record) ; get the filters found in the <listen-on-record>s
                                   (if (and (opensmtpd-interface-filters listen-on-record)
                                            (= 1 (length (opensmtpd-interface-filters
                                                          listen-on-record))))
                                       (car (opensmtpd-interface-filters listen-on-record))
                                       (opensmtpd-interface-filters listen-on-record)))
                                 list-of-listen-on-records))
           listen-on-socket-filters)))

(define (flatten . lst)
  "Return a list that recursively concatenates all sub-lists of LST."
  (define (flatten1 head out)
    (if (list? head)
        (fold-right flatten1 out head)
        (cons head out)))
  (fold-right flatten1 '() lst))

;; This function takes in a record, or list, or anything, and returns
;; a list of <opensmtpd-table>s assuming the thing you passed into it had
;; any <opensmtpd-table>s.
;;
;; is object record? call func on it's fieldnames
;; is object list? loop through it's fieldnames calling func on it's records
;; is object #f or string? or '()? -> #f
(define (get-opensmtpd-tables value)
  (delete-duplicates
   (remove boolean? (flatten ;; turn (list '(1) '(2 '(3))) -> '(1 2 3)
                     (cond ((opensmtpd-table? value)
                            value)
                           ((record? value)
                            (let* ((record-type (record-type-descriptor value))
                                   (list-of-record-fieldnames (record-type-fields record-type)))
                              (map (lambda (fieldname)
                                     (get-opensmtpd-tables ((record-accessor record-type fieldname) value)))
                                   list-of-record-fieldnames)))
                           ((and (list? value) (not (null? value)))
                            (map get-opensmtpd-tables value))
                           (else #f))))))

(define (opensmtpd-configuration-fieldname->string record fieldname-accessor record->string)
  (if (fieldname-accessor record)
      (begin
        (string-append
         (list-of-records->string (fieldname-accessor record) record->string) "\n"))
      ""))

(define (list-of-records->string list-of-records record->string)
  (string-append
   (cond ((not (list? list-of-records))
          (record->string list-of-records))
         (else
          (let loop ([list list-of-records])
            (if (null? list)
                ""
                (string-append
                 (record->string (car list))
                 (loop (cdr list)))))))))

(define (opensmtpd-configuration->string record)
  (string-append
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-bounce
                                              (lambda (%bounce)
                                                (if %bounce
                                                    (list-of-strings->string %bounce)
                                                    "")))
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-smtp
                                              opensmtpd-smtp->string)
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-srs
                                              opensmtpd-configuration-srs->string)
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-queue
                                              opensmtpd-configuration-queue->string)
   ;; write out the mta-max-deferred
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-mta-max-deferred
    (lambda (var)
      (string-append "mta max-deferred "
                     (number->string (opensmtpd-configuration-mta-max-deferred record)) "\n")))
   ;;write out all the tables
   (opensmtpd-configuration-fieldname->string record get-opensmtpd-tables opensmtpd-table->string)
   ;; write out all the cas
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-cas opensmtpd-ca->string)
   ;; write out all the pkis
   (opensmtpd-configuration-fieldname->string record get-opensmtpd-pkis opensmtpd-pki->string)
   ;; write all of the listen-on-records
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-listen-ons
                                              opensmtpd-interface->string)
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-listen-on-socket
                                              opensmtpd-socket->string)
   ;; write all the actions
   (opensmtpd-configuration-fieldname->string record get-opensmtpd-actions
                                              opensmtpd-action->string)
   ;; write all of the matches
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-matches opensmtpd-match->string)))

;; FIXME/TODO should I use format here srfi-28 ?
;; web.scm nginx does a (format #f "string" "another string")
;; this could be a list like (list (file-append opensmtpd-dkimsign "/libexec/filter") "-d gnucode.me -s /path/to/selector.cert")
;; Then opensmtpd-configuration->mixed-text-file could be rewritten to be something like
;; (mixed-text-file (eval `(string-append (opensmtpd-configuration-fieldname->string ...)) (gnu services mail)))
(define (opensmtpd-configuration->mixed-text-file record)
  ;; should I use this named let, or should I give this a name, or not use it at all...
  ;; eg: (write-all-fieldnames (list (cons fieldname fieldname->string) (cons fieldname2 fieldname->string)))
  ;; (let loop ([list (list (cons opensmtpd-configuration-includes (lambda (string)
  ;;                                                                 (string-append
  ;;                                                                  "include \"" string "\"\n")))
  ;;                        (cons opensmtpd-configuration-smtp opensmtpd-smtp->string)
  ;;                        (cons opensmtpd-configuration-srs opensmtpd-srs->string))])
  ;;   (if (null? list)
  ;;       ""
  ;;       (string-append (opensmtpd-configuration-fieldname->string record
  ;;                                                                 (caar list)
  ;;                                                                 (cdar list))
  ;;                      (loop (cdr list)))))

  (apply mixed-text-file "smtpd.conf"
         ;; write out the includes
         (flatten (list
                   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-includes
                                                              opensmtpd-configuration-listen->string)
                   ;; TODO should I change the below line of code into these two lines of code?
                   ;;(opensmtpd-configuration-fieldname->string record get-opensmtpd-filters-and-filter-phases opensmtpd-filter-and-filter-phase->string)
                   ;;(opensmtpd-configuration-fieldname->string record get-opensmtpd-filter-chains opensmtpd-filter-chain->string)
                   ;; write out all the filters
                   (opensmtpd-filters->list-of-strings-and-gexps (get-opensmtpd-filters record))
                   (opensmtpd-configuration->string record)))))


(define %default-opensmtpd-config-file
  (plain-file "smtpd.conf" "
listen on lo

action inbound mbox
match for local action inbound

action outbound relay
match from local for any action outbound
"))

(define (opensmtpd-shepherd-service config)
  (match-lambda
    (($ <opensmtpd-configuration> package config-file)
     (list (shepherd-service
            (provision '(smtpd))
            (requirement '(loopback))
            (documentation "Run the OpenSMTPD daemon.")
            (start (let ((smtpd (file-append package "/sbin/smtpd")))
                     #~(make-forkexec-constructor
                        (list #$smtpd "-f" (or #$config-file
                                               #$(opensmtpd-configuration->mixed-text-file config)))
                        #:pid-file "/var/run/smtpd.pid")))
            (stop #~(make-kill-destructor)))))))

(define %opensmtpd-accounts
  (list (user-group
         (name "smtpq")
         (system? #t))
        (user-account
         (name "smtpd")
         (group "nogroup")
         (system? #t)
         (comment "SMTP Daemon")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))
        (user-account
         (name "smtpq")
         (group "smtpq")
         (system? #t)
         (comment "SMTPD Queue")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define (opensmtpd-activation config)
  (match-lambda
    (($ <opensmtpd-configuration> package config-file)
     (let ((smtpd (file-append package "/sbin/smtpd"))
           (configuration (opensmtpd-configuration->mixed-text-file config)))
       #~(begin
           (use-modules (guix build utils))
           ;; Create mbox and spool directories.
           (mkdir-p "/var/mail")
           (mkdir-p "/var/spool/smtpd")
           (chmod "/var/spool/smtpd" #o711)
           (mkdir-p "/var/spool/mail")
           (chmod "/var/spool/mail" #o711)
           (display (string-append "checking syntax of "
                                   (or
                                    #$config-file
                                    #$configuration)
                                   "\n")))))))

(define %opensmtpd-pam-services
  (list (unix-pam-service "smtpd")))

(define opensmtpd-set-gids
  (match-lambda
    (($ <opensmtpd-configuration> package config-file set-gids?)
     (if set-gids?
         (list
          (setuid-program
           (program (file-append package "/sbin/smtpctl"))
           (setuid? #false)
           (setgid? #true)
           (group "smtpq"))
          (setuid-program
           (program (file-append package "/sbin/sendmail"))
           (setuid? #false)
           (setgid? #true)
           (group "smtpq"))
          (setuid-program
           (program (file-append package "/sbin/send-mail"))
           (setuid? #false)
           (setgid? #true)
           (group "smtpq"))
          (setuid-program
           (program (file-append package "/sbin/makemap"))
           (setuid? #false)
           (setgid? #true)
           (group "smtpq"))
          (setuid-program
           (program (file-append package "/sbin/mailq"))
           (setuid? #false)
           (setgid? #true)
           (group "smtpq"))
          (setuid-program
           (program (file-append package "/sbin/newaliases"))
           (setuid? #false)
           (setgid? #true)
           (group "smtpq")))
         '()))))

(define opensmtpd-service-type
  (service-type
   (name 'opensmtpd)
   (extensions
    (list (service-extension account-service-type
                             (const %opensmtpd-accounts))
          (service-extension activation-service-type
                             opensmtpd-activation)
          (service-extension pam-root-service-type
                             (const %opensmtpd-pam-services))
          (service-extension profile-service-type
                             (compose list opensmtpd-configuration-package))
          (service-extension shepherd-root-service-type
                             opensmtpd-shepherd-service)
          (service-extension setuid-program-service-type
                             opensmtpd-set-gids)))
   (description "Run the OpenSMTPD, a lightweight @acronym{SMTP, Simple Mail
Transfer Protocol} server.")))

\f
;;;
;;; mail aliases.
;;;

(define (mail-aliases-etc aliases)
  `(("aliases" ,(plain-file "aliases"
                            ;; Ideally we'd use a format string like
                            ;; "~:{~a: ~{~a~^,~}\n~}", but it gives a
                            ;; warning that I can't figure out how to fix,
                            ;; so we'll just use string-join below instead.
                            (format #f "~:{~a: ~a\n~}"
                                    (map (match-lambda
                                           ((alias addresses ...)
                                            (list alias (string-join addresses ","))))
                                         aliases))))))

(define mail-aliases-service-type
  (service-type
   (name 'mail-aliases)
   (extensions
    (list (service-extension etc-service-type mail-aliases-etc)))
   (compose concatenate)
   (extend append)
   (description "Provide a @file{/etc/aliases} file---an email alias
database---computed from the given alias list.")))

\f
;;;
;;; Exim.
;;;

(define-record-type* <exim-configuration> exim-configuration
  make-exim-configuration
  exim-configuration?
  (package       exim-configuration-package ;file-like
                 (default exim))
  (config-file   exim-configuration-config-file ;file-like
                 (default #f)))

(define %exim-accounts
  (list (user-group
         (name "exim")
         (system? #t))
        (user-account
         (name "exim")
         (group "exim")
         (system? #t)
         (comment "Exim Daemon")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define (exim-computed-config-file package config-file)
  (computed-file "exim.conf"
                 #~(call-with-output-file #$output
                     (lambda (port)
                       (format port "
exim_user = exim
exim_group = exim
.include ~a"
                               #$(or config-file
                                     (file-append package "/etc/exim.conf")))))))

(define exim-shepherd-service
  (match-lambda
    (($ <exim-configuration> package config-file)
     (list (shepherd-service
            (provision '(exim mta))
            (documentation "Run the exim daemon.")
            (requirement '(networking))
            (start #~(make-forkexec-constructor
                      '(#$(file-append package "/bin/exim")
                        "-bd" "-v" "-C"
                        #$(exim-computed-config-file package config-file))))
            (stop #~(make-kill-destructor)))))))

(define exim-activation
  (match-lambda
    (($ <exim-configuration> package config-file)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))

           (let ((uid (passwd:uid (getpw "exim")))
                 (gid (group:gid (getgr "exim"))))
             (mkdir-p "/var/spool/exim")
             (chown "/var/spool/exim" uid gid))

           (zero? (system* #$(file-append package "/bin/exim")
                           "-bV" "-C" #$(exim-computed-config-file package config-file))))))))

(define exim-profile
  (compose list exim-configuration-package))

(define exim-service-type
  (service-type
   (name 'exim)
   (extensions
    (list (service-extension shepherd-root-service-type exim-shepherd-service)
          (service-extension account-service-type (const %exim-accounts))
          (service-extension activation-service-type exim-activation)
          (service-extension profile-service-type exim-profile)
          (service-extension mail-aliases-service-type (const '()))))
   (description "Run the Exim mail transfer agent (MTA).")))

\f
;;;
;;; GNU Mailutils IMAP4 Daemon.
;;;

(define %default-imap4d-config-file
  (plain-file "imap4d.conf" "server localhost {};\n"))

(define-record-type* <imap4d-configuration>
  imap4d-configuration make-imap4d-configuration imap4d-configuration?
  (package     imap4d-configuration-package
               (default mailutils))
  (config-file imap4d-configuration-config-file
               (default %default-imap4d-config-file)))

(define imap4d-shepherd-service
  (match-lambda
    (($ <imap4d-configuration> package config-file)
     (list (shepherd-service
            (provision '(imap4d))
            (requirement '(networking syslogd))
            (documentation "Run the imap4d daemon.")
            (start (let ((imap4d (file-append package "/sbin/imap4d")))
                     #~(make-forkexec-constructor
                        (list #$imap4d "--daemon" "--foreground"
                              "--config-file" #$config-file))))
            (stop #~(make-kill-destructor)))))))

(define imap4d-service-type
  (service-type
   (name 'imap4d)
   (description
    "Run the GNU @command{imap4d} to serve e-mail messages through IMAP.")
   (extensions
    (list (service-extension
           shepherd-root-service-type imap4d-shepherd-service)))
   (default-value (imap4d-configuration))))

\f
;;;
;;; Radicale.
;;;

(define-record-type* <radicale-configuration>
  radicale-configuration make-radicale-configuration
  radicale-configuration?
  (package     radicale-configuration-package
               (default radicale))
  (config-file radicale-configuration-config-file
               (default %default-radicale-config-file)))

(define %default-radicale-config-file
  (plain-file "radicale.conf" "
[auth]
type = htpasswd
htpasswd_filename = /var/lib/radicale/users
htpasswd_encryption = plain

[server]
hosts = localhost:5232"))

(define %radicale-accounts
  (list (user-group
         (name "radicale")
         (system? #t))
        (user-account
         (name "radicale")
         (group "radicale")
         (system? #t)
         (comment "Radicale Daemon")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define radicale-shepherd-service
  (match-lambda
    (($ <radicale-configuration> package config-file)
     (list (shepherd-service
            (provision '(radicale))
            (documentation "Run the radicale daemon.")
            (requirement '(networking))
            (start #~(make-forkexec-constructor
                      (list #$(file-append package "/bin/radicale")
                        "-C" #$config-file)
                      #:user "radicale"
                      #:group "radicale"))
            (stop #~(make-kill-destructor)))))))

(define radicale-activation
  (match-lambda
    (($ <radicale-configuration> package config-file)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils))
           (let ((uid (passwd:uid (getpw "radicale")))
                 (gid (group:gid (getgr "radicale"))))
             (mkdir-p "/var/lib/radicale/collections")
             (chown "/var/lib/radicale" uid gid)
             (chown "/var/lib/radicale/collections" uid gid)
             (chmod "/var/lib/radicale" #o700)))))))

(define radicale-service-type
  (service-type
   (name 'radicale)
   (description "Run radicale, a small CalDAV and CardDAV server.")
   (extensions
    (list (service-extension shepherd-root-service-type radicale-shepherd-service)
          (service-extension account-service-type (const %radicale-accounts))
          (service-extension activation-service-type radicale-activation)))
   (default-value (radicale-configuration))))