Message ID | a8ebf5f4f792cb98b7691c40053f30e09386b177.1666632422.git.jbranso@dismail.de |
---|---|
State | New |
Headers | show |
Series | [bug#56046,master,v2] services (opensmtpd): add opensmtpd records to enhance opensmtpd-configuration. | expand |
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" . > "root@dismail.de") ("joshua" . "postmaster@dismail.de")))) > +;; (opensmtpd-table (name "root accounts") (data (list "mysite.me" > "your-site.com"))) > +;; TODO should <opensmtpd-table> support have a fieldname 'file'? > +;; Or should I change name to name-or-file ? > +(define-record-type* <opensmtpd-table> > + opensmtpd-table make-opensmtpd-table > + opensmtpd-table? > + this-record > + (name opensmtpd-table-name ;; string > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-table" "name" (list > string?))))) > + (file-db opensmtpd-table-file-db > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-table" "file-db" > + (list boolean?))))) > + ;; FIXME support an aliasing table as described here: > + ;; https://man.openbsd.org/table.5 > + ;; One may have to use the record file for this. I don't think > tables support a table like this: > + ;; table "name" { joshua = > joshua@gnucode.me,joshua@gnu-hurd.com,joshua@propernaming.org, root = > root@gnucode.me } > + ;; If values is an absolute filename, then it will use said > filename to house the table info. > + ;; filename must be an absolute filename. > + (data opensmtpd-table-data > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-table" "values" > + (list list-of-strings? assoc- > list? file-exists?))))) > + ;; is a list of values or key values > + ;; eg: (list "mysite.me" "your-site.com") > + ;; eg: (list ("joshua" . "joshua@gnu.org") ("james" . > "james@gnu.org")) > + ;; I am currently making these values be as assocation list of > strings only. > + ;; FIXME should I allow a var like this? > + ;; (list (cons "gnucode.me" 234.949.392.23)) > + ;; can be of type: (quote list-of-strings) or (quote assoc-list) > + ;; (opensmtpd-table-type record) returns the values' type. The > user SHOULD NEVER set the type. > + ;; TODO jpoiret: on irc reccomends that I just use an outside > function to determine fieldname 'values', type. > + ;; it would be "simpler" and possibly easier for the next person > working on this code to understand what is happening. > + (type opensmtpd-table-type > + (default #f) > + (thunked) > + (sanitize (lambda (var) > + (cond ((opensmtpd-table-data this-record) > + (if (list-of-strings? (opensmtpd-table- > data this-record)) > + (quote list-of-strings) > + (quote assoc-list))) > + ((file-exists? (opensmtpd-table-data this- > record)) > + (if (opensmtpd-table-file-db this-record) > + (quote db) > + (quote file))) > + (else > + (display "opensmtpd-table-type is > broke\n") > + (throw 'bad! var))))))) > + > +(define-record-type* <opensmtpd-ca> > + opensmtpd-ca make-opensmtpd-ca > + opensmtpd-ca? > + (name opensmtpd-ca-name > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-ca" "name" (list > string?))))) > + (file opensmtpd-ca-file > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-ca" "file" (list > file-exists?)))))) > + > +(define-record-type* <opensmtpd-pki> > + opensmtpd-pki make-opensmtpd-pki > + opensmtpd-pki? > + (domain opensmtpd-pki-domain > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-pki" "domain" > (list string?))))) > + ;; TODO/FIXME this should probably be a list of files. The > opensmtpd documentation says > + ;; that you could have a list of files: > + ;; > + ;; pki pkiname cert certfile > + ;; Associate certificate file certfile with host pkiname, and use > that file to prove > + ;; the identity of the mail server to clients. pkiname is the > server's name, de‐ > + ;; rived from the default hostname or set using either > + ;; /gnu/store/2d13sdz76ldq8zgwv4wif0zx7hkr3mh2-opensmtpd- > 6.8.0p2/etc/mailname or us‐ > + ;; ing the hostname directive. If a fallback certificate or SNI > is wanted, the ‘*’ > + ;; wildcard may be used as pkiname. > + > + ;; A certificate chain may be created by appending one or many > certificates, includ‐ > + ;; ing a Certificate Authority certificate, to certfile. The > creation of certifi‐ > + ;; cates is documented in starttls(8). > + (cert opensmtpd-pki-cert > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-pki" "cert" (list > file-exists?))))) > + (key opensmtpd-pki-key > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-pki" "key" (list > file-exists?))))) > + ; todo sanitize this. valid parameters are "none", "legacy", or > "auto". > + (dhe opensmtpd-pki-dhe > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-dhe" "dhe" (list > false? string?)))))) > + > +(define-record-type* <opensmtpd-lmtp> > + opensmtpd-lmtp make-opensmtpd-lmtp > + opensmtpd-lmtp? > + (destination opensmtpd-lmtp-destination > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-lmtp" > "destination" > + (list string?))))) > + (rcpt-to opensmtpd-lmtp-rcpt-to > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-lmtp" "rcpt-to" > + (list false? string?)))))) > + > +(define-record-type* <opensmtpd-mda> > + opensmtpd-mda make-opensmtpd-mda > + opensmtpd-mda? > + (name opensmtpd-mda-name > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-mda" "name" > + (list string?))))) > + ;; TODO should I allow this command to be a gexp? > + (command opensmtpd-mda-command > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-mda" "command" > + (list string?)))))) > + > +(define-record-type* <opensmtpd-maildir> > + opensmtpd-maildir make-opensmtpd-maildir > + opensmtpd-maildir? > + (pathname opensmtpd-maildir-pathname > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-maildir" > "pathname" > + (list false? string?))))) > + (junk opensmtpd-maildir-junk > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-maildir" "junk" > + (list boolean?)))))) > + > +(define-record-type* <opensmtpd-local-delivery> > + opensmtpd-local-delivery make-opensmtpd-local-delivery > + opensmtpd-local-delivery? > + (name opensmtpd-local-delivery-name > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-local-delivery" > "name" > + (list string?))))) > + (method opensmtpd-local-delivery-method > + (default "mbox") > + (sanitize (lambda (var) > + (cond > + ((or (opensmtpd-lmtp? var) > + (opensmtpd-maildir? var) > + (opensmtpd-mda? var) > + (string=? var "mbox") > + (string=? var "expand-only") > + (string=? var "forward-only")) > + var) > + (else > + (begin > + (display (string-append "<opensmtpd-local- > delivery> fieldname 'method' must be of type \n" > + "\"mbox\", > \"expand-only\", \"forward-only\" \n" > + "<opensmtpd-lmtp>, > <opensmtpd-maildir>, \n" > + "or <opensmtpd- > mda>.\n")) > + (throw 'bad! var))))))) > + (alias opensmtpd-local-delivery-alias > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-local-delivery" > "alias" > + (list false? opensmtpd-table?))))) > + (ttl opensmtpd-local-delivery-ttl > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-local-delivery" "ttl" > + (list false? string?))))) > + (user opensmtpd-local-delivery-user > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-local-delivery" > "user" > + (list false? string?))))) > + (userbase opensmtpd-local-delivery-userbase > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-local-delivery" > "userbase" > + (list false? opensmtpd- > table?))))) > + (virtual opensmtpd-local-delivery-virtual > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-local-delivery" > "virtual" > + (list false? opensmtpd- > table?))))) > + (wrapper opensmtpd-local-delivery-wrapper > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-local-delivery" > "wrapper" > + (list false? string?)))))) > + > +;; FIXME/TODO this is a valid opensmtpd-relay record > +;; (opensmtpd-relay > +;; (pki (opensmtpd-pki > +;; (domain "gnucode.me") > +;; (cert "opensmtpd.scm") > +;; (key "opensmtpd.scm")))) > +;; BUT how does it relay the email? What host does it use? > +;; I think opensmtpd-relay-configuration needs "method" field. > +;; the method field might need to be another record...BUT basically > the relay has to have a 'backup', 'backup-mx', > +;; or 'domain', or 'host' defined. > +(define-record-type* <opensmtpd-relay> > + opensmtpd-relay make-opensmtpd-relay > + opensmtpd-relay? > + (name opensmtpd-relay-name > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "name" > + (list string?)))) > + (default #f)) > + (backup opensmtpd-relay-backup ;; boolean > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "backup" > + (list boolean?))))) > + (backup-mx opensmtpd-relay-backup-mx ;; string mx name > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "backup- > mx" > + (list false? string?))))) > + (helo opensmtpd-relay-helo > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "helo" > + (list false? string? opensmtpd- > table?)))) > + (default #f)) > + (helo-src opensmtpd-relay-helo-src > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "helo-src" > + (list false? string? opensmtpd- > table?)))) > + (default #f)) > + (domain opensmtpd-relay-domain > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "domain" > + (list false? opensmtpd-table?)))) > + (default #f)) > + (host opensmtpd-relay-host > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "host" > + (list false? string?)))) > + (default #f)) > + (pki opensmtpd-relay-pki > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "pki" > + (list false? opensmtpd-pki?))))) > + (srs opensmtpd-relay-srs > + (default #f) > + (lambda (var) > + (my/sanitize var "opensmtpd-relay" "srs" > + (list boolean?)))) > + (tls opensmtpd-relay-tls > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "tls" > + (list false? string?))))) > + (auth opensmtpd-relay-auth > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "auth" > + (list false? opensmtpd-table?)))) > + (default #f)) > + (mail-from opensmtpd-relay-mail-from > + (default #f)) > + ;; string "127.0.0.1" or "<interface>" or "<table of IP > addresses>" > + ;; TODO should I do some sanitizing to make sure that the string? > here is actually an IP address or a valid interface? > + (src opensmtpd-relay-src > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-relay" "src" > + (list false? string? opensmtpd- > table?)))) > + (default #f))) > + > +;; this record is used by <opensmtpd-filter-phase> & > +;; <opensmtpd-match> > +(define-record-type* <opensmtpd-option> > + opensmtpd-option make-opensmtpd-option > + opensmtpd-option? > + (option opensmtpd-option-option > + (default #f) > + (sanitize (lambda (var) > + (if (and (string? var) > + (or (string-in-list? var (list > "fcrdns" "rdns" > + "src" > "helo" > + "auth" > "mail-from" > + "rcpt-to" > + "for" > + "for any" > "for local" > + "for > domain" "for rcpt-to" > + "from any" > "from auth" > + "from > local" "from mail-from" > + "from > rdns" "from socket" > + "from src" > "auth" > + "helo" > "mail-from" > + "rcpt-to" > "tag" "tls")))) > + > + var > + (begin > + (display (string-append "<opensmtpd- > option> fieldname: 'option' is of type \n" > + "string. The > string can be either 'fcrdns', \n" > + " 'rdns', 'src', > 'helo', 'auth', 'mail-from', or 'rcpt-to', \n" > + "'for', 'for > any', 'for local', 'for domain', 'for rcpt-to', \n" > + "'from any', > 'from auth', 'from local', 'from mail-from', 'from rdns', 'from > socket', \n" > + "'from src', > 'auth helo', 'mail-from', 'rcpt-to', 'tag', or 'tls' \n")) > + > + (throw 'bad! var)))))) > + (not opensmtpd-option-not > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-option" "not" > + (list boolean?))))) > + (regex opensmtpd-option-regex > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-option" "regex" > + (list boolean?))))) > + (data opensmtpd-option-data > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-option" "data" > + (list false? string? opensmtpd- > table?)))))) > + > +(define-record-type* <opensmtpd-filter-phase> > + opensmtpd-filter-phase make-opensmtpd-filter-phase > + opensmtpd-filter-phase? > + (name opensmtpd-filter-phase-name ;; string chain-name > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-filter-phase" "name" > + (list string?))))) > + (phase opensmtpd-filter-phase-phase ;; string > + (default #f) > + (sanitize (lambda (var) > + (if (and (string? var) > + (string-in-list? var (list > "connect" > + "helo" > + "mail- > from" > + "rcpt- > to" > + "data" > + > "commit"))) > + var > + (begin > + (display (string-append "<opensmtpd- > filter-phase> fieldname: 'phase' is of type \n" > + "string. > The string can be either 'connect'," > + " 'helo', > 'mail-from', 'rcpt-to', 'data', or 'commit.'\n ")) > + > + (throw 'bad! var)))))) > + (options opensmtpd-filter-phase-options > + (default #f) > + (sanitize (lambda (var) > + ;; returns #t if list is a unique list of > <opensmtpd-option> > + (define (list-of-opensmtpd-option? list) > + (and (list-of-type? list opensmtpd-option?) > + (not (contains-duplicate? list)))) > + > + (define (list-has-duplicates-or-non- > opensmtpd-option list) > + (not (list-of-opensmtpd-option? list))) > + > + ;; input <opensmtpd-option> > + ;; return #t if <opensmtpd-option> fieldname > 'option' > + ;; that needs a corresponding table has one. > Otherwise #f > + (define (opensmtpd-option-has-table? record) > + (define decision (opensmtpd-option-option > record)) > + (and (string? decision) > + ;; if option needs a table, check for > a table > + (if (string-in-list? decision (list > "src" > + > "helo" > + > "mail-from" > + > "rcpt-to")) > + (opensmtpd-table? (opensmtpd- > option-data record)) > + #t))) > + > + (define (list-of-opensmtpd-option-has-table? > list) > + (list-of-type? list opensmtpd-option-has- > table?)) > + > + (define (some-opensmtpd-option-in-list-lack- > table? list) > + (not (list-of-opensmtpd-option-has-table? > list))) > + > + (sanitize-options-for-filter-phase- > configuration var) > + ))) > + (decision opensmtpd-filter-phase-decision > + (default #f) > + (sanitize (lambda (var) > + (if (and (string? var) > + (string-in-list? var (list "bypass" > "disconnect" > + "reject" > "rewrite" "junk"))) > + var > + (begin > + (display (string-append "<opensmtpd- > filter-decision> fieldname: 'decision' is of type \n" > + "string. The > string can be either 'bypass'," > + " > 'disconnect', 'reject', 'rewrite', or 'junk'.\n")) > + (throw 'bad! var)))))) > + (message opensmtpd-filter-phase-message > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-filter-phase" > "message" > + (list false? string?))))) > + (value opensmtpd-filter-phase-value > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-filter-phase" > "value" > + (list false? number?)))))) > + > +(define-record-type* <opensmtpd-filter> > + opensmtpd-filter make-opensmtpd-filter > + opensmtpd-filter? > + (name opensmtpd-filter-name > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-filter" "name" > + (list string?))))) > + (exec opensmtpd-filter-exec > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-filter" "exec" > + (list boolean?))))) > + (proc opensmtpd-filter-proc ; a string like "rspamd" or the > command to start it like "/path/to/rspamd --option=arg --2nd- > option=arg2" > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-filter" "proc" > + (list string? list-of-strings- > or-gexps?)))))) > + > +;; There is another type of filter that opensmtpd supports, which is > a filter chain. > +;; A filter chain is a list of <opensmtpd-filter-phase> and > <opensmtpd-filter>. > +;; This lets you apply several filters under one filter name. I > could have defined > +;; a record type for it, but the record would only have had two > fields: name and list-of-filters. > +;; Why write that as a record? That's too simple. > +;; returns #t if list is a unique list of <opensmtpd-filter> or > <opensmtpd-filter-phase> > +;; returns # otherwise > +(define (opensmtpd-filter-chain? %filters) > + (and (list-of-unique-filter-or-filter-phase? %filters) > + (< 1 (length %filters)))) > + > +(define-record-type* <opensmtpd-interface> > + opensmtpd-interface make-opensmtpd-interface > + opensmtpd-interface? > + ;; interface may be an IP address, interface group, or domain name > + (interface opensmtpd-interface-interface > + (default "lo")) > + (family opensmtpd-interface-family > + (default #f) > + (sanitize (lambda (var) > + (cond > + ((eq? #f var) ;; var == #f > + var) > + ((and (string? var) > + (string-in-list? var (list "inet4" > "inet6"))) > + var) > + (else > + (begin > + (display "<opensmtpd-interface> fieldname > 'family' must be string \"inet4\" or \"inet6\".\n") > + (throw 'bad! var))))))) > + (auth opensmtpd-interface-auth > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-interface" "auth" > + (list boolean? table-whose-data- > are-assoc-list?))))) > + (auth-optional opensmtpd-interface-auth-optional > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-interface" > "auth-optional" > + (list boolean? > + table-whose-data- > are-assoc-list?))))) > + ;; TODO add a ca entry? > + ;; string FIXME/TODO sanitize this to support a gexp. That way > way the > + ;; includes directive can include my hacky scheme code that I use > for opensmtpd-dkimsign. > + (filters opensmtpd-interface-filters > + (default #f) > + (sanitize (lambda (var) > + (sanitize-filter-phases var)))) > + (hostname opensmtpd-interface-hostname > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-interface" > "hostname" > + (list false? string?))))) > + (hostnames opensmtpd-interface-hostnames > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-interface" > "hostnames" > + (list false? table-whose-data- > are-assoc-list?))))) > + (mask-src opensmtpd-interface-mask-src > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-interface" > "mask-src" > + (list boolean?))))) > + (disable-dsn opensmtpd-interface-disable-dsn > + (default #f)) > + (pki opensmtpd-interface-pki > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-interface" "pki" > + (list false? opensmtpd-pki?))))) > + (port opensmtpd-interface-port > + (default #f) > + (sanitize (lambda (var) > + (my/sanitize var "opensmtpd-interface" "port" > + (list false? integer?))))) > + (proxy-v2 opensmtpd-interface-proxy-k2 > + (default #f)) > + (received-auth opensmtpd-interface-received-auth > + (default #f)) > + ;; TODO add in a senders option! > + ;; string or <opensmtpd-senders> record > + ;; (senders opensmtpd-interface-senders > + ;; (sanitize (lambda (var) > + ;; (my/sanitize var "opensmtpd-interface" > "port" (list false? integer?)))) > + ;; (default #f)) > + (secure-connection opensmtpd-interface-secure-connection > + (default #f) > + (sanitize (lambda (var) > + (cond ((boolean? var) > + var) > + ((and (string? var) > + (string-in-list? var > + (list > "smtps" "tls" > + > "tls-require" > + > "tls-require-verify"))) > + var) > + (else > + (begin > + (display (string-append > "<opensmtd-listen-on> fieldname 'secure-connection' can be \n" > + > "one of the following strings: \n'smtps', 'tls', 'tls-require', \n" > + > "or 'tls-require-verify'.\n")) > + (throw 'bad! var))))))) 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
October 24, 2022 2:29 PM, "Liliana Marie Prikler" <liliana.prikler@gmail.com> wrote: > Am Montag, dem 24.10.2022 um 13:30 -0400 schrieb Joshua Branson: > > Cheers Thanks for the speedy response and quick review! I also forgot to mention that the service is actually fairly use-able now! <opensmtpd-filter> takes in a list of strings and gexps. With a little work you can use s-expressions to configure dkimsigning. And it should be possible to integrate bogofilter, but I have not figured that out yet..... Thanks, Joshua
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 +@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)))) + +;; Some example opensmtpd-tables: +;; +;; (opensmtpd-table (name "root accounts") (data '(("joshua" . "root@dismail.de") ("joshua" . "postmaster@dismail.de")))) +;; (opensmtpd-table (name "root accounts") (data (list "mysite.me" "your-site.com"))) +;; TODO should <opensmtpd-table> support have a fieldname 'file'? +;; Or should I change name to name-or-file ? +(define-record-type* <opensmtpd-table> + opensmtpd-table make-opensmtpd-table + opensmtpd-table? + this-record + (name opensmtpd-table-name ;; string + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-table" "name" (list string?))))) + (file-db opensmtpd-table-file-db + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-table" "file-db" + (list boolean?))))) + ;; FIXME support an aliasing table as described here: + ;; https://man.openbsd.org/table.5 + ;; One may have to use the record file for this. I don't think tables support a table like this: + ;; table "name" { joshua = joshua@gnucode.me,joshua@gnu-hurd.com,joshua@propernaming.org, root = root@gnucode.me } + ;; If values is an absolute filename, then it will use said filename to house the table info. + ;; filename must be an absolute filename. + (data opensmtpd-table-data + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-table" "values" + (list list-of-strings? assoc-list? file-exists?))))) + ;; is a list of values or key values + ;; eg: (list "mysite.me" "your-site.com") + ;; eg: (list ("joshua" . "joshua@gnu.org") ("james" . "james@gnu.org")) + ;; I am currently making these values be as assocation list of strings only. + ;; FIXME should I allow a var like this? + ;; (list (cons "gnucode.me" 234.949.392.23)) + ;; can be of type: (quote list-of-strings) or (quote assoc-list) + ;; (opensmtpd-table-type record) returns the values' type. The user SHOULD NEVER set the type. + ;; TODO jpoiret: on irc reccomends that I just use an outside function to determine fieldname 'values', type. + ;; it would be "simpler" and possibly easier for the next person working on this code to understand what is happening. + (type opensmtpd-table-type + (default #f) + (thunked) + (sanitize (lambda (var) + (cond ((opensmtpd-table-data this-record) + (if (list-of-strings? (opensmtpd-table-data this-record)) + (quote list-of-strings) + (quote assoc-list))) + ((file-exists? (opensmtpd-table-data this-record)) + (if (opensmtpd-table-file-db this-record) + (quote db) + (quote file))) + (else + (display "opensmtpd-table-type is broke\n") + (throw 'bad! var))))))) + +(define-record-type* <opensmtpd-ca> + opensmtpd-ca make-opensmtpd-ca + opensmtpd-ca? + (name opensmtpd-ca-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-ca" "name" (list string?))))) + (file opensmtpd-ca-file + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-ca" "file" (list file-exists?)))))) + +(define-record-type* <opensmtpd-pki> + opensmtpd-pki make-opensmtpd-pki + opensmtpd-pki? + (domain opensmtpd-pki-domain + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-pki" "domain" (list string?))))) + ;; TODO/FIXME this should probably be a list of files. The opensmtpd documentation says + ;; that you could have a list of files: + ;; + ;; pki pkiname cert certfile + ;; Associate certificate file certfile with host pkiname, and use that file to prove + ;; the identity of the mail server to clients. pkiname is the server's name, de‐ + ;; rived from the default hostname or set using either + ;; /gnu/store/2d13sdz76ldq8zgwv4wif0zx7hkr3mh2-opensmtpd-6.8.0p2/etc/mailname or us‐ + ;; ing the hostname directive. If a fallback certificate or SNI is wanted, the ‘*’ + ;; wildcard may be used as pkiname. + + ;; A certificate chain may be created by appending one or many certificates, includ‐ + ;; ing a Certificate Authority certificate, to certfile. The creation of certifi‐ + ;; cates is documented in starttls(8). + (cert opensmtpd-pki-cert + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-pki" "cert" (list file-exists?))))) + (key opensmtpd-pki-key + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-pki" "key" (list file-exists?))))) + ; todo sanitize this. valid parameters are "none", "legacy", or "auto". + (dhe opensmtpd-pki-dhe + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-dhe" "dhe" (list false? string?)))))) + +(define-record-type* <opensmtpd-lmtp> + opensmtpd-lmtp make-opensmtpd-lmtp + opensmtpd-lmtp? + (destination opensmtpd-lmtp-destination + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-lmtp" "destination" + (list string?))))) + (rcpt-to opensmtpd-lmtp-rcpt-to + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-lmtp" "rcpt-to" + (list false? string?)))))) + +(define-record-type* <opensmtpd-mda> + opensmtpd-mda make-opensmtpd-mda + opensmtpd-mda? + (name opensmtpd-mda-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-mda" "name" + (list string?))))) + ;; TODO should I allow this command to be a gexp? + (command opensmtpd-mda-command + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-mda" "command" + (list string?)))))) + +(define-record-type* <opensmtpd-maildir> + opensmtpd-maildir make-opensmtpd-maildir + opensmtpd-maildir? + (pathname opensmtpd-maildir-pathname + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-maildir" "pathname" + (list false? string?))))) + (junk opensmtpd-maildir-junk + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-maildir" "junk" + (list boolean?)))))) + +(define-record-type* <opensmtpd-local-delivery> + opensmtpd-local-delivery make-opensmtpd-local-delivery + opensmtpd-local-delivery? + (name opensmtpd-local-delivery-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-local-delivery" "name" + (list string?))))) + (method opensmtpd-local-delivery-method + (default "mbox") + (sanitize (lambda (var) + (cond + ((or (opensmtpd-lmtp? var) + (opensmtpd-maildir? var) + (opensmtpd-mda? var) + (string=? var "mbox") + (string=? var "expand-only") + (string=? var "forward-only")) + var) + (else + (begin + (display (string-append "<opensmtpd-local-delivery> fieldname 'method' must be of type \n" + "\"mbox\", \"expand-only\", \"forward-only\" \n" + "<opensmtpd-lmtp>, <opensmtpd-maildir>, \n" + "or <opensmtpd-mda>.\n")) + (throw 'bad! var))))))) + (alias opensmtpd-local-delivery-alias + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-local-delivery" "alias" + (list false? opensmtpd-table?))))) + (ttl opensmtpd-local-delivery-ttl + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-local-delivery" "ttl" + (list false? string?))))) + (user opensmtpd-local-delivery-user + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-local-delivery" "user" + (list false? string?))))) + (userbase opensmtpd-local-delivery-userbase + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-local-delivery" "userbase" + (list false? opensmtpd-table?))))) + (virtual opensmtpd-local-delivery-virtual + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-local-delivery" "virtual" + (list false? opensmtpd-table?))))) + (wrapper opensmtpd-local-delivery-wrapper + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-local-delivery" "wrapper" + (list false? string?)))))) + +;; FIXME/TODO this is a valid opensmtpd-relay record +;; (opensmtpd-relay +;; (pki (opensmtpd-pki +;; (domain "gnucode.me") +;; (cert "opensmtpd.scm") +;; (key "opensmtpd.scm")))) +;; BUT how does it relay the email? What host does it use? +;; I think opensmtpd-relay-configuration needs "method" field. +;; the method field might need to be another record...BUT basically the relay has to have a 'backup', 'backup-mx', +;; or 'domain', or 'host' defined. +(define-record-type* <opensmtpd-relay> + opensmtpd-relay make-opensmtpd-relay + opensmtpd-relay? + (name opensmtpd-relay-name + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "name" + (list string?)))) + (default #f)) + (backup opensmtpd-relay-backup ;; boolean + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "backup" + (list boolean?))))) + (backup-mx opensmtpd-relay-backup-mx ;; string mx name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "backup-mx" + (list false? string?))))) + (helo opensmtpd-relay-helo + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "helo" + (list false? string? opensmtpd-table?)))) + (default #f)) + (helo-src opensmtpd-relay-helo-src + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "helo-src" + (list false? string? opensmtpd-table?)))) + (default #f)) + (domain opensmtpd-relay-domain + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "domain" + (list false? opensmtpd-table?)))) + (default #f)) + (host opensmtpd-relay-host + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "host" + (list false? string?)))) + (default #f)) + (pki opensmtpd-relay-pki + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "pki" + (list false? opensmtpd-pki?))))) + (srs opensmtpd-relay-srs + (default #f) + (lambda (var) + (my/sanitize var "opensmtpd-relay" "srs" + (list boolean?)))) + (tls opensmtpd-relay-tls + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "tls" + (list false? string?))))) + (auth opensmtpd-relay-auth + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "auth" + (list false? opensmtpd-table?)))) + (default #f)) + (mail-from opensmtpd-relay-mail-from + (default #f)) + ;; string "127.0.0.1" or "<interface>" or "<table of IP addresses>" + ;; TODO should I do some sanitizing to make sure that the string? here is actually an IP address or a valid interface? + (src opensmtpd-relay-src + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-relay" "src" + (list false? string? opensmtpd-table?)))) + (default #f))) + +;; this record is used by <opensmtpd-filter-phase> & +;; <opensmtpd-match> +(define-record-type* <opensmtpd-option> + opensmtpd-option make-opensmtpd-option + opensmtpd-option? + (option opensmtpd-option-option + (default #f) + (sanitize (lambda (var) + (if (and (string? var) + (or (string-in-list? var (list "fcrdns" "rdns" + "src" "helo" + "auth" "mail-from" + "rcpt-to" + "for" + "for any" "for local" + "for domain" "for rcpt-to" + "from any" "from auth" + "from local" "from mail-from" + "from rdns" "from socket" + "from src" "auth" + "helo" "mail-from" + "rcpt-to" "tag" "tls")))) + + var + (begin + (display (string-append "<opensmtpd-option> fieldname: 'option' is of type \n" + "string. The string can be either 'fcrdns', \n" + " 'rdns', 'src', 'helo', 'auth', 'mail-from', or 'rcpt-to', \n" + "'for', 'for any', 'for local', 'for domain', 'for rcpt-to', \n" + "'from any', 'from auth', 'from local', 'from mail-from', 'from rdns', 'from socket', \n" + "'from src', 'auth helo', 'mail-from', 'rcpt-to', 'tag', or 'tls' \n")) + + (throw 'bad! var)))))) + (not opensmtpd-option-not + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-option" "not" + (list boolean?))))) + (regex opensmtpd-option-regex + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-option" "regex" + (list boolean?))))) + (data opensmtpd-option-data + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-option" "data" + (list false? string? opensmtpd-table?)))))) + +(define-record-type* <opensmtpd-filter-phase> + opensmtpd-filter-phase make-opensmtpd-filter-phase + opensmtpd-filter-phase? + (name opensmtpd-filter-phase-name ;; string chain-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter-phase" "name" + (list string?))))) + (phase opensmtpd-filter-phase-phase ;; string + (default #f) + (sanitize (lambda (var) + (if (and (string? var) + (string-in-list? var (list "connect" + "helo" + "mail-from" + "rcpt-to" + "data" + "commit"))) + var + (begin + (display (string-append "<opensmtpd-filter-phase> fieldname: 'phase' is of type \n" + "string. The string can be either 'connect'," + " 'helo', 'mail-from', 'rcpt-to', 'data', or 'commit.'\n ")) + + (throw 'bad! var)))))) + (options opensmtpd-filter-phase-options + (default #f) + (sanitize (lambda (var) + ;; returns #t if list is a unique list of <opensmtpd-option> + (define (list-of-opensmtpd-option? list) + (and (list-of-type? list opensmtpd-option?) + (not (contains-duplicate? list)))) + + (define (list-has-duplicates-or-non-opensmtpd-option list) + (not (list-of-opensmtpd-option? list))) + + ;; input <opensmtpd-option> + ;; return #t if <opensmtpd-option> fieldname 'option' + ;; that needs a corresponding table has one. Otherwise #f + (define (opensmtpd-option-has-table? record) + (define decision (opensmtpd-option-option record)) + (and (string? decision) + ;; if option needs a table, check for a table + (if (string-in-list? decision (list "src" + "helo" + "mail-from" + "rcpt-to")) + (opensmtpd-table? (opensmtpd-option-data record)) + #t))) + + (define (list-of-opensmtpd-option-has-table? list) + (list-of-type? list opensmtpd-option-has-table?)) + + (define (some-opensmtpd-option-in-list-lack-table? list) + (not (list-of-opensmtpd-option-has-table? list))) + + (sanitize-options-for-filter-phase-configuration var) + ))) + (decision opensmtpd-filter-phase-decision + (default #f) + (sanitize (lambda (var) + (if (and (string? var) + (string-in-list? var (list "bypass" "disconnect" + "reject" "rewrite" "junk"))) + var + (begin + (display (string-append "<opensmtpd-filter-decision> fieldname: 'decision' is of type \n" + "string. The string can be either 'bypass'," + " 'disconnect', 'reject', 'rewrite', or 'junk'.\n")) + (throw 'bad! var)))))) + (message opensmtpd-filter-phase-message + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter-phase" "message" + (list false? string?))))) + (value opensmtpd-filter-phase-value + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter-phase" "value" + (list false? number?)))))) + +(define-record-type* <opensmtpd-filter> + opensmtpd-filter make-opensmtpd-filter + opensmtpd-filter? + (name opensmtpd-filter-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter" "name" + (list string?))))) + (exec opensmtpd-filter-exec + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter" "exec" + (list boolean?))))) + (proc opensmtpd-filter-proc ; a string like "rspamd" or the command to start it like "/path/to/rspamd --option=arg --2nd-option=arg2" + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter" "proc" + (list string? list-of-strings-or-gexps?)))))) + +;; There is another type of filter that opensmtpd supports, which is a filter chain. +;; A filter chain is a list of <opensmtpd-filter-phase> and <opensmtpd-filter>. +;; This lets you apply several filters under one filter name. I could have defined +;; a record type for it, but the record would only have had two fields: name and list-of-filters. +;; Why write that as a record? That's too simple. +;; returns #t if list is a unique list of <opensmtpd-filter> or <opensmtpd-filter-phase> +;; returns # otherwise +(define (opensmtpd-filter-chain? %filters) + (and (list-of-unique-filter-or-filter-phase? %filters) + (< 1 (length %filters)))) + +(define-record-type* <opensmtpd-interface> + opensmtpd-interface make-opensmtpd-interface + opensmtpd-interface? + ;; interface may be an IP address, interface group, or domain name + (interface opensmtpd-interface-interface + (default "lo")) + (family opensmtpd-interface-family + (default #f) + (sanitize (lambda (var) + (cond + ((eq? #f var) ;; var == #f + var) + ((and (string? var) + (string-in-list? var (list "inet4" "inet6"))) + var) + (else + (begin + (display "<opensmtpd-interface> fieldname 'family' must be string \"inet4\" or \"inet6\".\n") + (throw 'bad! var))))))) + (auth opensmtpd-interface-auth + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "auth" + (list boolean? table-whose-data-are-assoc-list?))))) + (auth-optional opensmtpd-interface-auth-optional + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "auth-optional" + (list boolean? + table-whose-data-are-assoc-list?))))) + ;; TODO add a ca entry? + ;; string FIXME/TODO sanitize this to support a gexp. That way way the + ;; includes directive can include my hacky scheme code that I use for opensmtpd-dkimsign. + (filters opensmtpd-interface-filters + (default #f) + (sanitize (lambda (var) + (sanitize-filter-phases var)))) + (hostname opensmtpd-interface-hostname + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "hostname" + (list false? string?))))) + (hostnames opensmtpd-interface-hostnames + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "hostnames" + (list false? table-whose-data-are-assoc-list?))))) + (mask-src opensmtpd-interface-mask-src + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "mask-src" + (list boolean?))))) + (disable-dsn opensmtpd-interface-disable-dsn + (default #f)) + (pki opensmtpd-interface-pki + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "pki" + (list false? opensmtpd-pki?))))) + (port opensmtpd-interface-port + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "port" + (list false? integer?))))) + (proxy-v2 opensmtpd-interface-proxy-k2 + (default #f)) + (received-auth opensmtpd-interface-received-auth + (default #f)) + ;; TODO add in a senders option! + ;; string or <opensmtpd-senders> record + ;; (senders opensmtpd-interface-senders + ;; (sanitize (lambda (var) + ;; (my/sanitize var "opensmtpd-interface" "port" (list false? integer?)))) + ;; (default #f)) + (secure-connection opensmtpd-interface-secure-connection + (default #f) + (sanitize (lambda (var) + (cond ((boolean? var) + var) + ((and (string? var) + (string-in-list? var + (list "smtps" "tls" + "tls-require" + "tls-require-verify"))) + var) + (else + (begin + (display (string-append "<opensmtd-listen-on> fieldname 'secure-connection' can be \n" + "one of the following strings: \n'smtps', 'tls', 'tls-require', \n" + "or 'tls-require-verify'.\n")) + (throw 'bad! var))))))) + (tag opensmtpd-interface-tag + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "tag" + (list false? string?)))) + (default #f))) + +(define-record-type* <opensmtpd-socket-configuration> + opensmtpd-socket-configuration make-opensmtpd-socket-configuration + opensmtpd-socket-configuration? + ;; false or <opensmtpd-filter> or list of <opensmtpd-filter> + (filters opensmtpd-socket-configuration-filters + (sanitize (lambda (var) + (sanitize-filter-phases var))) + (default #f)) + (mask-src opensmtpd-socket-configuration-mask-src + (default #f)) + (tag opensmtpd-socket-configuration-tag + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-interface" "tag" + (list false? string?)))) + (default #f))) + + +(define-record-type* <opensmtpd-match> + opensmtpd-match make-opensmtpd-match + opensmtpd-match? + ;;TODO? Perhaps I should add in a reject fieldname. If reject + ;;is #t, then the match record will be a reject match record. + ;; (opensmtpd-match (reject #t)) vs. (opensmtpd-match (action 'reject)) + ;; To do this, I will also have to 'reject' mutually exclusive. AND an match with 'reject' can have no action defined. + (action opensmtpd-match-action + (default #f) + (sanitize (lambda (var) + (if (or (opensmtpd-relay? var) + (opensmtpd-local-delivery? var) + (eq? (quote reject) var)) + var + (begin + (display + (string-append "<opensmtpd-match> fieldname 'action' is of type <opensmtpd-relay>, \n" + "<opensmtpd-local-delivery>, or (quote reject).\n" + "If its var is (quote reject), then the match rejects the incoming message\n" + "during the SMTP dialogue.\n")) + (throw 'bad! var)))))) + (options opensmtpd-match-options + (default #f) + (sanitize (lambda (var) + (cond ((not var) + #f) + ((not (list-of-unique-opensmtpd-option? var)) + (throw-error var '("<opensmtpd-match> fieldname 'options' is a list of unique \n" + "<opensmtpd-option> records. \n"))) + (else (sanitize-list-of-options-for-match-configuration var))))))) + +(define-record-type* <opensmtpd-smtp> + opensmtpd-smtp make-opensmtpd-smtp + opensmtpd-smtp? + (ciphers opensmtpd-smtp-ciphers + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp" "ciphers" + (list false? string?))))) + (limit-max-mails opensmtpd-smtp-limit-max-mails + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp" "limit-max-mails" + (list false? integer?))))) + (limit-max-rcpt opensmtpd-smtp-limit-max-rcpt + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp" "limit-max-rcpt" + (list false? integer?))))) + (max-message-size opensmtpd-smtp-max-message-size + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp" "max-message-size" + (list false? integer? string?))))) + ;; FIXME/TODO the sanitize function of sub-addr-delim should accept a string of length one not string? + (sub-addr-delim opensmtpd-smtp-sub-addr-delim + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp" "sub-addr-delim" + (list false? integer? string?)))))) + +(define-record-type* <opensmtpd-srs> + opensmtpd-srs make-opensmtpd-srs + opensmtpd-srs? + ;; TODO should this be a file? + (key opensmtpd-srs-key + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-srs" "key" + (list false? boolean? string?))))) + ;; TODO should this also be a file? + (backup-key opensmtpd-srs-backup-key + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-srs" "backup-key" + (list false? integer?))))) + (ttl-delay opensmtpd-srs-ttl-delay + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-srs" "ttl-delay" + (list false? string?)))))) + +(define-record-type* <opensmtpd-queue> + opensmtpd-queue make-opensmtpd-queue + opensmtpd-queue? + (compression opensmtpd-queue-compression + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-queue" "compression" + (list boolean?))))) + (encryption opensmtpd-queue-encryption + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-queue" "encryption" + (list boolean? string? file-exists?))))) + (ttl-delay opensmtpd-queue-ttl-delay + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-queue" "ttl-delay" + (list false? string?)))))) + (define-record-type* <opensmtpd-configuration> opensmtpd-configuration make-opensmtpd-configuration opensmtpd-configuration? - (package opensmtpd-configuration-package - (default opensmtpd)) + (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