linode-guix-system-configuration/opensmtpd-records.scm

;; sudo guix system -L ../linode/ reconfigure sway.scm
;; use the above to test this code on an actual system.
;; An example configuration can usually be found in in the below link,
;; near the top of the file:  https://notabug.org/jbranso/guix-config/src/master/opensmtpd-records.scm
;;
;; You can test various non-exported functions in the repl like so:
;; Try this -> ((@@ (opensmtpd-records) opensmtpd-configuration->mixed-text-file) (opensmtpd-configuration))
;; (@@ (opensmtpd-records) opensmtpd-listen-on-configuration->string) (opensmtpd-listen-on))

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

            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
            ))

;; 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)
  (if (null? list-of-procedures)
        #f
        (if ((car list-of-procedures) var)
              #t
              (is-value-right-type? var (cdr list-of-procedures)))))

;; 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 <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")))

;; 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 <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 = 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>
  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>
  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>
  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>
  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>
  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>
  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 "<opensmtpd-action-local-delivery-configuration> fieldname 'method' must be of type \n"
                                                  "\"mbox\", \"expand-only\", \"forward-only\" \n"
                                                  "<opensmtpd-lmtp-configuration>, <opensmtpd-maildir-configuration>, \n"
                                                  "or <opensmtpd-mda-configuration>.\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>
  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 "<interface>" or "<table of IP addresses>"
  ;; TODO should I do some sanitizing to make sure that the string? here is actually an IP address or a valid interface?
  (src opensmtpd-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 <opensmtpd-filter-phase-configuration> &
;; <opensmtpd-match-configuration>
(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))))))
  (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>
  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
                          ;;                                    "<opensmtpd-filter-phase-configuration> 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 "<opensmtpd-filter-phase-configuration> 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 <opensmtpd-option-configuration>
                          (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 <opensmtpd-option-configuration>
                          ;; return #t if <opensmtpd-option-configuration> 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 <opensmtpd-option-configuration>
                          (cond [(list-has-duplicates-or-non-opensmtpd-option-configuration var)
                                 (begin
                                   (display (string-append "<opensmtpd-filter-phase-configuration> fieldname: 'options' is a list of unique \n"
                                                           "<opensmtpd-option-configuration> 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 "<opensmtpd-option-configuration>'s fieldname 'option' values of \n"
                                                           "'src', 'helo', 'mail-from', or 'rcpt-to' need a corresponding 'table' \n"
                                                           " of type <opensmtpd-table-configuration>. 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
                                   ;; <opensmtpd-option-configuration>, 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 "<opensmtpd-filter-decision> fieldname: 'decision' is of type \n"
                                                      "string.  The string can be either 'bypass',"
                                                      " 'disconnect', 'reject', 'rewrite', or 'junk'.\n"))
                              (throw 'bad! var))))))
  (message opensmtpd-filter-phase-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>
  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 <opensmtpd-filter-phase-configuration> and <opensmtpd-filter-configuration>.
;; This lets you apply several filters under one filter name.  I could have defined
;; a record type for it, but the record would only have had two fields: name and list-of-filters.
;; Why write that as a record?  That's too simple.
;; returns #t if list is a unique list of <opensmtpd-filter-configuration> or <opensmtpd-filter-phase-configuration>
;; 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>
  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 "<opensmtpd-listen-on-configuration> 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 <opensmtpd-senders> 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 "<opensmtd-listen-on> fieldname 'secure-connection' can be \n"
                                                                  "one of the following strings: \n'smtps', 'tls', 'tls-require', \n"
                                                                  "or 'tls-require-verify'.\n"))
                                          (throw 'bad! var))]))))
  (tag opensmtpd-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>
  opensmtpd-listen-on-socket-configuration-configuration make-opensmtpd-listen-on-socket-configuration-configuration
  opensmtpd-listen-on-socket-configuration-configuration?
  ;; false or <opensmtpd-filter-configuration> or list of <opensmtpd-filter-configuration>
  (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>
  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 "<opensmtpd-match-configuration> fieldname 'action' is of type <opensmtpd-action-relay-configuration>, \n"
                                            "<opensmtpd-action-local-delivery-configuration>, 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 '("<opensmtpd-match-configuration> fieldname 'options' is a list of unique \n"
                                                 "<opensmtpd-option-configuration> records. \n")))
                           (else (sanitize-list-of-options-for-match-configuration var)))))))

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

  ;; TODO sanitize this properly with perhaps a <sanitize-configuration>.
  (bounce opensmtpd-configuration-bounce
          (default #f)
          (sanitize (lambda (var)
                      (my/sanitize var "opensmtpd-configuration" "bounce"
                                   (list false? list?)))))
  (cas opensmtpd-configuration-cas
       (default #f)
       (sanitize (lambda (var)
                   (my/sanitize var "opensmtpd-configuration" "cas"
                                (list false? list-of-opensmtpd-ca-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 "<opensmtpd-configuration> fieldname 'listen-ons' expects a list of records ")
                                (display "of one or more unique <opensmtpd-listen-on-configuration> records.\n")
                                (throw 'bad! var))))))
  ;; accepts type <opensmtpd-listen-on-socket-configuration-configuration>
  (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 procedure sanitizes the fieldname opensmtpd-match-configuration-options
(define* (sanitize-list-of-options-for-match-configuration %options
                                                           #:key
                                                           (for #f)
                                                           (from #f)
                                                           (auth #f)
                                                           (helo #f)
                                                           (mail-from #f)
                                                           (rcpt-to #f)
                                                           (tag #f)
                                                           (tls #f))
  (if (null? %options)
      (remove false?
              (list for from auth helo mail-from rcpt-to tag tls))
      (let* ((option-record (car %options))
             (option-string (opensmtpd-option-configuration-option option-record)))
        (cond ((string=? "auth" option-string)
               (if auth
                   (throw-error %options
                                '("<opensmtpd-match-configuration>'s fieldname 'options' has two records of type \n"
                                  "<opensmtpd-option-configuration> with fieldname 'option' with value 'auth'. \n"
                                  "You can only have one option with value 'auth' in the options list.\n"))
                   (sanitize-list-of-options-for-match-configuration (cdr %options)
                                             #:for for
                                             #:from from
                                             #:auth option-record
                                             #:helo helo
                                             #:mail-from mail-from
                                             #:rcpt-to rcpt-to
                                             #:tag tag
                                             #:tls tls)))
              ((string=? "helo" option-string)
               (cond (helo
                      (throw-error %options
                                   (list "<opensmtpd-match-configuration>'s fieldname 'options' has two records of type \n"
                                         "<opensmtpd-option-configuration> with fieldname 'option' with value 'helo'. \n"
                                         "You can only have one option with value 'helo' in the options list.\n")))
                     ((not (opensmtpd-option-configuration-data option-record))
                      (throw-error option-record
                                   (list "<opensmtpd-option-configuration> with fieldname 'option' with value 'helo' \n"
                                         "must have a 'data' of type string or <opensmtpd-table-configuration>.\n")))
                     (else (sanitize-list-of-options-for-match-configuration (cdr %options)
                                                     #:for for
                                                     #:from from
                                                     #:auth auth
                                                     #:helo option-record
                                                     #:mail-from mail-from
                                                     #:rcpt-to rcpt-to
                                                     #:tag tag
                                                     #:tls tls))))
              ((string=? "tag" option-string)
               (cond (tag
                      (throw-error %options
                                   (list
                                    "<opensmtpd-match-configuration>'s fieldname 'options' has two records of type \n"
                                    "<opensmtpd-option-configuration> with fieldname 'option' with value 'tag'. \n"
                                    "You can only have one option with value 'tag' in the options list.\n")))
                     ((not (string? (opensmtpd-option-configuration-data option-record)))
                      (throw-error option-record
                                   (list "<opensmtpd-option-configuration> with fieldname 'option' with value 'tag' \n"
                                         "must have a 'data' of type string.\n")))
                     (else (sanitize-list-of-options-for-match-configuration (cdr %options)
                                                     #:for for
                                                     #:from from
                                                     #:auth auth
                                                     #:helo helo
                                                     #:mail-from mail-from
                                                     #:rcpt-to rcpt-to
                                                     #:tag option-record
                                                     #:tls tls))))
              ((string=? "tls" option-string)
               (if tls
                   (begin
                     (display (string-append
                               "<opensmtpd-match-configuration>'s fieldname 'options' has two records of type \n"
                               "<opensmtpd-option-configuration> with fieldname 'option' with value 'tls'. \n"
                               "You can only have one option with value 'tls' in the options list.\n"))
                     (throw 'bad! %options))
                   (sanitize-list-of-options-for-match-configuration (cdr %options)
                                             #:for for
                                             #:from from
                                             #:auth auth
                                             #:helo helo
                                             #:mail-from mail-from
                                             #:rcpt-to rcpt-to
                                             #:tag tag
                                             #:tls option-record)))
              ((string=? "mail-from" option-string)
               (cond (mail-from
                      (begin
                        (display (string-append
                                  "<opensmtpd-match-configuration>'s fieldname 'options' has two records of type \n"
                                  "<opensmtpd-option-configuration> with fieldname 'option' with value 'mail-from'. \n"
                                  "You can only have one option with value 'mail-from' in the options list.\n"))
                        (throw 'bad! %options)))
                     ((not (opensmtpd-option-configuration-data option-record))
                      (throw-error option-record
                                   (list "<opensmtpd-option-configuration> with fieldname 'option' with value 'mail-from' \n"
                                         "must have a 'data' of type string or <opensmtpd-table-configuration>.\n")))
                     (else (sanitize-list-of-options-for-match-configuration (cdr %options)
                                                                             #:for for
                                                                             #:from from
                                                                             #:auth auth
                                                                             #:helo helo
                                                                             #:mail-from option-record
                                                                             #:rcpt-to rcpt-to
                                                                             #:tag tag
                                                                             #:tls tls))))
              ((string=? "rcpt-to" option-string)
               (if rcpt-to
                   (begin
                     (display (string-append
                               "<opensmtpd-match-configuration>'s fieldname 'options' has two records of type \n"
                               "<opensmtpd-option-configuration> with fieldname 'option' with value 'rcpt-to'. \n"
                               "You can only have one option with value 'rcpt-to' in the options list.\n"))
                     (throw 'bad! %options))
                   (sanitize-list-of-options-for-match-configuration (cdr %options)
                                             #:for for
                                             #:from from
                                             #:auth auth
                                             #:helo helo
                                             #:mail-from mail-from
                                             #:rcpt-to option-record
                                             #:tag tag
                                             #:tls tls)))
              ((string=? "for" (substring option-string 0 3))
               (cond (for
                      (throw-error %options
                                   `("<opensmtpd-match-configuration>'s fieldname 'options' can only have one 'for' option. \n"
                                     "But '" ,option-string "' and '" ,(opensmtpd-option-configuration-option 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 <openmstpd-option-configuration>'s fieldname 'options' value is 'for any' \n"
                                              "or 'for local', then its 'data' and 'regex' field must be #f. \n")))
                     ((and (string-in-list? option-string (list "for domain" "for rcpt-to")) ; for domain must have a data field.
                           (not (opensmtpd-option-configuration-data option-record)))
                           (throw-error option-record
                                        (list "When <openmstpd-option-configuration>'s fieldname 'options' value is 'for domain' \n"
                                              "or 'for rcpt-to', then its 'data' field must be a string or an \n"
                                              "<opensmtpd-table-configuration> record.\n")))
                     (else (sanitize-list-of-options-for-match-configuration (cdr %options)
                                                                             #:for option-record
                                                                             #:from from
                                                                             #:auth auth
                                                                             #:helo helo
                                                                             #:mail-from mail-from
                                                                             #:rcpt-to rcpt-to
                                                                             #:tag tag
                                                                             #:tls tls))))
              ((string=? "from" (substring option-string 0 4))
               (cond (from
                      (throw-error %options
                                   `("<opensmtpd-match-configuration>'s fieldname 'options' can only have one 'from' option. \n"
                                     "But '" ,option-string "' and '" ,(opensmtpd-option-configuration-option 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 <openmstpd-option-configuration>'s fieldname 'options' value is 'from any', \n"
                                              " 'from local', or 'from socket', then its 'data' and 'regex' field must be #f. \n")))
                     ((and (string-in-list? option-string (list "from mail-from" "from src")) ; for domain must have a data field.
                           (not (opensmtpd-option-configuration-data option-record)))
                           (throw-error option-record
                                        (list "When <openmstpd-option-configuration>'s fieldname 'options' value is 'from mail-from' \n"
                                              "or 'from src', then its 'data' field must be a string or an \n"
                                              "<opensmtpd-table-configuration> record.\n")))
                     (else (sanitize-list-of-options-for-match-configuration (cdr %options)
                                                                             #:for for
                                                                             #:from option-record
                                                                             #:auth auth
                                                                             #:helo helo
                                                                             #:mail-from mail-from
                                                                             #:rcpt-to rcpt-to
                                                                             #:tag tag
                                                                             #:tls tls))))))))

;; some procedures for <opensmtpd-listen-on-configuration> and
;; <opensmtpd-listen-on-socket-configuration-configuration>.
(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 "<opensmtpd-listen-on-configuration> fieldname: 'filters' is a list, in which each unique element \n"
                                   "is of type <opensmtpd-filter-configuration> or <opensmtpd-filter-phase-configuration>.\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 "<opensmtpd-filter-phase-configuration> cannot have defined fieldnames 'value' \n"
                                           "and 'message'.\n"))
                   (throw 'bad! (car %traversing-list)))]
                [(filter-phase-decision-lacks-proper-message? (car %traversing-list))
                 (begin
                   (display (string-append "<opensmtpd-filter-phase-configuration> 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 "<opensmtpd-filter-phase-configuration> fieldname: 'decision' option \n"
                                           "\"rewrite\" requires fieldname 'value' to have a number.\n"))
                   (throw 'bad! (car %traversing-list)))]
                [(filter-phase-has-incorrect-junk-or-bypass? (car %traversing-list))
                 (begin
                   (display (string-append "<opensmtpd-filter-phase-configuration> fieldname 'decision' option \n"
                                           "\"junk\" or 'bypass' cannot have a defined fieldnames 'message' or 'value'.\n"))
                   (throw 'bad! (car %traversing-list)))]
                [(filter-phase-junks-after-commit? (car %traversing-list))
                 (begin
                   (display (string-append "<opensmtpd-filter-phase-configuration> 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 <opensmtpd-filter-configuration> or <opensmtpd-filter-phase-configuration>
;; returns # otherwise
(define (list-of-unique-filter-or-filter-phase? %filters)
  (and (list? %filters)
       (not (null? %filters))
       ;; this list is made up of only <opensmtpd-filter-phase-configuration> or <opensmtpd-filter-configuration>
       (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 <opensmtpd-filter-phase-configuration> 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 <opensmtpd-table-configuration> 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 <opensmtpd-table-configuration> 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 <table>s
;; into strings suitable to fit into "opensmtpd.conf".
(define (assoc-list->string assoc-list)
  (string-drop-right
   (let loop ([assoc-list assoc-list])
     (if (null? assoc-list)
         ""
         ;; pair is (cons "hello" "world") -> ("hello" . "world")
         (let ([pair (car assoc-list)])
           (string-append
            "\"" (car pair)  "\""
            " = "
            "\"" (cdr pair) "\""
            ", "
            (loop (cdr assoc-list))))))
   2))

;; 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 <opensmtpd-table-configuration>
        [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 <opensmtpd-table-configuration>
        [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 <opensmtpd-match-configuration> 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 <opensmtpd-filter-configuration> and <opensmtpd-filter-phase-configuration>,
;; 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 <opensmtpd-filter-configuration>, <opensmtpd-filter-phase-configuration>,
;; 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 <opensmtpd-configuration>, whose total valid filters
;; so that (get-opensmtpd-filters (opensmtpd-configuration)) returns
;; look like this: (we will call this list "total filters"):
;; (list (opensmtpd-filter
;;         (name "rspamd")
;;         (proc "rspamd"))
;;       (list (opensmtpd-filter-phase-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 <opensmtpd-filter-configuration>s. and <opensmtpd-filter-phase-configuration>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 <opensmtpd-filter-configuration>
                        (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 <opensmtpd-filter-configuration>
                                #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 <opensmtpd-action> from
;; opensmtpd-configuration-matches, which is a list of <opensmtpd-match-configuration>.  Each <opensmtpd-match-configuration> has a fieldname
;; 'action', which accepts an <opensmtpd-action>.
(define (get-opensmtpd-actions record)
  (define opensmtpd-actions
    (let loop ([list (opensmtpd-configuration-matches record)])
      (if (null? list)
          '()
          (cons (opensmtpd-match-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 <opensmtpd-configuration> and returns a list whose elements are <opensmtpd-filter-configuration>,
;; <opensmtpd-filter-phase-configuration>, and a filter-chain.
;; It returns a list of <opensmtpd-filter-configuration> and/or <opensmtpd-filter-phase-configuration>
;; 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 <listen-on-record>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 <opensmtpd-table-configuration>s assuming the thing you passed into it had
;; any <opensmtpd-table-configuration>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
;; TODO this function is wasteful.  For every value it gets,
;; it is calling (delete-duplicates (remove boolean? (flatten))).  Some of the
;; elements it gets are records. It should only call (delete-duplicates (remove boolean? (flatten)))
;; once.
(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 (opensmtpd-shepherd-service config)
  (list (shepherd-service
         (provision '(smtpd ;;config
                      ))
         (requirement '(loopback))
         (documentation "Run the OpenSMTPD daemon.")
         ;; FIXME/TODO add a config option to show the current smtpd.conf file.
         ;; (config #~(display (or #$(opensmtpd-configuration-config-file config)
         ;;                        #$(opensmtpd-configuration->mixed-text-file config))))
         (start (let ((smtpd (file-append (opensmtpd-configuration-package config) "/sbin/smtpd")))
                  #~(make-forkexec-constructor
                     (list #$smtpd "-f" (or #$(opensmtpd-configuration-config-file config)
                                            #$(opensmtpd-configuration->mixed-text-file config)))
                     #:pid-file "/var/run/smtpd.pid")))
         (stop #~(make-kill-destructor)))))

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

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

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

(define opensmtpd-service-type
  (service-type
   (name 'opensmtpd)
   (extensions
    (list (service-extension account-service-type
                             (const %opensmtpd-accounts))
          (service-extension activation-service-type
                             opensmtpd-activation)
          (service-extension pam-root-service-type
                             (const %opensmtpd-pam-services))
          (service-extension profile-service-type
                             (compose list opensmtpd-configuration-package))
          (service-extension shepherd-root-service-type
                             opensmtpd-shepherd-service)))
   (default-value (opensmtpd-configuration))
   (description "Run the Opensmtpd email server.")))