Subject: Re: [Patch master v2] services (opensmtpd): add opensmtpd records to enhance opensmtpd-configuration.

From: Liliana Marie Prikler <[email-masked]>
Date: Mon, 24 Oct 2022 20:28:57 +0200

Am Montag, dem 24.10.2022 um 13:30 -0400 schrieb Joshua Branson:
> This is a V2 patch.  I've added some tests that help test for various
> ways that users could accidentally misconfigure their configuration.
> 
> I probably need to make those error messages, use   
> (guix diagnostics).  Currently compiling the tests, auto runs them.
> So "make" auto runs the tests.  Also their error messages are output
> to the terminal, and I'm not sure how to turn that off.
> 
> tl;dr this is a WIP patch, and I just wanted to submit something,
> because I keep finding more things that I need to fix.
> 
> The task list as always is here:
> https://notabug.org/jbranso/linode-guix-system-configuration/src/master/opensmtpd.org
>  
> 
> Openmstpd-configuration may only be configured by a config-file that
> uses the smtpd.conf syntax.  This patch, enables one to configure
> opensmtpd by using record types.
> 
> * gnu/services/mail.scm:
> (opensmtpd-table-configuration,
ChangeLog format would be (opensmtpd-table-configuration) followed by a
new line, followed by (opensmtpd-ca-configuration) etc.
> opensmtpd-ca-configuration,
> opensmtpd-pki-configuration,
> opensmtpd-action-local-delivery-configuration,
> opensmtpd-maildir-configuration,
> opensmtpd-mda-configuration,
> opensmtpd-action-relay-configuration,
> opensmtpd-option-configuration,
> opensmtpd-filter-phase-configuration,
> opensmtpd-filter-configuration,
> opensmtpd-interface,
> opensmtpd-socket,
> opensmtpd-match-configuration,
> opensmtpd-smtp-configuration,
> opensmtpd-srs-configuration,
> opensmtpd-queue-configuration, and
> opensmtpd-configuration): New records.
> 
> (false?, is-value-right-type, add-comma-or-string,
> list-of-procedures->string, string-in-list?, my-sanitize,
> opensmtpd-filter-chain?, throw-error-duplicate-option,
> sanitize-list-of-options-for-match-configuration, sanitize-filters,
> list-has-duplicates-or-non-filters?,
> filter-phase-has-message-and-value?,
> filter-phase-decision-lacks-proper-message?,
> filter-phase-lacks-proper-value?,
> filter-phase-has-incorrect-junk-or-bypass?,
> filter-phase-junks-after-commit?,
> list-of-unique-filter-or-filter-phase?, throw-error,
> contains-duplicate?, list-of-type?, list-of-strings?,
> list-of-unique-opensmtpd-option-configuration?,
> list-of-opensmtpd-ca-configuration?,
> list-of-opensmtpd-pki-configuration?,
> list-of-opensmtpd-listen-on-configuration?,
> list-of-unique-opensmtpd-match-configuration?, list-of-strings-
> >string,
> assoc-list? assoc-list, variable->string,
> table-whose-data-are-assoc-list?,
> table-whose-data-are-a-list-of-strings?, assoc-list->string,
> opensmtpd-table-configuration->string,
> opensmtpd-listen-on-configuration->string,
> opensmtpd-listen-on-socket-configuration->string,
> opensmtpd-action-relay-configuration->string,
> opensmtpd-lmtp-configuration->string,
> opensmtpd-mda-configuration->string,
> opensmtpd-maildir-configuration->string,
> opensmtpd-action-local-delivery-configuration->string,
> opensmtpd-action->string, opensmtpd-option-configuration->string,
> opensmtpd-match-configuration->string,
> opensmtpd-ca-configuration->string, opensmtpd-pki-configuration-
> >string,
> generate-filter-chain-name, opensmtpd-filter-chain->string,
> opensmtpd-filter-phase-configuration->string, opensmtpd-filters-
> >string,
> opensmtpd-configuration-listen->string,
> opensmtpd-configuration-srs->string,
> opensmtpd-smtp-configuration->string,
> opensmtpd-configuration-queue->string, get-opensmtpd-actions,
> get-opensmtpd-pki-configurations, get-opensmtpd-filters, flatten,
> get-opensmtpd-tables, opensmtpd-configuration-fieldname->string,
> list-of-records->string, opensmtpd-configuration->mixed-text-file):
> New
> procedures.
> 
> * gnu/tests/mail.scm : new tests for various opensmtpd records.
> 
> * doc/guix.texi (OpenSMTPD Service): Added documentation for the
> new records for opensmtpd.
> ---
>  doc/guix.texi         | 1054 ++++++++++++++++++++-
>  gnu/services/mail.scm | 2085
> ++++++++++++++++++++++++++++++++++++++++-
>  gnu/tests/mail.scm    |  355 +++++++
>  3 files changed, 3475 insertions(+), 19 deletions(-)
> 
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 535c8cdfc3..c80f3e9d76 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -25409,14 +25409,59 @@ could instantiate a dovecot service like
> this:
>  @subsubheading OpenSMTPD Service
>  
>  @deffn {Scheme Variable} opensmtpd-service-type
> -This is the type of the @uref{https://www.opensmtpd.org, OpenSMTPD}
> -service, whose value should be an @code{opensmtpd-configuration}
> object
> -as in this example:
> -
> -@lisp
> -(service opensmtpd-service-type
> -         (opensmtpd-configuration
> -           (config-file (local-file "./my-smtpd.conf"))))
> +OpenSMTPD is an easy-to-use mail transfer agent (MTA). Its
> configuration file is
> +throughly documented in @code{man 5 smtpd.conf}. OpenSMTPD
> @strong{listens} for incoming
> +mail and @strong{matches} the mail to @strong{actions}. The
> following records represent those
> +stages:
> +
> +@multitable {aaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item @strong{listens}
> +@tab @code{<opensmtpd-interface>}
> +@item
> +@tab @code{<opensmtpd-socket>}
> +@item
> +@tab
> +@item @strong{matches}
> +@tab @code{<opensmtpd-match>}
> +@item
> +@tab
> +@item @strong{actions}
> +@tab @code{<opensmtpd-local-delivery>}
> +@item
> +@tab @code{<opensmtpd-relay>}
> +@end multitable
> +
> +Additionally, each @code{<opensmtpd-interface>} and
> +@code{<opensmtpd-socket>} may use a list of
> +@code{<opensmtpd-filter>}, and/or
> +@code{<opensmtpd-filter-phase>} records to filter email/spam. Also
> +numerous records' fieldnames use @code{<opensmtpd-table>} to hold
> lists
> +or key value pairs of data.
> +
> +A simple example configuration is below:
> +
> +@lisp
> +(let ((smtp.gnu.org (opensmtpd-pki
> +                        (domain "smtp.gnu.org")
> +                        (cert "file.cert")
> +                        (key "file.key"))))
> +  (service opensmtpd-service-type
> +           (opensmtpd-configuration
> +            (listen-ons (list
> +                         (opensmtpd-interface
> +                          (pki smtp.gnu.org))
> +                         (opensmtpd-interface
> +                          (pki smtp.gnu.org)
> +                          (secure-connection "smtps"))))
> +            (matches (list
> +                      (opensmtpd-match
> +                       (action
> +                        (opensmtpd-local-delivery
> +                         (name "local-delivery"))))
> +                      (opensmtpd-match
> +                       (action
> +                        (opensmtpd-relay
> +                         (name "relay")))))))))
>  @end lisp
>  @end deffn
>  
> @@ -25433,14 +25478,1007 @@ it listens on the loopback network
> interface, and allows for mail from
>  users and daemons on the local machine, as well as permitting email
> to
>  remote servers.  Run @command{man smtpd.conf} for more information.
>  
> +<<<<<<< HEAD
You have an artifact here.
> +@item @code{bounce} (default: @code{(list "4h")})
> +
> +@code{bounce} is a list of strings, which send warning messages to
> the envelope
> +sender when temporary delivery failures cause a message to remain in
> the
> +queue for longer than string delay. Each string delay parameter
> consists
> +of a string beginning with a positive decimal integer and a unit
> 's', 'm', 'h',
> +or 'd'. At most four delay parameters can be specified.
> +
> +@item @code{listen-ons} (default: @code{(list (opensmtpd-
> interface))})
> +
> +@code{listen-ons} is a list of @code{<opensmtpd-interface>} records.
> +This list details what interfaces and ports OpenSMTPD listens on as
> well as
> +other information.
> +
> +@item @code{listen-on-socket} (default: @code{(opensmtpd-socket)})
> +
> +Listens for incoming connections on the Unix domain socket.
> +
> +@item @code{includes} (default: @code{#f})
> +
> +@code{includes} is a list of string filenames. Each filename's
> contents is
> +additional configuration that is inserted into the top of the
> configuration
> +file.
> +
> +@item @code{matches} default:
> +
> +@lisp
> +    (list (opensmtpd-match
> +           (action (opensmtpd-local-delivery
> +                    (name "local")
> +                    (method "mbox")))
> +           (for (opensmtpd-option
> +                 (option "for local"))))
> +          (opensmtpd-match
> +           (action (opensmtpd-relay
> +                    (name "outbound")))
> +           (from (opensmtpd-option
> +                  (option "from local")))
> +           (for (opensmtpd-option
> +                 (option "for any")))))
> +@end lisp
> +
> +@code{matches} is a list of @code{<opensmtpd-match>} records, which
> +matches incoming mail and sends it to a correspending action. The
> match
> +records are evaluated sequentially, with the first match winning. If
> an
> +incoming mail does not match any match records, then it is rejected.
> +@c put this backin? @end itemize
> +
> +@c put this back in? @itemize
> +@item @code{mta-max-deferred} (default: @code{100})
> +
> +When delivery to a given host is suspended due to temporary
> failures, cache
> +at most number envelopes for that host such that they can be
> delivered as
> +soon as another delivery succeeds to that host. The default is 100.
> +
> +@item @code{queue} (default: @code{#f})
> +
> +@code{queue} expects an @code{<opensmtpd-queue>} record. With it,
> one may
> +compress and encrypt queue-ed emails as well as set the default
> expiration
> +time for temporarily undeliverable messages.
> +
> +@item @code{smtp} (default: @code{#f})
> +
> +@code{smtp} expects an @code{<opensmtpd-smtp>} record, which lets
> one
> +specifiy how large email may be along with other settings.
> +
> +@item @code{srs} (default: @code{#f})
> +
> +@code{srs} expects an @code{<opensmtpd-srs>} record, which lets one
> set
> +up SRS, the Sender Rewritting Scheme.
> +=======
>  @item @code{setgid-commands?} (default: @code{#t})
>  Make the following commands setgid to @code{smtpq} so they can be
>  executed: @command{smtpctl}, @command{sendmail}, @command{send-
> mail},
>  @command{makemap}, @command{mailq}, and @command{newaliases}.
>  @xref{Setuid Programs}, for more information on setgid programs.
> +>>>>>>> origin/master
>  @end table
>  @end deftp
>  
> +@itemize
> +@item
> +Data Type: opensmtpd-interface
> +
> +Data type representing the configuration of an
> +@code{<opensmtpd-interface>}. Listen on the fieldname
> @code{interface} for
> +incoming connections, using the same syntax as for ifconfig(8). The
> interface
> +parameter may also be an string interface group, an string IP
> address, or a
> +string domain name. Listening can optionally be restricted to a
> specific
> +address fieldname @code{family}, which can be either ``inet4'' or
> ``inet6''.
> +
> +@itemize
> +@item @code{interface} (default: ``lo'')
> +
> +The string interface to listen for incoming connections. These
> interface can
> +usually be found by the command @code{ip link}.
> +
> +@item @code{family} (default: @code{#f})
> +
> +The string IP family to use.  Valid strings are ``inet4'' or
> ``inet6''.
> +
> +@item @code{auth} (default: @code{#f})
> +
> +Support SMTPAUTH: clients may only start SMTP transactions after
> successful
> +authentication. If @code{auth} is @code{#t}, then users are
> authenticated against
> +their own normal login credentials. Alternatively @code{auth} may be
> an
> +@code{<opensmtpd-table>} whose users are authenticated against
> +their passwords.
> +
> +@item @code{auth-optional} (default: @code{#f})
> +
> +Support SMTPAUTH optionally: clients need not authenticate, but may
> do so.
> +This allows the @code{<opensmtpd-interface>} to both accept
> +incoming mail from untrusted senders and permit outgoing mail from
> +authenticated users (using @code{<opensmtpd-match>} fieldname
> +@code{auth}). It can be used in situations where it is not possible
> to listen on
> +a separate port (usually the submission port, 587) for users to
> +authenticate.
> +
> +@item @code{filters} (default: @code{#f})
> +
> +A list of one or many @code{<opensmtpd-filter>} or
> +@code{<opensmtpd-filter-phase>} records. The filters are applied
> +sequentially. These records listen and filter on connections handled
> by this
> +listener.
> +
> +@item @code{hostname} (default: @code{#f})
> +
> +Use string ``hostname'' in the greeting banner instead of the
> default server
> +name.
> +
> +@item @code{hostnames} (default: @code{#f})
> +
> +Override the server name for specific addresses. Use a
> +@code{<opensmtpd-table>} containing a mapping of string IP
> +addresses to hostnames. If the address on which the connection
> arrives
> +appears in the mapping, the associated hostname is used.
> +
> +@item @code{mask-src} (default: @code{#f})
> +
> +If @code{#t}, then omit the from part when prepending “Received”
> headers.
> +
> +@item @code{disable-dsn} (default: @code{#f})
> +
> +When @code{#t}, then disable the DSN (Delivery Status Notification)
> extension.
> +
> +@item @code{pki} (default: @code{#f})
> +
> +For secure connections, use an @code{<opensmtpd-pki>}
> +to prove a mail server's identity.
> +
> +@item @code{port} (default: @code{#f})
> +
> +Listen on the integer port instead of the default port of 25.
> +
> +@item @code{proxy-v2} (default: @code{#f})
> +
> +If @code{#t}, then support the PROXYv2 protocol, rewriting
> appropriately source
> +address received from proxy.
> +
> +@item @code{received-auth} (default: @code{#f})
> +
> +If @code{#t}, then in “Received” headers, report whether the session
> was
> +authenticated and by which local user.
> +
> +@item @code{senders} (default: @code{#f})
> +
> +Look up the authenticated user in the supplied
> +@code{<opensmtpd-table>} to find the email addresses that user is
> +allowed to submit mail as.
> +
> +@item @code{secure-connection} (default: @code{#f})
> +
> +This is a string of one of these options:
> +
> +@multitable {aaaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item ``smtps''
> +@tab Support SMTPS, by default on port 465.
> +@item ``tls''
> +@tab Support STARTTLS, by default on port 25.
> +@item ``tls-require-verify''
> +@tab Like tls, but force clients to establish
> +@item
> +@tab a secure connection before being allowed to
> +@item
> +@tab start an SMTP transaction.  With the verify
> +@item
> +@tab option, clients must also provide a valid
> +@item
> +@tab certificate to establish an SMTP session.
> +@end multitable
> +
> +@item @code{tag} (default: @code{#f})
> +
> +Clients connecting to the listener are tagged with the given string
> tag.
> +@end itemize
> +
> +@item Data Type: opensmtpd-socket
> +
> +Data type representing the configuration of an
> +@code{<opensmtpd-socket>}. Listen for incoming SMTP
> +connections on the Unix domain socket @samp{/var/run/smtpd.sock}.
> This is done by
> +default, even if the directive is absent.
> +
> +@itemize
> +@item @code{filters} (default: @code{#f})
> +
> +A list of one or many @code{<opensmtpd-filter>} or
> +@code{<opensmtpd-filter-phase>} records. These filter incoming
> +connections handled by this listener.
> +
> +@item @code{mask-src} (default: @code{#f})
> +
> +If @code{#t}, then omit the from part when prepending “Received”
> headers.
> +
> +@item @code{tag} (default: @code{#f})
> +
> +Clients connecting to the listener are tagged with the given string
> tag.
> +@end itemize
> +
> +@item Data Type: opensmtpd-match
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-match>} record.
> +
> +If at least one mail envelope matches the options of one match
> record, receive
> +the incoming message, put a copy into each matching envelope, and
> atomically
> +save the envelopes to the mail spool for later processing by the
> respective
> +@code{<opensmtpd-action>} found in fieldname @code{action}.
> +
> +@itemize
> +@item @code{action} (default: @code{#f})
> +
> +If mail matches this match configuration, then do this action. Valid
> values
> +include @code{<opensmtpd-local-delivery>} or
> +@code{<opensmtpd-relay>}.
> +
> +@item @code{options} (default: @code{#f}) @code{<opensmtpd-option>}
> +The fieldname 'option' is a list of unique
> +@code{<opensmtpd-option>} records.
> +
> +Each @code{<opensmtpd-option>} record's fieldname 'option' has some
> +mutually exclusive options: there can be only one ``for'' and only
> one ``from'' option.
> +
> +@multitable {aaaaaaaaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@headitem for
> +@tab from
> +@item only use one of the following:
> +@tab only use one of the following:
> +@item ``for any''
> +@tab ``from any''
> +@item ``for local''
> +@tab ``from auth''
> +@item ``for domain''
> +@tab ``from local''
> +@item ``for rcpt-to''
> +@tab ``from mail-from''
> +@item
> +@tab ``from socket''
> +@item
> +@tab ``from src''
> +@end multitable
> +
> +The following matching options are supported and can all be negated
> (via not
> +#t). The options that support a table (anything surrounded with '<'
> and '>'
> +eg: <table>), also support specifying regex via (regex #t).
> +
> +@itemize
> +@item @samp{for any}
> +
> +Specify that session may address any destination.
> +
> +@item @samp{for local}
> +
> +Specify that session may address any local domain.  This is the
> default,
> +and may be omitted.
> +
> +@item @samp{for domain _domain_ | <domain>}
> +
> +Specify that session may address the string or list table domain.
> +
> +@item @samp{for rcpt-to _recipient_ | <recipient>}
> +
> +Specify that session may address the string or list table recipient.
> +
> +@item @samp{from any}
> +
> +Specify that session may originate from any source.
> +
> +@item @samp{from auth}
> +
> +Specify that session may originate from any authenticated user, no
> matter
> +the source IP address.
> +
> +@item @samp{from auth _user_ | <user>}
> +
> +Specify that session may originate from authenticated user or user
> list
> +user, no matter the source IP address.
> +
> +@item @samp{from local}
> +
> +Specify that session may only originate from a local IP address, or
> from
> +the local enqueuer.  This is the default, and may be omitted.
> +
> +@item @samp{from mail-from _sender_ | <sender>}
> +
> +Specify that session may originate from sender or table sender, no
> +matter the source IP address.
> +
> +@item @samp{from rdns}
> +
> +Specify that session may only originate from an IP address that
> resolves
> +to a reverse DNS@.
> +
> +@item @samp{from rdns _hostname_ | <hostname>}
> +
> +Specify that session may only originate from an IP address that
> resolves
> +to a reverse DNS matching string or list string hostname.
> +
> +@item @samp{from socket}
> +
> +Specify that session may only originate from the local enqueuer.
> +
> +@item @samp{from src _address_ | <address>}
> +
> +Specify that session may only originate from string or list table
> address
> +which can be a specific address or a subnet expressed in CIDR-
> notation.
> +
> +@item @samp{auth}
> +
> +Matches transactions which have been authenticated.
> +
> +@item @samp{auth _username_ | <username>}
> +
> +Matches transactions which have been authenticated for user or user
> list
> +username.
> +
> +@item @samp{helo _helo-name_ | <helo-name>}
> +
> +Specify that session's HELO / EHLO should match the string or list
> table
> +helo-name.
> +
> +@item @samp{mail-from _sender_ | <sender>}
> +
> +Specify that transactions's MAIL FROM should match the string or
> list
> +table sender.
> +
> +@item @samp{rcpt-to _recipient_ | <recipient>}
> +
> +Specify that transaction's RCPT TO should match the string or list
> table
> +recipient.
> +
> +@item @samp{tag tag}
> +Matches transactions tagged with the given tag.
> +
> +@item @samp{tls}
> +Specify that transaction should take place in a TLS channel.
> +@end itemize
> +
> +Here is a simple example:
> +@lisp
> +    (opensmtpd-option
> +     (not #t)
> +     (regex #f)
> +     (option "for domain")
> +     (data (opensmtpd-table
> +            (name "domain-table")
> +            (data (list "gnu.org" "dismail.de")))))
> +@end lisp
> +
> +The mail must NOT come from the domains @samp{gnu.org} or
> @samp{dismail.de}.
> +
> +@item Data Type: opensmtpd-option
> +@end itemize
> +
> +@item Data Type: opensmtpd-local-delivery
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-local-delivery>} record.
> +
> +@itemize
> +@item
> +@code{name} (default: @code{#f})
> +
> +@code{name} is the string name of the relay action.
> +
> +@item @code{method} (default: @code{"mbox"})
> +
> +The email delivery option.  Valid options are:
> +
> +@itemize
> +@item @code{"mbox"}
> +
> +Deliver the message to the user's mbox with mail.local(8).
> +
> +@item @code{"expand-only"}
> +
> +Only accept the message if a delivery method was specified in an
> aliases
> +or .forward file.
> +
> +@item @code{"forward-only"}
> +
> +Only accept the message if the recipient results in a remote address
> after
> +the processing of aliases or forward file.
> +
> +@item @code{<opensmtpd-lmtp>}
> +
> +Deliver the message to an LMTP server at
> +@code{<opensmtpd-lmtp>}'s fieldname @code{destination}. The location
> +may be expressed as string host:port or as a UNIX socket.
> Optionally,
> +@code{<opensmtpd-lmtponfiguration>}'s fieldname @code{rcpt-to} might
> be specified
> +to use the recipient email address (after expansion) instead of the
> local
> +user in the LMTP session as RCPT TO@.
> +
> +@item @code{<opensmtpd-maildir>}
> +
> +Deliver the message to the maildir in
> +@code{<opensmtpd-maildir>}'s fieldname @code{pathname} if specified,
> +or by default to @samp{~/Maildir}.
> +
> +The pathname may contain format specifiers that are expanded before
> use
> +(see the below section about Format Specifiers).
> +
> +If @code{<opensmtpd-maildir>}'s record fieldname @code{junk} is
> @code{#t},
> +then message will be moved to the ‘Junk’ folder if it contains a
> positive
> +‘X-Spam’ header. This folder will be created under fieldname
> @code{pathname} if
> +it does not yet exist.
> +
> +@item @code{<opensmtpd-mda>}
> +
> +Delegate the delivery to the @code{<opensmtpd-mda>}'s fieldname
> +@code{command} (type string) that receives the message on its
> standard input.
> +
> +The @code{command} may contain format specifiers that are expanded
> before use
> +(see Format Specifiers).
> +@end itemize
> +
> +@item @code{alias} (default: @code{#f})
> +
> +Use the mapping table for aliases expansion. @code{alias} is an
> +@code{<opensmtpd-table>}.
> +
> +@item @code{ttl} (default: @code{#f})
> +
> +@code{ttl} is a string specify how long a message may remain in the
> queue.  It's
> +format is @samp{n@{s|m|h|d@}}.  eg: ``4m'' is four minutes.
> +
> +@item @code{user} (default: @code{#f} )
> +
> +@code{user} is the string username for performing the delivery, to
> be looked up
> +with getpwnam(3).
> +
> +This is used for virtual hosting where a single username is in
> charge of
> +handling delivery for all virtual users.
> +
> +This option is not usable with the mbox delivery method.
> +
> +@item @code{userbase} (default: @code{#f})
> +
> +@code{userbase} is an @code{<opensmtpd-table>} record for mapping
> user
> +lookups instead of the getpwnam(3) function.
> +
> +The fieldnames @code{user} and @code{userbase} are mutually
> exclusive.
> +
> +@item @code{virtual} (default: @code{#f})
> +
> +@code{virtual} is an @code{<opensmtpd-table>} record is used for
> virtual
> +expansion.
> +@end itemize
> +
> +@item Data Type: opensmtpd-relay
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-relay>} record.
> +
> +@itemize
> +@item @code{name} (default: @code{#f})
> +
> +@code{name} is the string name of the relay action.
> +
> +@item @code{backup} (default: @code{#f})
> +
> +When @code{#t}, operate as a backup mail exchanger delivering
> messages to any
> +mail exchanger with higher priority.
> +
> +@item @code{backup-mx} (default: @code{#f})
> +
> +Operate as a backup mail exchanger delivering messages to any mail
> exchanger
> +with higher priority than mail exchanger identified as string name.
> +
> +@item @code{helo} (default: @code{#f})
> +
> +Advertise string heloname as the hostname to other mail exchangers
> during
> +the HELO phase.
> +
> +@item @code{helo-src} (default: @code{#f} )
> +
> + Use the mapping @code{<opensmtpd-table>} to look up a hostname
> +matching the source address, to advertise during the HELO phase.
> +
> +@item @code{domain} (default: @code{#f})
> +
> +Do not perform MX lookups but look up destination domain in an
> +@code{<opensmtpd-table>} and use matching relay url as relay host.
> +
> +@item @code{host} (default: @code{#f})
> +
> +Do not perform MX lookups but relay messages to the relay host
> described by
> +the string relay-url. The format for relay-url is
> +@samp{[proto://[label@@]]host[:port]}. The following protocols are
> available:
> +
> +@multitable {aaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item smtp
> +@tab Normal SMTP session with opportunistic STARTTLS (the default).
> +@item smtp+tls
> +@tab Normal SMTP session with mandatory STARTTLS@.
> +@item smtp+notls
> +@tab Plain text SMTP session without TLS@.
> +@item lmtp
> +@tab LMTP session.  port is required.
> +@item smtps
> +@tab SMTP session with forced TLS on connection, default port is
> +@item
> +@tab 465.
> +@end multitable
> +
> +Unless noted, port defaults to 25.
> +
> +The label corresponds to an entry in a credentials table, as
> documented in
> +@samp{table(5)}. It is used with the @samp{"smtp+tls"} and
> @samp{"smtps"} protocols for
> +authentication. Server certificates for those protocols are verified
> by
> +default.
> +
> +@item @code{pki} (default: @code{#f})
> +
> +For secure connections, use the certificate associated with
> +@code{<opensmtpd-pki>} (declared in a pki directive) to prove the
> +client's identity to the remote mail server.
> +
> +@item @code{srs} (default: @code{#f})
> +
> +If @code{#t}, then when relaying a mail resulting from a forward,
> use the Sender
> +Rewriting Scheme to rewrite sender address.
> +
> +@item @code{tls} (default: @code{#f}) boolean or string ``no-
> verify''
> +
> +When @code{#t}, Require TLS to be used when relaying, using
> mandatory STARTTLS by
> +default. When used with a smarthost, the protocol must not be
> +@samp{"smtp+notls://"}. When string @code{"no-verify"}, then do not
> require a valid
> +certificate.
> +
> +@item @code{auth} (default: @code{#f}) @code{<opensmtpd-table>}
> +
> +Use the alist @code{<opensmtpd-table>} for connecting to relay-url
> +using credentials. This option is usable only with fieldname
> @code{host} option.
> +
> +@item @code{mail-from} (default: @code{#f}) string
> +
> +Use the string mailaddress as MAIL FROM address within the SMTP
> transaction.
> +
> +@item @code{src} (default: @code{#f}) string | @code{<opensmtpd-
> table>}
> +
> +Use the string or @code{<opensmtpd-table>} sourceaddr for the
> +source IP address, which is useful on machines with multiple
> interfaces. If
> +the list contains more than one address, all of them are used in
> such a way
> +that traffic is routed as efficiently as possible.
> +@end itemize
> +
> +@item Data Type: opensmtpd-filter
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-filter>}. This is the filter record one should use
> +if they want to use an external package to filter email eg: rspamd
> or
> +spamassassin.
> +
> +@itemize
> +@item @code{name} (default: @code{#f})
> +
> +The string name of the filter.
> +
> +@item @code{proc} (default: @code{#f})
> +
> +The string command or process name.  If @code{proc-exec} is
> @code{#t}, @code{proc} is
> +treated as a command to execute.  Otherwise, it is a process name.
> +
> +@item @code{proc-exec} (default: @code{#f})
> +@end itemize
> +
> +@item Data Type: opensmtpd-filter-phase
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-filter-phase>}.
> +
> +In a regular workflow, smtpd(8) may accept or reject a message based
> only on
> +the content of envelopes. Its decisions are about the handling of
> the message,
> +not about the handling of an active session.
> +
> +Filtering extends the decision making process by allowing smtpd(8)
> to stop at
> +each phase of an SMTP session, check that options are met, then
> decide if a
> +session is allowed to move forward.
> +
> +With filtering via an @code{<opensmtpd-filter-phase>} record, a
> +session may be interrupted at any phase before an envelope is
> complete. A
> +message may also be rejected after being submitted, regardless of
> whether the
> +envelope was accepted or not.
> +
> +@itemize
> +@item @code{name} (default: @code{#f})
> +
> +The string name of the filter phase.
> +
> +@item @code{phase-name} (default: @code{#f})
> +
> +The string name of the phase. Valid values are:
> +
> +@multitable {aaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item ``connect''
> +@tab upon connection, before a banner is displayed
> +@item ``helo''
> +@tab after HELO command is submitted
> +@item ``ehlo''
> +@tab after EHLO command is submitted
> +@item ``mail-from''
> +@tab after MAIL FROM command is submitted
> +@item ``rcpt-to''
> +@tab after RCPT TO command is submitted
> +@item ``data''
> +@tab after DATA command is submitted
> +@item ``commit''
> +@tab after message is fully is submitted
> +@end multitable
> +
> +@item @code{options} (default @code{#f})
> +
> +A list of unique @code{<opensmtpd-option>} records.
> +
> +At each phase, various options, specified by a list of
> +@code{<opensmtpd-option>}, may be checked. The
> +@code{<opensmtpd-option>}'s fieldname 'option' values of:
> ``fcrdns'',
> +``rdns'', and ``src'' data are available in all phases, but other
> data must have
> +been already submitted before they are available. Options with a
> @samp{<table>}
> +next to them require the @code{<opensmtpd-option>}'s fieldname
> +@code{data} to be an @code{<opensmtpd-table>}. There are the
> available
> +options:
> +
> +@multitable {aaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item fcrdns
> +@tab forward-confirmed reverse DNS is valid
> +@item rdns
> +@tab session has a reverse DNS
> +@item rdns <table>
> +@tab session has a reverse DNS in table
> +@item src <table>
> +@tab source address is in table
> +@item helo <table>
> +@tab helo name is in table
> +@item auth
> +@tab session is authenticated
> +@item auth <table>
> +@tab session username is in table
> +@item mail-from <table>
> +@tab sender address is in table
> +@item rcpt-to <table>
> +@tab recipient address is in table
> +@end multitable
> +
> +These conditions may all be negated by setting
> +@code{<opensmtpd-option>}'s fieldname @code{not} to @code{#t}.
> +
> +Any conditions that require a table may indicate that tables include
> regexs
> +setting @code{<opensmtpd-option>}'s fieldname @code{regex} to
> @code{#t}.
> +
> +@item @code{decision}
> +
> +A string decision to be taken. Some decisions require an
> @code{message} or
> +@code{value}. Valid strings are:
> +
> +@multitable {aaaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item ``bypass''
> +@tab the session or transaction bypasses filters
> +@item ``disconnect'' message
> +@tab the session is disconnected with message
> +@item ``junk''
> +@tab the session or transaction is junked, i.e., an
> +@item
> +@tab ‘X-Spam: yes’ header is added to any messages
> +@item ``reject'' message
> +@tab the command is rejected with message
> +@item ``rewrite'' value
> +@tab the command parameter is rewritten with value
> +@end multitable
> +
> +Decisions that involve a message require that the message be RFC
> valid,
> +meaning that they should either start with a 4xx or 5xx status code.
> +Descisions can be taken at any phase, though junking can only happen
> before
> +a message is committed.
> +
> +@item @code{message} (default @code{#f})
> +
> +A string message beginning with a 4xx or 5xx status code.
> +
> +@item @code{value} (default: @code{#f})
> +
> +A number value.  @code{value} and @code{message} are mutually
> exclusive.
> +@end itemize
> +
> +@item Data Type: opensmtpd-option
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-option>}, which is used by
> +@code{<opensmtpd-filter-phase>} and @code{<opensmtpd-match>}
> +to match various options for email.
> +
> +@itemize
> +@item @code{conditition} (default @code{#f})
> +
> +A string option to be taken. Some options require a string or an
> +@code{<opensmtpd-table>} via the fieldname data. When the option
> +record is used inside of an @code{<opensmtpd-filter-phase>}, then
> +valid strings are:
> +
> +At each phase, various options may be matched. The fcrdns, rdns, and
> src
> +data are available in all phases, but other data must have been
> already
> +submitted before they are available.
> +
> +@multitable {aaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item ``fcrdns''
> +@tab forward-confirmed reverse DNS is valid
> +@item ``rdns''
> +@tab session has a reverse DNS
> +@item ``rdns'' <table>
> +@tab session has a reverse DNS in table
> +@item ``src'' <table>
> +@tab source address is in table
> +@item ``helo'' <table>
> +@tab helo name is in table
> +@item ``auth''
> +@tab session is authenticated
> +@item ``auth'' <table>
> +@tab session username is in table
> +@item ``mail-from'' <table>
> +@tab sender address is in table
> +@item ``rcpt-to'' <table>
> +@tab recipient address is in table
> +@end multitable
> +
> +When @code{<opensmtpd-option>} is used inside of an
> +@code{<opensmtpd-match>}, then valid strigs for fieldname
> @code{option}
> +are: ``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'', or ``tls''.
> +
> +@item @code{data} (default @code{#f}) @code{<opensmtpd-table>}
> +
> +Some options require a table to be present. One would specify that
> table
> +here.
> +@item @code{regex} (default: @code{#f}) boolean
> +
> +Any options using a table may indicate that tables hold regex by
> +prefixing the table name with the keyword regex.
> +
> +@item @code{not} (default: @code{#f}) boolean
> +
> +When @code{#t}, this option record is negated.
> +@end itemize
> +
> +@item Data Type: opensmtpd-table
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-table>}.
> +
> +@itemize
> +@item @code{name} (default @code{#f})
> +
> +@code{name} is the name of the @code{<opensmtpd-table>} record.
> +
> +@item @code{data} (default: @code{#f})
> +
> +@code{data} expects a list of strings or an alist, which is a list
> of
> +cons cells.  eg: @code{(data (list ("james" . "password")))} OR
> +@code{(data (list ("gnu.org" "fsf.org")))}.
> +@end itemize
> +
> +@item Data Type: opensmtpd-pki
> +
> +This data type represents the configuration of an
> +@code{<opensmtpd-pki>}.
> +
> +@itemize
> +@item @code{domain} (default @code{#f})
> +
> +@code{domain} is the string name of the @code{<opensmtpd-pki>}
> record.
> +
> +@item @code{cert} (default: @code{#f})
> +
> +@code{cert} (default: @code{#f})
> +
> +@code{cert} is the string certificate filename to use for this pki.
> +
> +@item @code{key} (default: @code{#f})
> +
> +@code{key} is the string certificate falename to use for this pki.
> +
> +@item @code{dhe} (default: @code{"none"})
> +
> +Specify the DHE string parameter to use for DHE cipher suites with
> host
> +pkiname. Valid parameter values are ``none'', ``legacy'', or
> ``auto''. For ``legacy'', a
> +fixed key length of 1024 bits is used, whereas for ``auto'', the key
> length is
> +determined automatically. The default is ``none'', which disables
> DHE cipher
> +suites.
> +@end itemize
> +
> +@item Data Type: opensmtpd-maildir
> +
> +@itemize
> +@item @code{pathname} (default: @code{"~/Maildir"})
> +
> +Deliver the message to the maildir if pathname if specified, or by
> default
> +to @samp{~/Maildir}.
> +
> +The pathname may contain format specifiers that are expanded before
> use
> +(see FORMAT SPECIFIERS).
> +
> +@item @code{junk} (default: @code{#f})
> +
> +If the junk argument is @code{#t}, then the message will be moved to
> the @samp{‘Junk’}
> +folder if it contains a positive @samp{‘X-Spam’} header. This folder
> will be
> +created under pathname if it does not yet exist.
> +@end itemize
> +
> +@item Data Type: opensmtpd-mda
> +
> +@itemize
> +@item @code{name}
> +
> +The string name for this MDA command.
> +
> +@item @code{command}
> +
> +Delegate the delivery to a command that receives the message on its
> standard
> +input.
> +
> +The command may contain format specifiers that are expanded before
> use (see
> +FORMAT SPECIFIERS).
> +@end itemize
> +
> +@item Data Type: opensmtpd-queue
> +
> +@itemize
> +@item @code{compression} (default @code{#f})
> +
> +Store queue files in a compressed format. This may be useful to save
> disk
> +space.
> +
> +@item @code{encryption} (default @code{#f})
> +
> +Encrypt queue files with EVP@math{_aes}@math{_256}@math{_gcm}(3). If
> no key is specified, it is
> +read with getpass(3). If the string stdin or a single dash (‘-’) is
> given
> +instead of a key, the key is read from the standard input.
> +
> +@item @code{ttl-delay} (default @code{#f})
> +
> +Set the default expiration time for temporarily undeliverable
> messages,
> +given as a positive decimal integer followed by a unit s, m, h, or
> d. The
> +default is four days (``4d'').
> +@end itemize
> +
> +@item Data Type: opensmtpd-smtp
> +
> +Data type representing an @code{<opensmtpd-smtp>} record.
> +
> +@itemize
> +@item @code{ciphers} (default: @code{#f})
> +
> +Set the control string for
> SSL@math{_CTX}@math{_set}@math{_cipher}@math{_list}(3).  The default
> is
> +         ``HIGH:!aNULL:!MD5''.
> +
> +@item @code{limit-max-mails} (default: @code{100})
> +
> +Limit the number of messages to count for each sessio
> +
> +@item @code{limit-max-rcpt} (default: @code{1000})
> +
> +Limit the number of recipients to count for each transaction.
> +
> +@item @code{max-message-size} (default: @code{35M})
> +
> +Reject messages larger than size, given as a positive number of
> bytes or as
> +a string to be parsed with scan@math{_scaled}(3).
> +
> +@item @code{sub-addr-delim character} (default: @code{+})
> +
> +When resolving the local part of a local email address, ignore the
> ASCII
> +character and all characters following it. This is helpful for email
> +filters. @samp{"admin+bills@@gnu.org"} is the same email address as
> +@samp{"admin@@gnu.org"}. BUT an email filter can filter emails
> addressed to first
> +email address into a 'Bills' email folder.
> +@end itemize
> +
> +@item Data Type: opensmtpd-srs
> +
> +@itemize
> +@item @code{key} (default: @code{#f})
> +
> +Set the secret key to use for SRS, the Sender Rewriting Scheme.
> +
> +@item @code{backup-key} (default: @code{#f})
> +
> +Set a backup secret key to use as a fallback for SRS@. This can be
> used to
> +implement SRS key rotation.
> +
> +@item @code{ttl-delay} (default: @code{"4d"})
> +
> +Set the time-to-live delay for SRS envelopes. After this delay, a
> bounce
> +reply to the SRS address will be discarded to limit risks of forged
> +addresses.
> +@end itemize
> +
> +@item Format Specifiers
> +
> +Some configuration records support expansion of their parameters at
> +runtime. Such records (for example
> +@code{<opensmtpd-maildir>}, @code{<opensmtpd-mda>}) may use
> +format specifiers which are expanded before delivery or relaying.
> The
> +following formats are currently supported:
> +
> +@multitable {aaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item @samp{%@{sender@}}
> +@tab sender email address, may be empty string
> +@item @samp{%@{sender.user@}}
> +@tab user part of the sender email address, may be empty
> +@item @samp{%@{sender.domain@}}
> +@tab domain part of the sender email address, may be empty
> +@item @samp{%@{rcpt@}}
> +@tab recipient email address
> +@item @samp{%@{rcpt.user@}}
> +@tab user part of the recipient email address
> +@item @samp{%@{rcpt.domain@}}
> +@tab domain part of the recipient email address
> +@item @samp{%@{dest@}}
> +@tab recipient email address after expansion
> +@item @samp{%@{dest.user@}}
> +@tab user part after expansion
> +@item @samp{%@{dest.domain@}}
> +@tab domain part after expansion
> +@item @samp{%@{user.username@}}
> +@tab local user
> +@item @samp{%@{user.directory@}}
> +@tab home directory of the local user
> +@item @samp{%@{mbox.from@}}
> +@tab name used in mbox From separator lines
> +@item @samp{%@{mda@}}
> +@tab mda command, only available for mda wrappers
> +@end multitable
> +
> +Expansion formats also support partial expansion using the optional
> bracket notations
> +with substring offset.  For example, with recipient domain
> @samp{“example.org”}:
> +
> +@multitable {aaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaa}
> +@item @samp{%@{rcpt.domain[0]@}}
> +@tab expands to “e”
> +@item @samp{%@{rcpt.domain[1]@}}
> +@tab expands to “x”
> +@item @samp{%@{rcpt.domain[8:]@}}
> +@tab expands to “org”
> +@item @samp{%@{rcpt.domain[-3:]@}}
> +@tab expands to “org”
> +@item @samp{%@{rcpt.domain[0:6]@}}
> +@tab expands to “example”
> +@item @samp{%@{rcpt.domain[0:-4]@}}
> +@tab expands to “example”
> +@end multitable
> +
> +In addition, modifiers may be applied to the token.  For example,
> with recipient
> +@samp{“User+Tag@@Example.org”}:
> +
> +@multitable {aaaaaaaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item @samp{%@{rcpt:lowercase@}}
> +@tab expands to “user+tag@@example.org”
> +@item @samp{%@{rcpt:uppercase@}}
> +@tab expands to “USER+TAG@@EXAMPLE.ORG”
> +@item @samp{%@{rcpt:strip@}}
> +@tab expands to “User@@Example.org”
> +@item @samp{%@{rcpt:lowercasestrip@}}
> +@tab expands to “user@@example.org”
> +@end multitable
> +
> +For security concerns, expanded values are sanitized and potentially
> dangerous
> +characters are replaced with ‘:’. In situations where they are
> desirable, the
> +“raw” modifier may be applied. For example, with recipient
> +@samp{“user+t?g@@example.org”}:
> +
> +@multitable {aaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
> +@item @samp{%@{rcpt@}}
> +@tab expands to “user+t:g@@example.org”
> +@item @samp{%@{rcpt:raw@}}
> +@tab expands to “user+t?g@@example.org”
> +@end multitable
> +@end itemize
> +
>  @subsubheading Exim Service
>  
>  @cindex mail transfer agent (MTA)
> diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
> index 43f144a42d..d86e083d19 100644
> --- a/gnu/services/mail.scm
> +++ b/gnu/services/mail.scm
> @@ -58,10 +58,146 @@ (define-module (gnu services mail)
>              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-service-type
> -            %default-opensmtpd-config-file
> +            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
>  
> @@ -1641,22 +1777,1942 @@ (define (generate-dovecot-documentation)
>         (listeners unix-listener-configuration fifo-listener-
> configuration
>                    inet-listener-configuration))
>        (protocol-configuration ,protocol-configuration-fields))
> -  'dovecot-configuration))
> +   'dovecot-configuration))
>  
>  
>  ;;;
>  ;;; 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))))
That's a rather crude way of sanitizing.  You should probably raise a
formatted-message or similar.  I'd also curry this as follows:

(define (((expect-any predicates) record field) var)
  (if (any (cute <> var) predicates)
      var
      (do-the-exception-raising)))

where do-the-exception-raising contains all the formatting stuff etc.
that I skipped for the sake of simplicity.

Then you can define (expect-string-or-#f) and whatever else you need
quite simply.

> +;; Some example opensmtpd-tables:
> +;;
> +;;  (opensmtpd-table (name "root accounts") (data '(("joshua" .
> "[email-masked]") ("joshua" . "[email-masked]"))))
> +;;  (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 =
> [email-masked],[email-masked],[email-masked], root =
> [email-masked] }
> +  ;; 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" . "[email-masked]") ("james" .
> "[email-masked]"))
> +  ;; 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)))))))
You might want to reduce horizontal space here, even if guix style
tells you otherwise.
> +  (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))
> +  (package opensmtpd-configuration-package
> +           (default opensmtpd))
>    (config-file opensmtpd-configuration-config-file
> -               (default %default-opensmtpd-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
> @@ -1668,7 +3724,7 @@ (define %default-opensmtpd-config-file
>  match from local for any action outbound
>  "))
>  
> -(define opensmtpd-shepherd-service
> +(define (opensmtpd-shepherd-service config)
>    (match-lambda
>      (($ <opensmtpd-configuration> package config-file)
>       (list (shepherd-service
> @@ -1677,7 +3733,8 @@ (define opensmtpd-shepherd-service
>              (documentation "Run the OpenSMTPD daemon.")
>              (start (let ((smtpd (file-append package
> "/sbin/smtpd")))
>                       #~(make-forkexec-constructor
> -                        (list #$smtpd "-f" #$config-file)
> +                        (list #$smtpd "-f" (or #$config-file
> +                                               #$(opensmtpd-
> configuration->mixed-text-file config)))
>                          #:pid-file "/var/run/smtpd.pid")))
>              (stop #~(make-kill-destructor)))))))
>  
> @@ -1700,10 +3757,11 @@ (define %opensmtpd-accounts
>           (home-directory "/var/empty")
>           (shell (file-append shadow "/sbin/nologin")))))
>  
> -(define opensmtpd-activation
> +(define (opensmtpd-activation config)
>    (match-lambda
>      (($ <opensmtpd-configuration> package config-file)
> -     (let ((smtpd (file-append package "/sbin/smtpd")))
> +     (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.
> @@ -1711,7 +3769,12 @@ (define opensmtpd-activation
>             (mkdir-p "/var/spool/smtpd")
>             (chmod "/var/spool/smtpd" #o711)
>             (mkdir-p "/var/spool/mail")
> -           (chmod "/var/spool/mail" #o711))))))
> +           (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")))
> diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
> index f13751b72f..1bac9f50a2 100644
> --- a/gnu/tests/mail.scm
> +++ b/gnu/tests/mail.scm
> @@ -37,6 +37,7 @@ (define-module (gnu tests mail)
>    #:use-module (guix gexp)
>    #:use-module (guix store)
>    #:use-module (ice-9 ftw)
> +  #:use-module (srfi srfi-64)
>    #:export (%test-opensmtpd
>              %test-exim
>              %test-dovecot
> @@ -165,6 +166,360 @@ (define %test-opensmtpd
>     (description "Send an email to a running OpenSMTPD server.")
>     (value (run-opensmtpd-test))))
>  
> +;; trying to create a bad record, should result in an error.
> +;; this function should be able return, instead it should throw an
> error
> +(define (create-bad-record record)
> +  ;; TODO why is this not working
> +  (with-output-to-port (%make-void-port "w")
> +    (lambda () (when record #f))))
> +
> +;; if this caller function is reached, then trying to create the bad
> record
> +;; resulted in an error.  So return true.
> +(define (return-true error arg)
> +  #t)
> +
> +;; two filters with the same name
> +(define (bad-interface1)
> +  (create-bad-record
> +   (opensmtpd-interface
> +    (interface "lo")
> +    (filters (list
> +              (opensmtpd-filter
> +               (name "dkimsign")
> +               (exec #t)
> +               (proc (list (file-append opensmtpd-filter-dkimsign
> "/libexec/opensmtpd/filter-dkimsign")
> +                           " -d gnucode.me -s 2021-09-22 -c
> relaxed/relaxed -k "
> +                           "rando string"
> +                           "/etc/dkim/private.key "
> +                           "user nobody group nogroup")))
> +              (opensmtpd-filter
> +               (name "dkimsign")
> +               (exec #t)
> +               (proc (list (file-append opensmtpd-filter-dkimsign
> "/libexec/opensmtpd/filter-dkimsign")
> +                           " -d gnucode.me -s 2021-09-22 -c
> relaxed/relaxed -k "
> +                           "/etc/dkim/private.key "
> +                           "user nobody group nogroup"))))))))
> +
> +;; duplicate filter names
> +(define (bad-interface2)
> +  (create-bad-record
> +   (opensmtpd-interface
> +    (filters (list
> +              (opensmtpd-filter-phase
> +               (name "src")
> +               (phase "connect")
> +               (options
> +                (list
> +                 (opensmtpd-option
> +                  (option "fcrdns")
> +                  (not #t))))
> +               (decision "junk"))
> +              (opensmtpd-filter-phase
> +               (name "src")
> +               (phase "helo")
> +               (options
> +                (list
> +                 (opensmtpd-option
> +                  (option "rdns")
> +                  (not #t))))
> +               (decision "junk")))))))
> +
> + ;; improper phase name
> +(define (bad-filter-phase1)
> +    (create-bad-record
> +     (opensmtpd-filter-phase
> +      (name "filter")
> +      (phase "wrongString")
> +      (decision "bypass")
> +      (options
> +       (list
> +        (opensmtpd-option
> +         (option "auth")))))))
> +
> +;; decision reject requires you to have a
> +;; corresponding fieldname 'message' with value of string.
> +(define (bad-filter-phase2)
> +  (create-bad-record
> +   (opensmtpd-interface
> +    (filters (list
> +              (opensmtpd-filter-phase
> +               (name "src")
> +               (phase "connect")
> +               (options
> +                (list
> +                 (opensmtpd-option
> +                  (option "src")
> +                  (data (opensmtpd-table
> +                         (name "src-table")
> +                         (data (list "cat" "hat")))))))
> +               (decision "reject")))))))
> +
> +;; message needs to start with 4xx or 5xx
> +(define (bad-filter-phase3)
> +  (create-bad-record
> +   (opensmtpd-interface
> +    (filters (list
> +              (opensmtpd-filter-phase
> +               (name "src")
> +               (phase "connect")
> +               (options
> +                (list
> +                 (opensmtpd-option
> +                  (option "src")
> +                  (data (opensmtpd-table
> +                         (name "src-table")
> +                         (data (list "cat" "hat")))))))
> +               (decision "reject")
> +               (message "322 Bad data!")))))))
> +
> + ;; there needs to be a value here.  rewrite requires a value!
> +(define (bad-filter-phase4)
> +  (create-bad-record
> +   (opensmtpd-interface
> +    (filters
> +     (list
> +      (opensmtpd-filter-phase
> +       (name "noFRDNS")
> +       (phase "commit")
> +       (options (list (opensmtpd-option
> +                       (option "fcrdns")
> +                       (not #t))))
> +       (decision "rewrite"))
> +      )))))
> +
> +;; fieldname 'decision' with value "junk" or "bypass", then
> fieldname 'message' and 'value'
> +;; must NOT be defined
> +(define (bad-filter-phase5)
> +  (create-bad-record
> +   (opensmtpd-interface
> +    (filters
> +     (list
> +      (opensmtpd-filter-phase
> +       (name "noFRDNS")
> +       (phase "commit")
> +       (options (list (opensmtpd-option
> +                       (option "fcrdns")
> +                       )))
> +       (decision "junk")
> +       (message "This is not a good email.")))))))
> +
> +;; you cannot junk on phase commit.  You need to use an eariler
> phase.
> +(define (bad-filter-phase6)
> +  (create-bad-record
> +   (opensmtpd-interface
> +    (filters
> +     (list
> +      (opensmtpd-filter-phase
> +       (name "junk-after-commit")
> +       (options (list (opensmtpd-option
> +                       (option "fcrdns"))))
> +       (phase "commit")
> +       (decision "junk")))))))
> +
> +;; TODO fix this test
> +;; two fcrdns options records
> +(define (bad-filter-phase7)
> +  (create-bad-record
> +   (opensmtpd-filter-phase
> +    (name "invalid-fcrdns")
> +    (phase "connect")
> +    (options
> +     (list (opensmtpd-option
> +            (option "fcrdns")
> +            (not #t))
> +           (opensmtpd-option
> +            (option "fcrdns")
> +            (not #f))))
> +    (decision "reject")
> +    (message "422 No valid fcrdns."))))
> +
> +;; option src requires a table
> +;; TODO maybe check for other options requiring a table
> +(define (bad-filter-phase8)
> +  (create-bad-record
> +   (opensmtpd-filter-phase
> +    (name "filter")
> +    (phase "helo")
> +    (decision "bypass")
> +    (options
> +     (list
> +      (opensmtpd-option
> +       (option "src")))))))
> +
> +;; option fcrdns cannot have data defined.
> +(define (bad-filter-phase9)
> +  (create-bad-record
> +   (opensmtpd-filter-phase
> +    (name "filter")
> +    (phase "helo")
> +    (decision "bypass")
> +    (options
> +     (list
> +      (opensmtpd-option
> +       (option "fcrdns")
> +       (data (opensmtpd-table
> +               (name "table")
> +               (data (list "hello" "cat"))))))))))
> +
> +
> +;; this should be (list ...) instead of '( ...)
> +(define (bad-match1)
> +  (create-bad-record
> +   (opensmtpd-match
> +    (options
> +     '((opensmtpd-option
> +        (option "for any"))))
> +    (action
> +     (opensmtpd-relay)))))
> +
> +
> +;; duplcate "for" options
> +(define (bad-match2)
> +  (create-bad-record
> +   (opensmtpd-match
> +            (options (list
> +                      (opensmtpd-option
> +                       (option "for any"))
> +                      (opensmtpd-option
> +                       (option "for local"))))
> +            (action
> +             (opensmtpd-relay
> +              (name "relay"))))))
> +
> +;; duplicate froms
> +(define (bad-match3)
> +  (create-bad-record
> +   (opensmtpd-match
> +    (options (list
> +              (opensmtpd-option
> +               (option "from any"))
> +              (opensmtpd-option
> +               (option "from auth"))))
> +    (action
> +     (opensmtpd-relay
> +      (name "relay"))))))
> +
> +;; rcpt-to must have a data field.
> +(define (bad-match4)
> +  (create-bad-record
> +   (opensmtpd-match
> +    (options (list
> +              (opensmtpd-option
> +               (option "rcpt-to"))))
> +    (action
> +     (opensmtpd-relay
> +      (name "relay"))))))
> +
> +;; option 'tls' cannot have fieldname
> +;; 'data' defined.
> +(define (bad-match5)
> +  (create-bad-record
> +   (opensmtpd-match
> +    (options (list
> +              (opensmtpd-option
> +               (option "tls")
> +               (data "hello"))))
> +    (action
> +     (opensmtpd-relay
> +      (name "relay"))))))
> +
> +;; for any cannot have data
> +;; or regex defined
> +(define (bad-match6)
> +  (create-bad-record
> +   (opensmtpd-match
> +    (options (list
> +              (opensmtpd-option
> +               (option "for any")
> +               (regex #t))))
> +    (action
> +     (opensmtpd-relay
> +      (name "relay"))))))
> +
> +;; match needs an action
> +(define (bad-match7)
> +  (create-bad-record
> +   (opensmtpd-match
> +    (options (list
> +              (opensmtpd-option
> +               (option "from auth")))))))
> +
> +(define (run-opensmtpd-record-sanitation-test)
> +                                        ;(with-output-to-port
> (%make-void-port "w")
> +                                        ;  (lambda ()
> +  (test-begin "run-opensmtpd-record-sanitation-test")
> +
> +  ;; TODO fix me!
> +  (test-assert "Test <interface> fieldname 'filters' has two filters
> with the same name."
> +    (catch #t bad-interface1 return-true))
> +
> +  (test-assert "Test <interface> cannot have two filters with the
> same name."
> +               (catch #t bad-interface2 return-true))
> +
> +  (test-assert "Test <filter-phase> fieldname 'phase' the right
> string."
> +    (catch #t bad-filter-phase1 return-true))
> +
> +  (test-assert "Test <filter-phase> fieldname 'decision' w/ value
> \"reject\" and \"disconnect\" requires a 'message'."
> +    (catch #t bad-filter-phase2 return-true))
> +
> +  (test-assert (string-append  "Test <filter-phase> fieldname
> 'decision' "
> +                               "w/ value \"reject\" and
> \"disconnect\" requires a 'message'."
> +                               " The message must begin with 4xx or
> 5xx.")
> +    (catch #t bad-filter-phase3 return-true))
> +
> +  (test-assert "Test <filter-phase> fieldname 'rewrite' requires
> fieldname 'value' to have a number."
> +    (catch #t bad-filter-phase4 return-true))
> +
> +  (test-assert (string-append "Test <filter-phase> fieldname
> 'decision' with values 'junk' or 'bypass', "
> +                             "then fieldname 'message' and 'value'
> must be blank.")
> +    (catch #t bad-filter-phase5 return-true))
> +
> +  (test-assert "You cannot junk an email on phase commit."
> +    (catch #t bad-filter-phase6 return-true))
> +
> +  ;; TODO fix me!
> +  (test-assert "Test <filter-phase> has 2 duplicate options."
> +    (catch #t bad-filter-phase7 return-true))
> +
> +  (test-assert "Test <filter-phase> option 'src' requires a table."
> +    (catch #t bad-filter-phase8 return-true))
> +
> +  ;; TODO fix me!
> +  (test-assert "Test <filter-phase> option 'fcrdns' cannot have a
> table."
> +    (catch #t bad-filter-phase9 return-true))
> +
> +  (test-assert "Test <opensmtpd-match> fieldname 'options' should
> not be quoted."
> +    (catch #t bad-match1 return-true))
> +
> +  (test-assert "Test <opensmtpd-match> has duplicate 'for' options."
> +    (catch #t bad-match2 return-true))
> +
> +  (test-assert "Test <opensmtpd-match> has duplicate 'from'
> options."
> +    (catch #t bad-match3 return-true))
> +
> +  (test-assert "Test <opensmtpd-match> option 'rcpt' must have
> data."
> +    (catch #t bad-match4 return-true))
> +
> +  (test-assert "Test <opensmtpd-match> option 'tls' cannot have
> fieldname 'data' defined."
> +    (catch #t bad-match5 return-true))
> +
> +  (test-assert "Test <opensmtpd-match> option 'for any' cannot have
> fieldname 'data' defined."
> +    (catch #t bad-match6 return-true))
> +
> +  (test-assert "Test <opensmtpd-match> needs fieldname 'action'
> needs to be defined."
> +    (catch #t bad-match7 return-true))
> +
> +  (test-end "run-opensmtpd-record-sanitation-test"))
> +
> +(define %test-opensmtpd-record-sanitation
> +  (system-test
> +   (name "opensmtpdRecordSanitation")
> +   (description
> +    (string-append "<opensmtpd> has numerous sanity checks.\n"
> +                   "This checks that invalid configurations, return
> an\n"
> +                   "appropriate error.\n"))
> +   (value (run-opensmtpd-record-sanitation-test))))
> +
>  
>  (define %exim-os
>    (simple-operating-system
> 
> base-commit: 4b3493ed0156709a924f31ef4c9a5efa0815dfe8

Cheers