Subject: [bug#56046] [PATCH] services: mail: add opensmtpd records to enhance opensmtpd-configuration. Version 2

From: Liliana Marie Prikler <[email-masked]>
Date: Wed, 06 Jul 2022 06:27:44 +0200

Am Montag, dem 04.07.2022 um 17:17 -0400 schrieb Joshua Branson:
> 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).
Not a ChangeLog.
> 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.
Neither is this.
> * doc/guix.texi added documentation for the new records for
> opensmtpd.
Or this.
> ---
>  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}
I suggest using fractions here.
> [...]
> +This is a string of one of these options:
> +
> +@multitable {aaaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
Same here.  Btw. I did not actually check all the doc in between, so I
might be missing something.
> +@multitable {aaaaaaaaaaaaaaaaaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
Likewise.
> +@multitable {aaaaaaaaaa}
> {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
You get the drill.

> [more doc with strange multitables]
> 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))
I'm pretty sure it'd be fine to use not in lieu of false?, even at the
risk of matching nil.

> +;; 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))])))
Don't we have field sanitizers already that make this obsolete?

> +;; 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))
Is this not part of the Guile standard library?

> +(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 <opensmtpd-pki-configuration> record, "]
> +                   [(eq? opensmtpd-table-configuration? (car
> procedures))
> +                    "an <opensmtpd-table-configuration> record, "]
> +                   [(eq? list-of-unique-opensmtpd-match-
> configuration? (car procedures))
> +                    "a list of unique <opensmtpd-match-
> configuration> records, "]
> +                   [(eq? table-whose-data-are-assoc-list? (car
> procedures))
> +                    (string-append
> +                    "an <opensmtpd-table-configuration> 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")))
Using a table, map and string-join might be wiser.  If this is the only
place add-comma-or is used, you can replace it by 
(string-append 
  (string-join (butlast strings) ",")
  ", or " (last strings))
where you only need to define butlast.

> +;; 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))))
Ever heard of member?

> +(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" . "[email-masked]") ("joshua" .
> "[email-masked]"))))
> +;;  (opensmtpd-table-configuration (name "root accounts") (data
> (list "mysite.me" "your-site.com")))
> +;;  TODO should <opensmtpd-table-configuration> support have a
> fieldname 'file'?
> +;;  Or should I change name to name-or-file ?
> +(define-record-type* <opensmtpd-table-configuration>
> +  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 =
> [email-masked],[email-masked],[email-masked], root =
> [email-masked] }
> +  ;; If values is an absolute filename, then it will use said
> filename to house the table info.
> +  ;; filename must be an absolute filename.
> +  (data opensmtpd-table-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" . "[email-masked]") ("james" .
> "[email-masked]"))
> +  ;; I am currently making these values be as assocation list of
> strings only.
> +  ;; FIXME should I allow a var like this?
> +  ;; (list (cons "gnucode.me" 234.949.392.23))
> +  ;; can be of type: (quote list-of-strings) or (quote assoc-list)
> +  ;; (opensmtpd-table-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))]
Just a quick side note, we don't usually intermix [ and (.  It's all (.
> [skipping a bit of stuff, may check later...]
> +(define-record-type* <opensmtpd-option-configuration>
> +  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 "<opensmtpd-
> option-configuration> 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))))))
This is a little verbose for what it does.

> +(define-record-type* <opensmtpd-listen-on-configuration>
What is a "listen-on"?
> +(define-record-type* <opensmtpd-listen-on-socket-configuration-
> configuration>
Again, could this just be <opensmtpd-socket-configuration>?
>  (define-record-type* <opensmtpd-configuration>
>    opensmtpd-configuration make-opensmtpd-configuration
>    opensmtpd-configuration?
> -  (package     opensmtpd-configuration-package
> -               (default opensmtpd))
> +  (package opensmtpd-configuration-package
> +           (default opensmtpd))
>    (config-file opensmtpd-configuration-config-file
> -               (default %default-opensmtpd-config-file)))
> +               (default #f))
> +  ;; FIXME/TODO should I include a admd authservid entry?
> +
> +  ;; TODO sanitize this properly with perhaps a <sanitize-
> configuration>.
> +  (bounce opensmtpd-configuration-bounce
> +          (default #f)
> +          (sanitize (lambda (var)
> +                      (my/sanitize var "opensmtpd-configuration"
> "bounce"
> +                                   (list false? list?)))))
> +  (cas opensmtpd-configuration-cas
> +       (default #f)
> +       (sanitize (lambda (var)
> +                   (my/sanitize var "opensmtpd-configuration" "cas"
> +                                (list false? list-of-opensmtpd-ca-
> configuration?)))))
> +  ;; list of many records of type opensmtpd-listen-on-configuration
> +  (listen-ons opensmtpd-configuration-listen-ons
What does opensmtpd acutally listen on?

> [...]
Too much to check, too little time.  Maybe return later.