Openmstpd-configuration may only be configured by a config-file. This patch, enables one to configure opensmtpd by using some guile record types (defined via define-record-type*). * gnu/services/mail.scm: New records (opensmtpd-table-configuration), (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-listen-on-configuration), (opensmtpd-listen-on-socket-configuration), (opensmtpd-match-configuration), (opensmtpd-smtp-configuration), (opensmtpd-srs-configuration), (opensmtpd-queue-configuration), and (opensmtpd-configuration). New procedures: false?, is-value-right-type, add-comma-or-string, file-exists?, 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. * doc/guix.texi added documentation for the new records for opensmtpd. --- doc/guix.texi | 1051 ++++++++++++++++++++- gnu/services/mail.scm | 2016 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 3056 insertions(+), 11 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index eda0956260..e8564240d1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -24849,14 +24849,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{} +@item +@tab +@item @strong{matches} +@tab @code{} +@item +@tab +@item @strong{actions} +@tab @code{} +@item +@tab @code{} +@end multitable + +Additionally, each @code{} and +@code{} may use a list of +@code{}, and/or +@code{} records to filter email/spam. Also +numerous records' fieldnames use @code{} to hold lists +or key value pairs of data. + +A simple example configuration is below: + +@lisp +(let ((smtp.gnu.org (opensmtpd-pki-configuration + (domain "smtp.gnu.org") + (cert "file.cert") + (key "file.key")))) + (service opensmtpd-service-type + (opensmtpd-configuration + (listen-ons (list + (opensmtpd-listen-on-configuration + (pki smtp.gnu.org)) + (opensmtpd-listen-on-configuration + (pki smtp.gnu.org) + (secure-connection "smtps")))) + (matches (list + (opensmtpd-match-configuration + (action + (opensmtpd-action-local-delivery-configuration + (name "local-delivery")))) + (opensmtpd-match-configuration + (action + (opensmtpd-action-relay-configuration + (name "relay"))))))))) @end lisp @end deffn @@ -24873,9 +24918,999 @@ 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. +@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-listen-on-configuration))}) + +@code{listen-ons} is a list of @code{} records. +This list details what interfaces and ports OpenSMTPD listens on as well as +other information. + +@item @code{listen-on-socket} (default: @code{(opensmtpd-listen-on-socket-configuration-configuration)}) + +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-configuration + (action (opensmtpd-action-local-delivery-configuration + (name "local") + (method "mbox"))) + (for (opensmtpd-option-configuration + (option "for local")))) + (opensmtpd-match-configuration + (action (opensmtpd-action-relay-configuration + (name "outbound"))) + (from (opensmtpd-option-configuration + (option "from local"))) + (for (opensmtpd-option-configuration + (option "for any"))))) +@end lisp + +@code{matches} is a list of @code{} 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{} 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{} 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{} record, which lets one set +up SRS, the Sender Rewritting Scheme. @end table @end deftp +@itemize +@item +Data Type: opensmtpd-listen-on-configuration + +Data type representing the configuration of an +@code{}. 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{} 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{} to both accept +incoming mail from untrusted senders and permit outgoing mail from +authenticated users (using @code{} 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{} or +@code{} 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{} 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{} +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{} 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-listen-on-socket-configuration + +Data type representing the configuration of an +@code{}. 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{} or +@code{} 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-configuration + +This data type represents the configuration of an +@code{} 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{} 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{} or +@code{}. + +@item @code{options} (default: @code{#f}) @code{} +The fieldname 'option' is a list of unique +@code{} records. + +Each @code{} 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: ), 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_ | } + +Specify that session may address the string or list table domain. + +@item @samp{for rcpt-to _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_ | } + +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_ | } + +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_ | } + +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_ |
} + +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_ | } + +Matches transactions which have been authenticated for user or user list +username. + +@item @samp{helo _helo-name_ | } + +Specify that session's HELO / EHLO should match the string or list table +helo-name. + +@item @samp{mail-from _sender_ | } + +Specify that transactions's MAIL FROM should match the string or list +table sender. + +@item @samp{rcpt-to _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-configuration + (not #t) + (regex #f) + (option "for domain") + (data (opensmtpd-table-configuration + (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-configuration +@end itemize + +@item Data Type: opensmtpd-action-local-delivery-configuration + +This data type represents the configuration of an +@code{} 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{} + +Deliver the message to an LMTP server at +@code{}'s fieldname @code{destination}. The location +may be expressed as string host:port or as a UNIX socket. Optionally, +@code{}'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{} + +Deliver the message to the maildir in +@code{}'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{}'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{} + +Delegate the delivery to the @code{}'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{}. + +@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{} 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{} record is used for virtual +expansion. +@end itemize + +@item Data Type: opensmtpd-action-relay-configuration + +This data type represents the configuration of an +@code{} 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{} 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{} 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{} (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{} + +Use the alist @code{} 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{} + +Use the string or @code{} 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-configuration + +This data type represents the configuration of an +@code{}. 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-configuration + +This data type represents the configuration of an +@code{}. + +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{} 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{} records. + +At each phase, various options, specified by a list of +@code{}, may be checked. The +@code{}'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{
} +next to them require the @code{}'s fieldname +@code{data} to be an @code{}. 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
+@tab session has a reverse DNS in table +@item src
+@tab source address is in table +@item helo
+@tab helo name is in table +@item auth +@tab session is authenticated +@item auth
+@tab session username is in table +@item mail-from
+@tab sender address is in table +@item rcpt-to
+@tab recipient address is in table +@end multitable + +These conditions may all be negated by setting +@code{}'s fieldname @code{not} to @code{#t}. + +Any conditions that require a table may indicate that tables include regexs +setting @code{}'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-configuration + +This data type represents the configuration of an +@code{}, which is used by +@code{} and @code{} +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{} via the fieldname data. When the option +record is used inside of an @code{}, 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''
+@tab session has a reverse DNS in table +@item ``src''
+@tab source address is in table +@item ``helo''
+@tab helo name is in table +@item ``auth'' +@tab session is authenticated +@item ``auth''
+@tab session username is in table +@item ``mail-from''
+@tab sender address is in table +@item ``rcpt-to''
+@tab recipient address is in table +@end multitable + +When @code{} is used inside of an +@code{}, 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{} + +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-configuration + +This data type represents the configuration of an +@code{}. + +@itemize +@item @code{name} (default @code{#f}) + +@code{name} is the name of the @code{} 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-configuration + +This data type represents the configuration of an +@code{}. + +@itemize +@item @code{domain} (default @code{#f}) + +@code{domain} is the string name of the @code{} 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-configuration + +@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-configuration + +@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-configuration + +@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-configuration + +Data type representing an @code{} 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-configuration + +@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{}, @code{}) 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 d99743ac31..2a344e303e 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -57,8 +57,143 @@ (define-module (gnu services mail) mailbox-configuration namespace-configuration + opensmtpd-table-configuration + opensmtpd-table-configuration? + opensmtpd-table-configuration-name + opensmtpd-table-configuration-file-db + opensmtpd-table-configuration-data + + opensmtpd-ca-configuration + opensmtpd-ca-configuration? + opensmtpd-ca-configuration-name + opensmtpd-ca-configuration-file + + opensmtpd-pki-configuration + opensmtpd-pki-configuration? + opensmtpd-pki-configuration-domain + opensmtpd-pki-configuration-cert + opensmtpd-pki-configuration-key + opensmtpd-pki-configuration-dhe + + opensmtpd-action-local-delivery-configuration + opensmtpd-action-local-delivery-configuration? + opensmtpd-action-local-delivery-configuration-method + opensmtpd-action-local-delivery-configuration-alias + opensmtpd-action-local-delivery-configuration-ttl + opensmtpd-action-local-delivery-configuration-user + opensmtpd-action-local-delivery-configuration-userbase + opensmtpd-action-local-delivery-configuration-virtual + opensmtpd-action-local-delivery-configuration-wrapper + + opensmtpd-maildir-configuration + opensmtpd-maildir-configuration? + opensmtpd-maildir-configuration-pathname + opensmtpd-maildir-configuration-junk + + opensmtpd-mda-configuration + opensmtpd-mda-configuration-name + opensmtpd-mda-configuration-command + + opensmtpd-action-relay-configuration + opensmtpd-action-relay-configuration? + opensmtpd-action-relay-configuration-backup + opensmtpd-action-relay-configuration-backup-mx + opensmtpd-action-relay-configuration-helo + opensmtpd-action-relay-configuration-domain + opensmtpd-action-relay-configuration-host + opensmtpd-action-relay-configuration-pki + opensmtpd-action-relay-configuration-srs + opensmtpd-action-relay-configuration-tls + opensmtpd-action-relay-configuration-auth + opensmtpd-action-relay-configuration-mail-from + opensmtpd-action-relay-configuration-src + + opensmtpd-option-configuration + opensmtpd-option-configuration? + opensmtpd-option-configuration-option + opensmtpd-option-configuration-not + opensmtpd-option-configuration-regex + opensmtpd-option-configuration-data + + opensmtpd-filter-phase-configuration + opensmtpd-filter-phase-configuration? + opensmtpd-filter-phase-configuration-name + opensmtpd-filter-phase-configuration-phase-name + opensmtpd-filter-phase-configuration-options + opensmtpd-filter-phase-configuration-decision + opensmtpd-filter-phase-configuration-message + opensmtpd-filter-phase-configuration-value + + opensmtpd-filter-configuration + opensmtpd-filter-configuration? + opensmtpd-filter-configuration-name + opensmtpd-filter-configuration-proc + + opensmtpd-listen-on-configuration + opensmtpd-listen-on-configuration? + opensmtpd-listen-on-configuration-interface + opensmtpd-listen-on-configuration-family + opensmtpd-listen-on-configuration-auth + opensmtpd-listen-on-configuration-auth-optional + opensmtpd-listen-on-configuration-filters + opensmtpd-listen-on-configuration-hostname + opensmtpd-listen-on-configuration-hostnames + opensmtpd-listen-on-configuration-mask-src + opensmtpd-listen-on-configuration-disable-dsn + opensmtpd-listen-on-configuration-pki + opensmtpd-listen-on-configuration-port + opensmtpd-listen-on-configuration-proxy-v2 + opensmtpd-listen-on-configuration-received-auth + opensmtpd-listen-on-configuration-senders + opensmtpd-listen-on-configuration-secure-connection + opensmtpd-listen-on-configuration-tag + + opensmtpd-listen-on-socket-configuration + opensmtpd-listen-on-socket-configuration? + opensmtpd-listen-on-socket-configuration-filters + opensmtpd-listen-on-socket-configuration-mask-src + opensmtpd-listen-on-socket-configuration-tag + + opensmtpd-match-configuration + opensmtpd-match-configuration? + opensmtpd-match-configuration-action + opensmtpd-match-configuration-options + + opensmtpd-smtp-configuration + opensmtpd-smtp-configuration? + opensmtpd-smtp-configuration-ciphers + opensmtpd-smtp-configuration-limit-max-mails + opensmtpd-smtp-configuration-limit-max-rcpt + opensmtpd-smtp-configuration-max-message-size + opensmtpd-smtp-configuration-sub-addr-delim character + + opensmtpd-srs-configuration + opensmtpd-srs-configuration? + opensmtpd-srs-configuration-key + opensmtpd-srs-configuration-backup-key + opensmtpd-srs-configuration-ttl-delay + + opensmtpd-queue-configuration + opensmtpd-queue-configuration? + opensmtpd-queue-configuration-compression + opensmtpd-queue-configuration-encryption + opensmtpd-queue-configuration-ttl-delay + opensmtpd-configuration opensmtpd-configuration? + opensmtpd-package + opensmtpd-config-file + opensmtpd-configuration-bounce + opensmtpd-configuration-listen-ons + opensmtpd-configuration-listen-on-socket + opensmtpd-configuration-includes + opensmtpd-configuration-matches + opensmtpd-configuration-mda-wrappers + opensmtpd-configuration-mta-max-deferred + opensmtpd-configuration-srs + opensmtpd-configuration-smtp + opensmtpd-configuration-queue + opensmtpd-service-type %default-opensmtpd-config-file @@ -1651,13 +1786,1888 @@ (define (generate-dovecot-documentation) ;;; OpenSMTPD. ;;; +;; some fieldnames have a default value of #f, which is ok. They cannot have a value of #t. +;; for example opensmtpd-table-configuration-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 + (cond [(procedure? (car list-of-procedures)) + (if ((car list-of-procedures) var) + #t + (is-value-right-type? var (cdr list-of-procedures) record fieldname))] + [(and (sanitize-configuration? (car list-of-procedures)) + (sanitize-configuration-error-if-proc-fails (car list-of-procedures)) + (if ((sanitize-configuration-proc (car list-of-procedures)) var) + #t + (begin + (apply string-append + (sanitize-configuration-error-message (car list-of-procedures))) + (throw 'bad! var))))] + [else (if ((sanitize-configuration-proc (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)) + +;; I could test for read-ability of a file, but then I would have to +;; test the program as root everytime instead of as a normal user... +(define (file-exists? file) +(if (string? file) + (access? file F_OK) + #f)) + +(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-configuration? (car procedures)) + "an record, "] + [(eq? opensmtpd-table-configuration? (car procedures)) + "an record, "] + [(eq? list-of-unique-opensmtpd-match-configuration? (car procedures)) + "a list of unique records, "] + [(eq? table-whose-data-are-assoc-list? (car procedures)) + (string-append + "an record whose fieldname 'values' are an assoc-list \n" + "(eg: (opensmtpd-table-configuration (name \"table\") (data '(\"joshua\" . \"$encrypted$password\")))), ")] + [(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"))) + +;; TODO can I M-x raise-sexp (string=? string var) in this procedure? and get rid of checking +;; if the var is a string? The previous string-in-list? had that check. +;; (string-in-list? '("hello" 5 "cat")) currently works. If I M-x raise-sexp (string=? string var) +;; then it will no longer work. +(define (string-in-list? string list) + (primitive-eval (cons 'or (map (lambda (var) (and (string? var) (string=? string var))) list)))) + +(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-table-configurations: +;; +;; (opensmtpd-table-configuration (name "root accounts") (data '(("joshua" . "root@dismail.de") ("joshua" . "postmaster@dismail.de")))) +;; (opensmtpd-table-configuration (name "root accounts") (data (list "mysite.me" "your-site.com"))) +;; TODO should support have a fieldname 'file'? +;; Or should I change name to name-or-file ? +(define-record-type* + opensmtpd-table-configuration make-opensmtpd-table-configuration + opensmtpd-table-configuration? + this-record + (name opensmtpd-table-configuration-name ;; string + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-table-configuration" "name" (list string?))))) + (file-db opensmtpd-table-configuration-file-db + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-table-configuration" "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-configuration-data + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-table-configuration" "values" + (list file-exists? list-of-strings? assoc-list?))))) + ;; 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-configuration-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-configuration-type + (default #f) + (thunked) + (sanitize (lambda (var) + (cond [(opensmtpd-table-configuration-data this-record) + (if (list-of-strings? (opensmtpd-table-configuration-data this-record)) + (quote list-of-strings) + (quote assoc-list))] + [(file-exists? (opensmtpd-table-configuration-data this-record)) + (if (opensmtpd-table-configuration-file-db this-record) + (quote db) + (quote file))] + [else + (display "opensmtpd-table-configuration-type is broke\n") + (throw 'bad! var)]))))) + +(define-record-type* + opensmtpd-ca-configuration make-opensmtpd-ca-configuration + opensmtpd-ca-configuration? + (name opensmtpd-ca-configuration-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-ca-configuration" "name" (list string?))))) + (file opensmtpd-ca-configuration-file + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-ca-configuration" "file" (list file-exists?)))))) + +(define-record-type* + opensmtpd-pki-configuration make-opensmtpd-pki-configuration + opensmtpd-pki-configuration? + (domain opensmtpd-pki-configuration-domain + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-pki-configuration" "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-configuration-cert + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-pki-configuration" "cert" (list file-exists?))))) + (key opensmtpd-pki-configuration-key + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-pki-configuration" "key" (list file-exists?))))) + ; todo sanitize this. valid parameters are "none", "legacy", or "auto". + (dhe opensmtpd-pki-configuration-dhe + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-dhe" "dhe" (list false? string?)))))) + +(define-record-type* + opensmtpd-lmtp-configuration make-opensmtpd-lmtp-configuration + opensmtpd-lmtp-configuration? + (destination opensmtpd-lmtp-configuration-destination + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-lmtp-configuration" "destination" + (list string?))))) + (rcpt-to opensmtpd-lmtp-configuration-rcpt-to + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-lmtp-configuration" "rcpt-to" + (list false? string?)))))) + +(define-record-type* + opensmtpd-mda-configuration make-opensmtpd-mda-configuration + opensmtpd-mda-configuration? + (name opensmtpd-mda-configuration-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-mda-configuration" "name" + (list string?))))) + ;; TODO should I allow this command to be a gexp? + (command opensmtpd-mda-configuration-command + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-mda-configuration" "command" + (list string?)))))) + +(define-record-type* + opensmtpd-maildir-configuration make-opensmtpd-maildir-configuration + opensmtpd-maildir-configuration? + (pathname opensmtpd-maildir-configuration-pathname + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-maildir-configuration" "pathname" + (list false? string?))))) + (junk opensmtpd-maildir-configuration-junk + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-maildir-configuration" "junk" + (list boolean?)))))) + +(define-record-type* + opensmtpd-action-local-delivery-configuration make-opensmtpd-action-local-delivery-configuration + opensmtpd-action-local-delivery-configuration? + (name opensmtpd-action-local-delivery-configuration-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-local-delivery-configuration" "name" + (list string?))))) + (method opensmtpd-action-local-delivery-configuration-method + (default "mbox") + (sanitize (lambda (var) + (cond + [(or (opensmtpd-lmtp-configuration? var) + (opensmtpd-maildir-configuration? var) + (opensmtpd-mda-configuration? var) + (string=? var "mbox") + (string=? var "expand-only") + (string=? var "forward-only")) + var] + [else + (begin + (display (string-append " fieldname 'method' must be of type \n" + "\"mbox\", \"expand-only\", \"forward-only\" \n" + ", , \n" + "or .\n")) + (throw 'bad! var))])))) + (alias opensmtpd-action-local-delivery-configuration-alias + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-local-delivery-configuration" "alias" + (list false? opensmtpd-table-configuration?))))) + (ttl opensmtpd-action-local-delivery-configuration-ttl + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-local-delivery-configuration" "ttl" + (list false? string?))))) + (user opensmtpd-action-local-delivery-configuration-user + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-local-delivery-configuration" "user" + (list false? string?))))) + (userbase opensmtpd-action-local-delivery-configuration-userbase + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-local-delivery-configuration" "userbase" + (list false? opensmtpd-table-configuration?))))) + (virtual opensmtpd-action-local-delivery-configuration-virtual + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-local-delivery-configuration" "virtual" + (list false? opensmtpd-table-configuration?))))) + (wrapper opensmtpd-action-local-delivery-configuration-wrapper + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-local-delivery-configuration" "wrapper" + (list false? string?)))))) + +;; FIXME/TODO this is a valid opensmtpd-relay record +;; (opensmtpd-action-relay-configuration +;; (pki (opensmtpd-pki-configuration +;; (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-action-relay-configuration make-opensmtpd-action-relay-configuration + opensmtpd-action-relay-configuration? + (name opensmtpd-action-relay-configuration-name + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "name" + (list string?)))) + (default #f)) + (backup opensmtpd-action-relay-configuration-backup ;; boolean + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "backup" + (list boolean?))))) + (backup-mx opensmtpd-action-relay-configuration-backup-mx ;; string mx name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "backup-mx" + (list false? string?))))) + (helo opensmtpd-action-relay-configuration-helo + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "helo" + (list false? string? opensmtpd-table-configuration?)))) + (default #f)) + (helo-src opensmtpd-action-relay-configuration-helo-src + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "helo-src" + (list false? string? opensmtpd-table-configuration?)))) + (default #f)) + (domain opensmtpd-action-relay-configuration-domain + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "domain" + (list false? opensmtpd-table-configuration?)))) + (default #f)) + (host opensmtpd-action-relay-configuration-host + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "host" + (list false? string?)))) + (default #f)) + (pki opensmtpd-action-relay-configuration-pki + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "pki" + (list false? opensmtpd-pki-configuration?))))) + (srs opensmtpd-action-relay-configuration-srs + (default #f) + (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "srs" + (list boolean?)))) + (tls opensmtpd-action-relay-configuration-tls + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "tls" + (list false? string?))))) + (auth opensmtpd-action-relay-configuration-auth + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "auth" + (list false? opensmtpd-table-configuration?)))) + (default #f)) + (mail-from opensmtpd-action-relay-configuration-mail-from + (default #f)) + ;; string "127.0.0.1" or "" or "
" + ;; TODO should I do some sanitizing to make sure that the string? here is actually an IP address or a valid interface? + (src opensmtpd-action-relay-configuration-src + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-action-relay-configuration" "src" + (list false? string? opensmtpd-table-configuration?)))) + (default #f))) + +;; this record is used by & +;; +(define-record-type* + opensmtpd-option-configuration make-opensmtpd-option-configuration + opensmtpd-option-configuration? + (option opensmtpd-option-configuration-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 " 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-configuration-not + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-option-configuration" "not" + (list boolean?))))) + (regex opensmtpd-option-configuration-regex + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-option-configuration" "regex" + (list boolean?))))) + (data opensmtpd-option-configuration-data + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-option-configuration" "data" + (list false? string? opensmtpd-table-configuration?)))))) + +(define-record-type* + opensmtpd-filter-phase-configuration make-opensmtpd-filter-phase-configuration + opensmtpd-filter-phase-configuration? + (name opensmtpd-filter-phase-configuration-name ;; string chain-name + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter-phase-configuration" "name" + (list string?))))) + (phase opensmtpd-filter-phase-configuration-phase ;; string + (default #f) + (sanitize (lambda (var) + ;;(my/sanitize var "opensmtpd-filter-phase-configuration" "phase" + ;; (list (sanitize-configuration + ;; (proc (lambda (value) + ;; (and (string? var) + ;; (string-in-list? var (list "connect" + ;; "helo" + ;; "mail-from" + ;; "rcpt-to" + ;; "data" + ;; "commit"))))) + ;; (error-message (list + ;; " fieldname: 'phase' is of type \n" + ;; "string. The string can be either 'connect'," + ;; " 'helo', 'mail-from', 'rcpt-to', 'data', or 'commit.'\n "))))) + (if (and (string? var) + (string-in-list? var (list "connect" + "helo" + "mail-from" + "rcpt-to" + "data" + "commit"))) + var + (begin + (display (string-append " 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-configuration-options + (default #f) + (sanitize (lambda (var) + ;; returns #t if list is a unique list of + (define (list-of-opensmtpd-option-configuration? list) + (and (list-of-type? list opensmtpd-option-configuration?) + (not (contains-duplicate? list)))) + + (define (list-has-duplicates-or-non-opensmtpd-option-configuration list) + (not (list-of-opensmtpd-option-configuration? list))) + + ;; input + ;; return #t if fieldname 'option' + ;; that needs a corresponding table has one. Otherwise #f + (define (opensmtpd-option-configuration-has-table? record) + (define decision (opensmtpd-option-configuration-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-configuration? (opensmtpd-option-configuration-data record)) + #t))) + + (define (list-of-opensmtpd-option-configuration-has-table? list) + (list-of-type? list opensmtpd-option-configuration-has-table?)) + + (define (some-opensmtpd-option-configuration-in-list-lack-table? list) + (not (list-of-opensmtpd-option-configuration-has-table? list))) + + ;;each element in list is of type + (cond [(list-has-duplicates-or-non-opensmtpd-option-configuration var) + (begin + (display (string-append " fieldname: 'options' is a list of unique \n" + " records.\n")) + (throw 'bad! var))] + ;; if fieldname 'option' is of string 'src', 'helo', 'mail-from', 'rcpt-to', then there should be a table + [(some-opensmtpd-option-configuration-in-list-lack-table? var) + (begin + (display (string-append "'s fieldname 'option' values of \n" + "'src', 'helo', 'mail-from', or 'rcpt-to' need a corresponding 'table' \n" + " of type . eg: \n" + "(opensmtpd-option-configuration \n" + " (option \"src\")\n" + " (table (opensmtpd-table-configuration \n" + " (name \"src-table\")\n" + " (data (list \"hello\" \"cat\")))))\n")) + ;; TODO it would be nice if the var this error message throws in the bad + ;; , instead of the list of records. + (throw 'bad! var))] + [else var])))) + (decision opensmtpd-filter-phase-configuration-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 " 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-configuration-message + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter-phase-configuration" "message" + (list false? string?))))) + (value opensmtpd-filter-phase-configuration-value + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-filter-phase-configuration" "value" + (list false? number?)))))) + +(define-record-type* + opensmtpd-filter-configuration make-opensmtpd-filter-configuration + opensmtpd-filter-configuration? + (name opensmtpd-filter-configuration-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-configuration-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?)))))) + +;; There is another type of filter that opensmtpd supports, which is a filter chain. +;; A filter chain is a list of and . +;; 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 or +;; returns # otherwise +(define (opensmtpd-filter-chain? %filters) + (and (list-of-unique-filter-or-filter-phase? %filters) + (< 1 (length %filters)))) + +(define-record-type* + opensmtpd-listen-on-configuration make-opensmtpd-listen-on-configuration + opensmtpd-listen-on-configuration? + ;; interface may be an IP address, interface group, or domain name + (interface opensmtpd-listen-on-configuration-interface + (default "lo")) + (family opensmtpd-listen-on-configuration-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 " fieldname 'family' must be string \"inet4\" or \"inet6\".\n") + (throw 'bad! var))])))) + (auth opensmtpd-listen-on-configuration-auth + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "auth" + (list boolean? table-whose-data-are-assoc-list?))))) + (auth-optional opensmtpd-listen-on-configuration-auth-optional + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "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-listen-on-configuration-filters + (default #f) + (sanitize (lambda (var) + (sanitize-filters var)))) + (hostname opensmtpd-listen-on-configuration-hostname + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "hostname" + (list false? string?))))) + (hostnames opensmtpd-listen-on-configuration-hostnames + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "hostnames" + (list false? table-whose-data-are-assoc-list?))))) + (mask-src opensmtpd-listen-on-configuration-mask-src + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "mask-src" + (list boolean?))))) + (disable-dsn opensmtpd-listen-on-configuration-disable-dsn + (default #f)) + (pki opensmtpd-listen-on-configuration-pki + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "pki" + (list false? opensmtpd-pki-configuration?))))) + (port opensmtpd-listen-on-configuration-port + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "port" + (list false? integer?))))) + (proxy-v2 opensmtpd-listen-on-configuration-proxy-k2 + (default #f)) + (received-auth opensmtpd-listen-on-configuration-received-auth + (default #f)) + ;; TODO add in a senders option! + ;; string or record + ;; (senders opensmtpd-listen-on-configuration-senders + ;; (sanitize (lambda (var) + ;; (my/sanitize var "opensmtpd-listen-on-configuration" "port" (list false? integer?)))) + ;; (default #f)) + (secure-connection opensmtpd-listen-on-configuration-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 " 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-listen-on-configuration-tag + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "tag" + (list false? string?)))) + (default #f))) + +(define-record-type* + opensmtpd-listen-on-socket-configuration-configuration make-opensmtpd-listen-on-socket-configuration-configuration + opensmtpd-listen-on-socket-configuration-configuration? + ;; false or or list of + (filters opensmtpd-listen-on-socket-configuration-configuration-filters + (sanitize (lambda (var) + (sanitize-filters var))) + (default #f)) + (mask-src opensmtpd-listen-on-socket-configuration-configuration-mask-src + (default #f)) + (tag opensmtpd-listen-on-socket-configuration-configuration-tag + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-listen-on-configuration" "tag" + (list false? string?)))) + (default #f))) + + +(define-record-type* + opensmtpd-match-configuration make-opensmtpd-match-configuration + opensmtpd-match-configuration? + ;;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-configuration-action + (default #f) + (sanitize (lambda (var) + (if (or (opensmtpd-action-relay-configuration? var) + (opensmtpd-action-local-delivery-configuration? var) + (eq? (quote reject) var)) + var + (begin + (display + (string-append " fieldname 'action' is of type , \n" + ", 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-configuration-options + (default #f) + (sanitize (lambda (var) + (cond ((not var) + #f) + ((not (list-of-unique-opensmtpd-option-configuration? var)) + (throw-error var '(" fieldname 'options' is a list of unique \n" + " records. \n"))) + (else (sanitize-list-of-options-for-match-configuration var))))))) + +(define-record-type* + opensmtpd-smtp-configuration make-opensmtpd-smtp-configuration + opensmtpd-smtp-configuration? + (ciphers opensmtpd-smtp-configuration-ciphers + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp-configuration" "ciphers" + (list false? string?))))) + (limit-max-mails opensmtpd-smtp-configuration-limit-max-mails + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp-configuration" "limit-max-mails" + (list false? integer?))))) + (limit-max-rcpt opensmtpd-smtp-configuration-limit-max-rcpt + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp-configuration" "limit-max-rcpt" + (list false? integer?))))) + (max-message-size opensmtpd-smtp-configuration-max-message-size + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp-configuration" "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-configuration-sub-addr-delim + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-smtp-configuration" "sub-addr-delim" + (list false? integer? string?)))))) + +(define-record-type* + opensmtpd-srs-configuration make-opensmtpd-srs-configuration + opensmtpd-srs-configuration? + ;; TODO should this be a file? + (key opensmtpd-srs-configuration-key + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-srs-configuration" "key" + (list false? boolean? string?))))) + ;; TODO should this also be a file? + (backup-key opensmtpd-srs-configuration-backup-key + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-srs-configuration" "backup-key" + (list false? integer?))))) + (ttl-delay opensmtpd-srs-configuration-ttl-delay + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-srs-configuration" "ttl-delay" + (list false? string?)))))) + +(define-record-type* + opensmtpd-queue-configuration make-opensmtpd-queue-configuration + opensmtpd-queue-configuration? + (compression opensmtpd-queue-configuration-compression + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-queue-configuration" "compression" + (list boolean?))))) + (encryption opensmtpd-queue-configuration-encryption + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-queue-configuration" "encryption" + (list boolean? file-exists? string?))))) + (ttl-delay opensmtpd-queue-configuration-ttl-delay + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-queue-configuration" "ttl-delay" + (list false? string?)))))) + (define-record-type* 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 . + (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-configuration?))))) + ;; list of many records of type opensmtpd-listen-on-configuration + (listen-ons opensmtpd-configuration-listen-ons + (default (list (opensmtpd-listen-on-configuration))) + (sanitize (lambda (var) + (if (list-of-opensmtpd-listen-on-configuration? var) + var + (begin + (display " fieldname 'listen-ons' expects a list of records ") + (display "of one or more unique records.\n") + (throw 'bad! var)))))) + ;; accepts type + (listen-on-socket opensmtpd-configuration-listen-on-socket + (default (opensmtpd-listen-on-socket-configuration-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?))))) + (matches opensmtpd-configuration-matches + (default (list (opensmtpd-match-configuration + (action (opensmtpd-action-local-delivery-configuration + (name "local") + (method "mbox"))) + (options (list + (opensmtpd-option-configuration + (option "for local"))))) + (opensmtpd-match-configuration + (action (opensmtpd-action-relay-configuration + (name "outbound"))) + (options (list + (opensmtpd-option-configuration + (option "from local")) + (opensmtpd-option-configuration + (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-configuration?))))) + ;; 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-configuration?))))) + (smtp opensmtpd-configuration-smtp + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-configuration" "smtp" + (list false? opensmtpd-smtp-configuration?))))) + (srs opensmtpd-configuration-srs + (default #f) + (sanitize (lambda (var) + (my/sanitize var "opensmtpd-configuration" "srs" + (list false? opensmtpd-srs-configuration?)))))) + +;; This is a non-exported record for passing around sanitize procedures. +;; As of 5/2/2022 I am not using it. I should probably just delete it. +(define-record-type* + sanitize-configuration make-sanitize-configuration + sanitize-configuration? + (proc sanitize-configuration-proc + (default #f) + ;;(sanitize (lambda (var) (procedure? var))) + ) + (args sanitize-configuration-args + (default #f) + ;;(sanitize (lambda (var) (lambda (var) (list? var)))) + ) + (error-message sanitize-configuration-error-message + (default #f) + ;;(sanitize (lambda (var) (list? var))) + ) + (error-if-proc-fails sanitize-configuration-error-if-proc-fails + (default #f))) + +;; 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) + (throw-error error-arg + (list "'s fieldname 'options' has two\n" + (string-append " 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-configuration-options +(define* (sanitize-list-of-options-for-match-configuration %options) + (let loop ([%traversing-options %options] + [%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-configuration-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-configuration-data option-record)) + (throw-error option-record + (list " with fieldname 'option' with value 'helo' \n" + "must have a 'data' of type string or .\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-configuration-data option-record)) + (throw-error option-record + (list " with fieldname 'option' with value 'mail-from' \n" + "must have a 'data' of type string or .\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-configuration-data option-record)) + (throw-error option-record + (list " with fieldname 'option' with value 'rcpt-to' \n" + "must have a 'data' of type string or .\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-configuration-data option-record))) + (throw-error option-record + (list " 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-configuration-data option-record) + (opensmtpd-option-configuration-regex option-record)) + (throw-error option-record + (list " with fieldname 'option' with value 'tls' \n" + "cannot have a string or table 'data'.\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 + `("'s fieldname 'options' can only have one 'for' option. \n" + "But '" ,option-string "' and '" + ,(opensmtpd-option-configuration-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-configuration-data option-record) + (opensmtpd-option-configuration-regex option-record))) + (throw-error option-record + (list "When '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-configuration-data option-record))) + (throw-error option-record + (list "When 's fieldname 'options' value is 'for domain' \n" + "or 'for rcpt-to', then its 'data' field must be a string or an \n" + " 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 + `("'s fieldname 'options' can only have one 'from' option. \n" + "But '" ,option-string "' and '" + ,(opensmtpd-option-configuration-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-configuration-data option-record) + (opensmtpd-option-configuration-regex option-record))) + (throw-error option-record + (list "When '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-configuration-data option-record))) + (throw-error option-record + (list "When 's fieldname 'options' value is 'from mail-from' \n" + "or 'from src', then its 'data' field must be a string or an \n" + " record.\n"))) + (else (loop (cdr %traversing-options) (alist-cons "from" option-record %sanitized-options))))]))))) + +;; some procedures for and +;; . +(define (sanitize-filters %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 " fieldname: 'filters' is a list, in which each unique element \n" + "is of type or .\n")) + (throw 'bad! %list))] + [else + (let loop ([%traversing-list %list] + [%original-list %list]) + (if (null? %traversing-list) + %original-list + (cond + [(opensmtpd-filter-configuration? (car %traversing-list)) + (loop (cdr %traversing-list) %original-list)] + [(filter-phase-has-message-and-value? (car %traversing-list)) + (begin + (display (string-append " 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 " fieldname: 'decision' options \n" + "\"disconnect\" and \"reject\" require fieldname 'message' to have a string.\n" + "The 'message' string must be RFC commpliant, which means that the string \n" + "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 " 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 " 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 " 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 (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-configuration-message record) + (opensmtpd-filter-phase-configuration-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-configuration-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-configuration-message record)) + #t] + [(string? (opensmtpd-filter-phase-configuration-message record)) + (let ((number (string->number + (substring + (opensmtpd-filter-phase-configuration-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-configuration-decision record)) + (if (string=? "rewrite" decision) + (if (and (number? (opensmtpd-filter-phase-configuration-value record)) + (eq? #f (opensmtpd-filter-phase-configuration-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-configuration-decision record) + (list "junk" "bypass")) + (or + (opensmtpd-filter-phase-configuration-value record) + (opensmtpd-filter-phase-configuration-message record)))) + +(define (filter-phase-junks-after-commit? record) + (and (string=? (opensmtpd-filter-phase-configuration-decision record) "junk") + (string=? (opensmtpd-filter-phase-configuration-phase record) "commit"))) + +;; returns #t if list is a unique list of or +;; returns # otherwise +(define (list-of-unique-filter-or-filter-phase? %filters) + (and (list? %filters) + (not (null? %filters)) + ;; this list is made up of only or + (primitive-eval + (cons 'and (map (lambda (filter) + (or (opensmtpd-filter-configuration? filter) + (opensmtpd-filter-phase-configuration? filter))) + %filters))) + (not (contains-duplicate? %filters)))) + +(define (throw-error var %strings) + (display (apply string-append %strings)) + (throw 'bad! var)) + +;; this is used for sanitizing 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-configuration? list) + (and (list-of-type? + list opensmtpd-option-configuration?) + (not (contains-duplicate? list)))) + +(define (list-of-opensmtpd-ca-configuration? list) + (list-of-type? list opensmtpd-ca-configuration?)) + +(define (list-of-opensmtpd-pki-configuration? list) + (list-of-type? list opensmtpd-pki-configuration?)) + +(define (list-of-opensmtpd-listen-on-configuration? list) + (and (list-of-type? list opensmtpd-listen-on-configuration?) + (not (contains-duplicate? list)))) + +(define (list-of-unique-opensmtpd-match-configuration? list) + (and (list-of-type? list opensmtpd-match-configuration?) + (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 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-configuration-type) procedure? +(define (table-whose-data-are-assoc-list? table) + (if (not (opensmtpd-table-configuration? table)) + #f + (assoc-list? (opensmtpd-table-configuration-data table)))) + +;; this procedure takes in one argument +;; if that argument is an 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-configuration? table)) + #f + (list-of-strings? (opensmtpd-table-configuration-data table)))) + +;; these next few functions help me to turn
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)) + +;; can be of type: (quote list-of-strings) or (quote assoc-list) +(define (opensmtpd-table-configuration->string table) + (string-append "table " (opensmtpd-table-configuration-name table) " " + (let ([type (opensmtpd-table-configuration-type table)]) + (cond [(eq? type (quote list-of-strings)) + (string-append "{ " (list-of-strings->string (opensmtpd-table-configuration-data table) + #:append "\"" + #:drop-right-number 3 + #:postpend "\"") " }")] + [(eq? type (quote assoc-list)) + (string-append "{ " (assoc-list->string (opensmtpd-table-configuration-data table)) " }")] + [(eq? type (quote db)) + (string-append "db:" (opensmtpd-table-configuration-data table))] + [(eq? type (quote file)) + (string-append "file:" (opensmtpd-table-configuration-data table))] + [else (throw 'youMessedUp table)])) + " \n")) + +;; The following functions convert various records into strings. + +(define (opensmtpd-listen-on-configuration->string record) + (string-append "listen on " + (opensmtpd-listen-on-configuration-interface record) " " + (let* ([hostname (opensmtpd-listen-on-configuration-hostname record)] + [hostnames (if (opensmtpd-listen-on-configuration-hostnames record) + (opensmtpd-table-configuration-name (opensmtpd-listen-on-configuration-hostnames record)) + #f)] + [filters (opensmtpd-listen-on-configuration-filters record)] + [filter-name (if filters + (if (< 1 (length filters)) + (generate-filter-chain-name filters) + (if (opensmtpd-filter-configuration? (car filters)) + (opensmtpd-filter-configuration-name (car filters)) + (opensmtpd-filter-phase-configuration-name (car filters)))) + #f)] + [mask-src (opensmtpd-listen-on-configuration-mask-src record)] + [tag (opensmtpd-listen-on-configuration-tag record)] + [secure-connection (opensmtpd-listen-on-configuration-secure-connection record)] + [port (opensmtpd-listen-on-configuration-port record)] + [pki (opensmtpd-listen-on-configuration-pki record)] + [auth (opensmtpd-listen-on-configuration-auth record)] + [auth-optional (opensmtpd-listen-on-configuration-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-configuration-domain pki) #:append "pki ") + "") + (if auth + (string-append "auth " + (if (opensmtpd-table-configuration? auth) + (string-append "<" (opensmtpd-table-configuration-name auth) "> ") + "")) + "") + (if auth-optional + (string-append "auth-optional " + (if (opensmtpd-table-configuration? auth-optional) + (string-append "<" (opensmtpd-table-configuration-name auth-optional) "> ") + "")) + "") + "\n")))) + +(define (opensmtpd-listen-on-socket-configuration->string record) + (string-append "listen on socket " + (let* ([filters (opensmtpd-listen-on-socket-configuration-configuration-filters record)] + [filter-name (if filters + (if (< 1 (length filters)) + (generate-filter-chain-name filters) + (if (opensmtpd-filter-configuration? (car filters)) + (opensmtpd-filter-configuration-name (car filters)) + (opensmtpd-filter-phase-configuration-name (car filters)))) + #f)] + [mask-src (opensmtpd-listen-on-socket-configuration-configuration-mask-src record)] + [tag (opensmtpd-listen-on-socket-configuration-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-action-relay-configuration->string record) + (let ([backup (opensmtpd-action-relay-configuration-backup record)] + [backup-mx (opensmtpd-action-relay-configuration-backup-mx record)] + [helo (opensmtpd-action-relay-configuration-helo record)] + ;; helo-src can either be a string IP address or an + [helo-src (if (opensmtpd-action-relay-configuration-helo-src record) + (if (string? (opensmtpd-action-relay-configuration-helo-src record)) + (opensmtpd-action-relay-configuration-helo-src record) + (string-append "<\"" + (opensmtpd-table-configuration-name + (opensmtpd-action-relay-configuration-src record)) + "\">")) + #f)] + [domain (if (opensmtpd-action-relay-configuration-domain record) + (opensmtpd-table-configuration-name + (opensmtpd-action-relay-configuration-domain record)) + #f)] + [host (opensmtpd-action-relay-configuration-host record)] + [name (opensmtpd-action-relay-configuration-name record)] + [pki (if (opensmtpd-action-relay-configuration-pki record) + (opensmtpd-pki-configuration-domain (opensmtpd-action-relay-configuration-pki record)) + #f)] + [srs (opensmtpd-action-relay-configuration-srs record)] + [tls (opensmtpd-action-relay-configuration-tls record)] + [auth (if (opensmtpd-action-relay-configuration-auth record) + (opensmtpd-table-configuration-name + (opensmtpd-action-relay-configuration-auth record)) + #f)] + [mail-from (opensmtpd-action-relay-configuration-mail-from record)] + ;; src can either be a string IP address or an + [src (if (opensmtpd-action-relay-configuration-src record) + (if (string? (opensmtpd-action-relay-configuration-src record)) + (opensmtpd-action-relay-configuration-src record) + (string-append "<\"" + (opensmtpd-table-configuration-name + (opensmtpd-action-relay-configuration-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-configuration->string record) + (string-append "lmtp " + (opensmtpd-lmtp-configuration-destination record) + (if (opensmtpd-lmtp-configuration-rcpt-to record) + (begin + " " (opensmtpd-lmtp-configuration-rcpt-to record)) + ""))) + +(define (opensmtpd-mda-configuration->string record) + (string-append "mda " + (opensmtpd-mda-configuration-command record) " ")) + +(define (opensmtpd-maildir-configuration->string record) + (string-append "maildir " + "\"" + (if (opensmtpd-maildir-configuration-pathname record) + (opensmtpd-maildir-configuration-pathname record) + "~/Maildir") + "\"" + (if (opensmtpd-maildir-configuration-junk record) + " junk " + " "))) + +(define (opensmtpd-action-local-delivery-configuration->string record) + (let ([name (opensmtpd-action-local-delivery-configuration-name record)] + [method (opensmtpd-action-local-delivery-configuration-method record)] + [alias (if (opensmtpd-action-local-delivery-configuration-alias record) + (opensmtpd-table-configuration-name + (opensmtpd-action-local-delivery-configuration-alias record)) + #f)] + [ttl (opensmtpd-action-local-delivery-configuration-ttl record)] + [user (opensmtpd-action-local-delivery-configuration-user record)] + [userbase (if (opensmtpd-action-local-delivery-configuration-userbase record) + (opensmtpd-table-configuration-name + (opensmtpd-action-local-delivery-configuration-userbase record)) + #f)] + [virtual (if (opensmtpd-action-local-delivery-configuration-virtual record) + (opensmtpd-table-configuration-name + (opensmtpd-action-local-delivery-configuration-virtual record)) + #f)] + [wrapper (opensmtpd-action-local-delivery-configuration-wrapper record)]) + (string-append + "\"" name "\" " + (cond [(string? method) + (string-append method " ")] + [(opensmtpd-mda-configuration? method) + (opensmtpd-mda-configuration->string method)] + [(opensmtpd-lmtp-configuration? method) + (opensmtpd-lmtp-configuration->string method)] + [(opensmtpd-maildir-configuration? method) + (opensmtpd-maildir-configuration->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-action-local-delivery-configuration and +;; opensmtpd-action-relay-configuration into strings. +(define (opensmtpd-action->string record) + (string-append "action " + (cond [(opensmtpd-action-local-delivery-configuration? record) + (opensmtpd-action-local-delivery-configuration->string record)] + [(opensmtpd-action-relay-configuration? record) + (opensmtpd-action-relay-configuration->string record)]) + " \n")) + +;; this turns option records found in into strings. +(define* (opensmtpd-option-configuration->string record + #:key + (space-after-! #f)) + (let ([not (opensmtpd-option-configuration-not record)] + [option (opensmtpd-option-configuration-option record)] + [regex (opensmtpd-option-configuration-regex record)] + [data (opensmtpd-option-configuration-data record)]) + (string-append + (if not + (if space-after-! + "! " + "!") + "") + option " " + (if regex + "regex " + "") + (if data + (if (opensmtpd-table-configuration? data) + (string-append "<" (opensmtpd-table-configuration-name data) "> ") + (string-append data " ")) + "")))) + +(define (opensmtpd-match-configuration->string record) + (string-append "match " + (let* ([action (opensmtpd-match-configuration-action record)] + [name (cond [(opensmtpd-action-relay-configuration? action) + (opensmtpd-action-relay-configuration-name action)] + [(opensmtpd-action-local-delivery-configuration? action) + (opensmtpd-action-local-delivery-configuration-name action)] + [else 'reject])] + [options (opensmtpd-match-configuration-options record)]) + (string-append + (if options + (apply string-append + (map opensmtpd-option-configuration->string options)) + "") + (if (string? name) + (string-append "action " "\"" name "\" ") + "reject ") + "\n")))) + +(define (opensmtpd-ca-configuration->string record) + (string-append "ca " (opensmtpd-ca-configuration-name record) " " + "cert \"" (opensmtpd-ca-configuration-file record) "\"\n")) + +(define (opensmtpd-pki-configuration->string record) + (let ([domain (opensmtpd-pki-configuration-domain record)] + [cert (opensmtpd-pki-configuration-cert record)] + [key (opensmtpd-pki-configuration-key record)] + [dhe (opensmtpd-pki-configuration-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-configuration? filter) + (opensmtpd-filter-configuration-name filter) + (opensmtpd-filter-phase-configuration-name filter)) + "-")) + list-of-filters))) + 1)) + +;; this procedure takes in a list of and , +;; 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-configuration? filter) + (opensmtpd-filter-configuration-name filter) + (opensmtpd-filter-phase-configuration-name filter)) + "\", ")) + list-of-filters)) + ) 2) + "}\n")) + +(define (opensmtpd-filter-phase-configuration->string record) + (let ([name (opensmtpd-filter-phase-configuration-name record)] + [phase (opensmtpd-filter-phase-configuration-phase record)] + [decision (opensmtpd-filter-phase-configuration-decision record)] + [options (opensmtpd-filter-phase-configuration-options record)] + [message (opensmtpd-filter-phase-configuration-message record)] + [value (opensmtpd-filter-phase-configuration-value record)]) + (string-append "filter " + "\"" name "\" " + "phase " phase " " + "match " + (apply string-append ; turn the options into a string + (flatten + (map (lambda (option) + (opensmtpd-option-configuration->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 , , +;; and lists that look like (list (opensmtpd-filter-configuration...) (opensmtpd-filter-phase-configuration ...) +;; ...) +;; this function converts it to a string. +;; Consider if a user passed in a valid , 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-configuration ; 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->string filters) + ;; first display the unique s. and s. + ;; to do this: flatten filters, then remove duplicates. + (string-append + (apply string-append + (map (lambda (filter) + (cond ((opensmtpd-filter-phase-configuration? filter) + (opensmtpd-filter-phase-configuration->string filter)) + (else ; you are a + (string-append "filter " + "\"" (opensmtpd-filter-configuration-name filter) "\" " + (if (opensmtpd-filter-exec filter) + "proc-exec " + "proc ") + "\"" (opensmtpd-filter-configuration-proc filter) "\"" + "\n")))) + (delete-duplicates (flatten filters)))) + ;; now we have to print the filter chains. + (apply string-append + (remove boolean? + (map (lambda (filter) + (cond ((list? filter) + (opensmtpd-filter-chain->string filter)) + (else ; you are a + #f))) + filters))))) + +(define (opensmtpd-configuration-listen->string string) + (string-append + "include \"" string "\"\n")) + +(define (opensmtpd-configuration-srs->string record) + (let ([key (opensmtpd-srs-configuration-key record)] + [backup-key (opensmtpd-srs-configuration-backup-key record)] + [ttl-delay (opensmtpd-srs-configuration-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-configuration->string record) + (let ([ciphers (opensmtpd-smtp-configuration-ciphers record)] + [limit-max-mails (opensmtpd-smtp-configuration-limit-max-mails record)] + [limit-max-rcpt (opensmtpd-smtp-configuration-limit-max-rcpt record)] + [max-message-size (opensmtpd-smtp-configuration-max-message-size record)] + [sub-addr-delim (opensmtpd-smtp-configuration-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-configuration-compression record)] + [encryption (opensmtpd-queue-configuration-encryption record)] + [ttl-delay (opensmtpd-queue-configuration-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 from +;; opensmtpd-configuration-matches, which is a list of . +;; Each has a fieldname 'action', which accepts an . +(define (get-opensmtpd-actions record) + (define opensmtpd-actions + (let loop ([list (opensmtpd-configuration-matches record)]) + (if (null? list) + '() + (cons (opensmtpd-match-configuration-action (car list)) + (loop (cdr list)))))) + (delete-duplicates (append opensmtpd-actions))) + +;; build a list of opensmtpd-pki-configurations from +;; opensmtpd-configuration-listen-ons and +;; get-opensmtpd-actions +(define (get-opensmtpd-pki-configurations record) + ;; TODO/FIXME/maybe/wishlist could get-opensmtpd-actions -> NOT have an opensmtpd-action-relay-configuration? + ;; 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-action-relay-configuration? (car list)) + (opensmtpd-action-relay-configuration-pki (car list))) + (cons (opensmtpd-action-relay-configuration-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-listen-on-configuration-pki (car list)) + (cons (opensmtpd-listen-on-configuration-pki (car list)) + (loop2 (cdr list))) + (loop2 (cdr list)))))) + (delete-duplicates (append action-pkis listen-on-pkis))) + +;; takes in a and returns a list whose elements are , +;; , and a filter-chain. +;; It returns a list of and/or +;; here's an example of what this procedure might return: +;; (list (opensmtpd-filter-configuration...) (opensmtpd-filter-phase-configuration ...) +;; (openmstpd-filter ...) (opensmtpd-filter-phase-configuration ...) +;; ;; this next list is a filter-chain. +;; (list (opensmtpd-filter-phase-configuration ...) (opensmtpd-filter-configuration...))) +;; +;; 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-listen-on-socket-configuration-configuration-filters (opensmtpd-configuration-listen-on-socket record)) + (opensmtpd-listen-on-socket-configuration-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 s + (if (and (opensmtpd-listen-on-configuration-filters listen-on-record) + (= 1 (length (opensmtpd-listen-on-configuration-filters + listen-on-record)))) + (car (opensmtpd-listen-on-configuration-filters listen-on-record)) + (opensmtpd-listen-on-configuration-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 s assuming the thing you passed into it had +;; any 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-configuration? 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)))))]))) + + +;; 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))))) + + (mixed-text-file "opensmtpd.conf" + (string-append + ;; write out the includes + (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-includes + opensmtpd-configuration-listen->string) + (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-configuration->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-configuration->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->string (get-opensmtpd-filters record)) + ;; write out all the cas + (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-cas opensmtpd-ca-configuration->string) + ;; write out all the pkis + (opensmtpd-configuration-fieldname->string record get-opensmtpd-pki-configurations opensmtpd-pki-configuration->string) + ;; write all of the listen-on-records + (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-listen-ons + opensmtpd-listen-on-configuration->string) + (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-listen-on-socket + opensmtpd-listen-on-socket-configuration->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-configuration->string)))) + (define %default-opensmtpd-config-file (plain-file "smtpd.conf" " -- 2.36.1