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.

(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 format)
  #:use-module (srfi srfi-1)
  #:export (opensmtpd-service-type

            opensmtpd-table
            opensmtpd-table?
            opensmtpd-table-name
            opensmtpd-table-file
            opensmtpd-table-file-db
            opensmtpd-table-values

            opensmtpd-ca
            opensmtpd-ca?
            opensmtpd-name
            opensmtpd-file

            opensmtpd-pki
            opensmtpd-pki?
            opensmtpd-pki-domain
            opensmtpd-pki-cert
            opensmtpd-pki-key

            opensmtpd-local-delivery-configuration
            opensmtpd-local-delivery-configuration?
            opensmtpd-local-delivery-configuration-method
            opensmtpd-local-delivery-configuration-alias
            opensmtpd-local-delivery-configuration-ttl
            opensmtpd-local-delivery-configuration-user
            opensmtpd-local-delivery-configuration-userbase
            opensmtpd-local-delivery-configuration-virtual
            opensmtpd-local-delivery-configuration-wrapper

            opensmtpd-maildir-configuration
            opensmtpd-maildir-configuration?
            opensmtpd-maildir-configuration-pathname
            opensmtpd-maildir-configuration-junk

            opensmtpd-mda-configuration
            opensmtpd-mda-configuration-command

            opensmtpd-relay-configuration
            opensmtpd-relay-configuration?
            opensmtpd-relay-configuration-backup
            opensmtpd-relay-configuration-backup-mx
            opensmtpd-relay-configuration-helo
            opensmtpd-relay-configuration-domain
            opensmtpd-relay-configuration-host
            opensmtpd-relay-configuration-pki
            opensmtpd-relay-configuration-srs
            opensmtpd-relay-configuration-tls
            opensmtpd-relay-configuration-protocols
            opensmtpd-relay-configuration-ciphers
            opensmtpd-relay-configuration-auth
            opensmtpd-relay-configuration-mail-from
            opensmtpd-relay-configuration-src

            opensmtpd-action
            opensmtpd-action?
            opensmtpd-action-name
            opensmtpd-action-method

            opensmtpd-filter-chain
            opensmtpd-filter-chain?
            opensmtpd-filter-chain-name
            opensmtpd-filter-chain-filter-names

            opensmtpd-filter-phase
            opensmtpd-filter-phase?
            opensmtpd-filter-phase-name
            opensmtpd-filter-phase-phase-name
            opensmtpd-filter-phase-conditions
            opensmtpd-filter-phase-decision
            opensmtpd-filter-phase-message
            opensmtpd-filter-phase-value
            
            opensmtpd-filter-proc
            opensmtpd-filter-proc?
            opensmtpd-filter-proc-name
            opensmtpd-filter-proc-command

            opensmtpd-filter-proc-exec
            opensmtpd-filter-proc-exec?
            opensmtpd-filter-proc-exec-name
            opensmtpd-filter-proc-exec-command

            opensmtpd-listen-on
            opensmtpd-listen-on?
            opensmtpd-listen-on-interface
            opensmtpd-listen-on-auth
            opensmtpd-listen-on-auth-optional
            opensmtpd-listen-on-filter
            opensmtpd-listen-on-hostname
            opensmtpd-listen-on-hostnames
            opensmtpd-listen-on-mask-src
            opensmtpd-listen-on-no-dsn
            opensmtpd-listen-on-pki
            opensmtpd-listen-on-port
            opensmtpd-listen-on-proxy-v2
            opensmtpd-listen-on-received-auth
            opensmtpd-listen-on-senders
            opensmtpd-listen-on-secure-connection
            opensmtpd-listen-on-tag
            opensmtpd-listen-on-protocols
            opensmtpd-listen-on-ciphers

            opensmtpd-listen-on-socket
            opensmtpd-listen-on-socket?
            opensmtpd-listen-on-socket-filter
            opensmtpd-listen-on-socket-mask-src
            opensmtpd-listen-on-socket-tag

            opensmtpd-match
            opensmtpd-match?
            opensmtpd-match-name
            opensmtpd-match-for
            opensmtpd-match-from
            opensmtpd-match-auth
            opensmtpd-match-helo
            opensmtpd-match-mail-from
            opensmtpd-match-rcpt-to
            opensmtpd-match-tag
            opensmtpd-match-tls

            opensmtpd-proc
            opensmtpd-proc?
            opensmtpd-proc-name
            opensmtpd-proc-command

            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-actions
            opensmtpd-configuration-bounce
            opensmtpd-configuration-filter-chains
            opensmtpd-configuration-filter-phases
            opensmtpd-configuration-filter-procs
            opensmtpd-configuration-filter-proc-execs
            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-procs
            opensmtpd-configuration-tables
            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-values 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? value)
  (eq? #f value))

(define (is-value-right-type? value list-of-procedures)
  (let loop ([list-of-procedures list-of-procedures])
    (if (null? list-of-procedures)
        #f
        (begin
          (if ((car list-of-procedures) value)
              #t
              (loop (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
             ;; FIXME/TODO add a guess function that takes a look at the
             ;; function... eg:  list-of-opensmtpd-proc? -> "a list of
             ;; <opensmtpd-proc>s, "
             (cond [(eq? false? (car procedures))
                    "#f , "]
                   [(eq? boolean? (car procedures))
                       "boolean, "]
                   [(eq? string? (car procedures))
                    "string, "]
                   [(eq? integer? (car procedures))
                    "integer, "]
                   [(eq? list-of-strings? (car procedures))
                    "list of strings, "]
                   [(eq? assoc-list? (car procedures))
                    "an association list, "]
                   [(eq? opensmtpd-pki? (car procedures))
                    "an <opensmtpd-pki> record, "]
                   [(eq? file-exists? (car procedures))
                    "file, "]
                   [(eq? list-of-opensmtpd-filter-phase? (car procedures))
                    "a list of <opensmtpd-filter-phase>s, "]
                   [(eq? list-of-opensmtpd-filter-chain? (car procedures))
                    "a list of <opensmtpd-filter-chain>s, "]
                   [(eq? list-of-opensmtpd-proc? (car procedures))
                    "a list of <opensmtpd-proc>s, "]
                   [else
                    (display "You've got some procedure that you don't know about.\n")
                    (display (car procedures))
                    (display "\n")
                    (throw 'bad! (car procedures))])
             (loop (cdr procedures)))))))
  (add-comma-or (string-append (string-drop-right string 2) ".\n")))

;; TODO/FIXME? write a procedure (define (string-in-list? string
;; list)) The procedure will be used to sanitize the few values that
;; whose strings can be certain contrained
;; strings. opensmtpd-listen-on would use such a procedure.
;; There are a perhaps three places that would use this function:
;; search for (or (string=?
;; To use this function, I would have to modify list-of-procedures->string
;; to accept a function like (quote (string-in-strings? string list)) and I would
;; later have to evaluate that s-expression.
(define (string-in-strings? string list)
  (if (null? list)
      #f
      (if (string=? string (car list))
          #t
          (string-in-strings? string (cdr list)))))

(define (my/sanitize value table fieldname list-of-procedures)
  (if (is-value-right-type? value list-of-procedures)
      value
      (begin
        (display (string-append "<" table "> fieldname: '" fieldname "' is of type "
                                (list-of-procedures->string list-of-procedures) "\n"))
        (throw 'bad! value))))

;; FIXME/TODO? It is possible to create a table like this (opensmtpd-table (name "table")),
;; which is a table with no values or file, which is no table at all, and will result
;; in the service not starting.  This is probably not worth fixing.  Only silly users
;; would try to create a table with no values or file.
(define-record-type* <opensmtpd-table>
  opensmtpd-table make-opensmtpd-table
  opensmtpd-table?
  this-record
  ;; string
  (name opensmtpd-table-name
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-table" "name" (list string?)))))
  (file opensmtpd-table-file
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-table" "file" (list false? string?)))))
  ;; 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 value like this?
  ;; (list (cons "gnucode.me" 234.949.392.23))
  (file-db opensmtpd-table-file-db
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-table" "file-db" (list boolean?)))))
  ;; FIXME support an aliasing table as described here:
  ;; https://man.openbsd.org/table.5
  ;; One may have to use the record file for this.  I don't think tables support a table like this:
  ;; table "name" { joshua = joshua@gnucode.me,joshua@gnu-hurd.com,joshua@propernaming.org, root = root@gnucode.me }
  (values opensmtpd-table-values
          (default #f)
          (sanitize (lambda (value)
                      (my/sanitize value "opensmtpd-table" "values" (list false? list-of-strings? assoc-list?))
                      )))
  ;; can be of type: (quote list-of-strings) or (quote assoc-list)
  ;; (opensmtpd-table-type record) returns the values' type.  The user SHOULD NEVER set the type.
  ;; TODO jpoiret: on irc reccomends that I just use an outside function to determine fieldname 'values', type.
  ;; it would be "simpler" and possibly easier for the next person working on this code to understand what is happening.
  (type opensmtpd-table-type
        (default #f)
        (thunked)
        (sanitize (lambda (value)
                    (cond [(opensmtpd-table-values this-record)
                           (if (list-of-strings? (opensmtpd-table-values this-record))
                               (quote list-of-strings)
                               (quote assoc-list))]
                          [(opensmtpd-table-file this-record)
                           (if (opensmtpd-table-file-db this-record)
                               (quote db)
                               (quote file))]
                          [else
                           (display "opensmtpd-table-type is broke\n")
                           (throw 'bad! value)])))))

(define-record-type* <opensmtpd-ca>
  opensmtpd-ca make-opensmtpd-ca
  opensmtpd-ca?
  (name opensmtpd-ca-name
          (default #f)
          (sanitize (lambda (value)
                      (my/sanitize value "opensmtpd-ca" "name" (list string?)))))
  (file opensmtpd-ca-file
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-ca" "file" (list string? file-exists?))))))

(define-record-type* <opensmtpd-pki>
  opensmtpd-pki make-opensmtpd-pki
  opensmtpd-pki?
  (domain opensmtpd-pki-domain
          (default #f)
          (sanitize (lambda (value)
                      (my/sanitize value "opensmtpd-pki" "domain" (list string?)))))
  ;; TODO/FIXME this should probably be a list of files.  The opensmtpd documentation says
  ;; that you could have a list of files.
  (cert opensmtpd-pki-cert
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-pki" "cert" (list file-exists?)))))
  (key opensmtpd-pki-key
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-pki" "key" (list file-exists?)))))
  (dhe opensmtpd-pki-dhe
       (default #f)
       (sanitize (lambda (value)
                    (my/sanitize value "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 (value)
                           (my/sanitize value "opensmtpd-lmtp-configuration" "destination" (list string?)))))
  (rcpt-to opensmtpd-lmtp-configuration-rcpt-to
           (default #f)
           (sanitize (lambda (value)
                       (my/sanitize value "opensmtpd-lmtp-configuration" "rcpt-to" (list false? string?))))))

(define-record-type* <opensmtpd-mda-configuration>
  opensmtpd-mda-configuration make-opensmtpd-mda-configuration
  opensmtpd-mda-configuration?
  (command opensmtpd-mda-configuration-command
           (default #f)
           (sanitize (lambda (value)
                       (my/sanitize value "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 (value)
                        (my/sanitize value "opensmtpd-maildir-configuration" "pathname" (list false? string?)))))
  (junk opensmtpd-maildir-configuration-junk
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-maildir-configuration" "junk" (list boolean?))))))

(define-record-type* <opensmtpd-local-delivery-configuration>
  opensmtpd-local-delivery-configuration make-opensmtpd-local-delivery-configuration
  opensmtpd-local-delivery-configuration?
  ;; method only be "mbox", expand-only, forward-only,
  ;; <lmtp-configuration>, <maildir-configuration>, or
  ;; <mda-configuration>.  They all support various other values like alias, which is why they are
  ;; lumped togethor in the <opensmtpd-local-delivery-configuration>
  (method opensmtpd-local-delivery-configuration-method
          (default "mbox")
          (sanitize (lambda (value)
                      (cond
                       [(or (opensmtpd-lmtp-configuration? value)
                            (opensmtpd-maildir-configuration? value)
                            (opensmtpd-mda-configuration? value)
                            (string=? value "mbox")
                            (string=? value "expand-only")
                            (string=? value "forward-only"))
                        value]
                       [else
                        (begin
                          (display (string-append "<opensmtpd-local-delivery-configuration> fieldname 'method' must be of type "
                                                  "\"mbox\", \"expand-only\", \"forward-only\" "
                                                  "<opensmtpd-lmtp-configuration>, <opensmtpd-maildir-configuration>, "
                                                  "or <opensmtpd-mda-configuration>.\n"))
                          (throw 'bad! value))]))))
  ;; string opensmtpd-table-configuration-name
  (alias opensmtpd-local-delivery-configuration-alias
         (default #f)
         (sanitize (lambda (value)
                     (my/sanitize value "opensmtpd-local-delivery-configuration" "alias" (list false? string?)))))
  ;; string
  (ttl opensmtpd-local-delivery-configuration-ttl
       (default #f)
       (sanitize (lambda (value)
                   (my/sanitize value "opensmtpd-local-delivery-configuration" "ttl" (list false? string?)))))
  (user opensmtpd-local-delivery-configuration-user
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-local-delivery-configuration" "user" (list false? string?)))))
  ;; needs to be of type string
  (userbase opensmtpd-local-delivery-configuration-userbase
            (default #f)
            (sanitize (lambda (value)
                        (my/sanitize value "opensmtpd-local-delivery-configuration" "userbase" (list false? string?)))))
  (virtual opensmtpd-local-delivery-configuration-virtual
           (default #f)
           (sanitize (lambda (value)
                       (my/sanitize value "opensmtpd-local-delivery-configuration" "virtual" (list false? string?)))))
  (wrapper opensmtpd-local-delivery-configuration-wrapper
           (default #f)
           (sanitize (lambda (value)
                       (my/sanitize value "opensmtpd-local-delivery-configuration" "wrapper" (list false? string?))))))

;; FIXME/TODO this is a valid opensmtpd-relay record
;; (opensmtpd-relay-configuration
;;  (pki (opensmtpd-pki
;;        (domain "gnucode.me")
;;        (cert "opensmtpd.scm")
;;        (key "opensmtpd.scm"))))
;; BUT how does it relay the email?  What host does it use?
;; I think opensmtpd-relay-configuration needs "method" field.
;; the method field might need to be another record...BUT basically the relay has to have a 'backup', 'backup-mx',
;; or 'domain', or 'host' defined.
(define-record-type* <opensmtpd-relay-configuration>
  opensmtpd-relay-configuration make-opensmtpd-relay-configuration
  opensmtpd-relay-configuration?
  (backup opensmtpd-relay-configuration-backup ;; boolean
          (default #f)
          (sanitize (lambda (value)
                      (my/sanitize value "opensmtpd-relay-configuration" "backup" (list boolean?)))))
  (backup-mx opensmtpd-relay-configuration-backup-mx ;; string mx name
             (default #f)
             (sanitize (lambda (value)
                         (my/sanitize value "opensmtpd-relay-configuration" "backup-mx" (list false? string?)))))

  ;; string or heloname or <table name>
  ;; this combines options helo or helo-src
  (helo opensmtpd-relay-configuration-helo
        (default #f))
  ;; add helo-src and sanitize the value so that it does NOT include "<" or ">".
  ;; string sanitize the value so that it does NOT include "<" or ">". This MUST correspond to a <opensmtpd-table>.
  (domain opensmtpd-relay-configuration-domain
          (default #f))
  ;; string
  (host opensmtpd-relay-configuration-host
        (default #f))
  ;; <opensmtpd-pki-configuration>
  (pki opensmtpd-relay-configuration-pki
       (default #f)
       (sanitize (lambda (value)
                   (my/sanitize value "opensmtpd-relay-configuration" "pki" (list false? opensmtpd-pki?)))))
  ;; boolean
  (srs opensmtpd-relay-configuration-srs
       (default #f)
       (lambda (value)
         (my/sanitize value "opensmtpd-relay-configuration" "srs" (list boolean?))))
  ;; boolean or no-verify
  (tls opensmtpd-relay-configuration-tls
       (default #f)
       (sanitize (lambda (value)
                   (my/sanitize value "opensmtpd-relay-configuration" "tls" (list false? string?)))))
  ;; string
  (protocols opensmtpd-relay-configuration-protocols
             (default #f)
             (sanitize (lambda (value)
                         (my/sanitize value "opensmtpd-relay-configuration" "protocols" (list false? string?)))))
  ;; string
  (ciphers opensmtpd-relay-configuration-ciphers
           (default #f)
           (sanitize (lambda (value)
                         (my/sanitize value "opensmtpd-relay-configuration" "ciphers" (list false? string?)))))
  ;; string "table".  Sanitize this value so that it does not include "<" or ">".
  (auth opensmtpd-relay-configuration-auth
        (default #f))
  (mail-from opensmtpd-relay-configuration-mail-from
             (default #f))
  ;; string "sourceaddr" or "<sourceadd>"
  (src opensmtpd-relay-configuration-src
       (default #f)))

(define-record-type* <opensmtpd-action>
  opensmtpd-action make-opensmtpd-action
  opensmtpd-action?
  this-record
  (name opensmtpd-action-name
        (default "local"))
  ;; type <opensmtpd-local-delivery-configuration> or <opensmtpd-relay-configuration>
  (method opensmtpd-action-method
          (default (opensmtpd-local-delivery-configuration))
          (sanitize (lambda (value)
                      (my/sanitize value "opensmtpd-action" "method"
                                   (list opensmtpd-relay-configuration?
                                         opensmtpd-local-delivery-configuration?))))))

;; FIXME/TODO Perhaps it would be nice in the future to change filter names to "filters".
;; Then "filters" could either be a list of filter names, OR it could be a list of types
;; <opensmtpd-filter-phase>, <opensmtpd-filter-proc>, or <opensmtpd-filter-proc-exec>.
;; BUT then I would have to write more code...and it would get complicated.  Seems like
;; to much work.
;;list of many records of type opensmtpd-filter-chain
;; FIXME/TODO?  Perhaps I could make filter-chains accept a list like this:
;; (list (filter-chain (name "chain-filter")
;;                     (filters (list (filter-phase
;;                                     (name "phase")
;;                                     (conditions (list "rdns")))
;;                                    (filter-proc-exec
;;                                     (name "process")
;;                                     (command "this command"))))))
;; then I could get rid of fieldnames filter-phases, filter-procs, and filter-proc-execs from
;; opensmtpd-configuration
(define-record-type* <opensmtpd-filter-chain>
  opensmtpd-filter-chain make-opensmtpd-filter-chain
  opensmtpd-filter-chain?
  ;; string chain name
  (name opensmtpd-filter-chain-name
              (default "filter-chain")
              (sanitize
               (lambda (value)
                 (my/sanitize value "opensmtpd-filter-chain" "chain-name" (list string?)))))
  ;; list of strings of filter-name
  ;; maybe someday this could support record types
  ;; <opensmtpd-filter-proc>, <opensmtpd-filter-proc-exec>, or <opensmtpd-filter-phase>
  (filter-names opensmtpd-filter-chain-filter-names
                (default #f)
                (sanitize
                 (lambda (value)
                   (my/sanitize value "opensmtpd-filter-chain" "filter-names" (list list-of-strings?))))))

(define-record-type* <opensmtpd-filter-phase>
  opensmtpd-filter-phase make-opensmtpd-filter-phase
  opensmtpd-filter-phase?
  (name opensmtpd-filter-phase-name   ;; string chain-name
              (default "filter-chain")
              (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-filter-phase" "name" (list string?)))))
  (phase-name opensmtpd-filter-phase-phase-name   ;; string
         (default #f)
         (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-filter-phase" "phase-name" (list string?)))))
  (conditions opensmtpd-filter-phase-conditions
              (default #f)
              (sanitize (lambda (value)
                          (my/sanitize value "opensmtpd-filter-phase" "conditions-name" (list list-of-strings?)))))
  (decision opensmtpd-filter-phase-decision
            (default #f)
            (sanitize (lambda (value)
                        (my/sanitize value "opensmtpd-filter-phase" "decision"
                                     (list
                                      (lambda (value)
                                        (if (or (string=? "bypass" value)
                                                (string=? "disconnect" value)
                                                (string=? "reject" value)
                                                (string=? "rewrite" value)
                                                (string=? "junk" value))
                                            value
                                            #f)))))))
  (message opensmtpd-filter-phase-message
           (default #f)
           (sanitize (lambda (value)
                       (my/sanitize value "opensmtpd-filter-phase" "message" (list false? string?)))))
  (value opensmtpd-filter-phase-value
           (default #f)
           (sanitize (lambda (value)
                        (my/sanitize value "opensmtpd-filter-phase" "value" (list false? integer?))))))

(define-record-type* <opensmtpd-filter-proc>
  opensmtpd-filter-proc make-opensmtpd-filter-proc
  opensmtpd-filter-proc?
  (name opensmtpd-filter-proc-name
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-filter-proc" "name" (list? string?)))))
  (proc-name opensmtpd-proc-proc-name
             (default #f)
             (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-filter-proc" "name" (list? string?))))))

(define-record-type* <opensmtpd-filter-proc-exec>
  opensmtpd-filter-proc-exec make-opensmtpd-filter-proc-exec
  opensmtpd-filter-proc-exec?
  (name opensmtpd-filter-proc-exec-name
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-filter-proc-exec" "name" (list string?)))))
  ;; FIXME/TODO how do I let this accept a list of file-like objects and strings?
  ;; how do I get opensmtpd-configuration-fieldname->string to accept a list of gexp and strings?
  (command opensmtpd-filter-proc-exec-command
           (default #f)
           (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-filter-proc-exec" "command" (list string?))))))

(define-record-type* <opensmtpd-listen-on>
  opensmtpd-listen-on make-opensmtpd-listen-on
  opensmtpd-listen-on?
  ;; interface may be an IP address, interface group, or domain name
  (interface opensmtpd-listen-on-interface
             (default "lo"))
  ;;FIXME/TODO? should I convert this lambda into a (my/sanitize) invocation?
  ;; NO. It's not worth the effort, and the code is cleaner/easier to understand without it. 
  ;; I would have to make a string-in-strings? procedure, which I would use thrice...
  ;; register that function with list-of-procedures->string
  ;; and modify my/sanitize to accept a procedure which accepts an argument.
  ;; eg: (my/sanitize value "opensmtpd-match" "decision" (list (cons string-in-strings? (list "reject" "accept"))
  (family opensmtpd-listen-on-family
          (default #f)
          (sanitize (lambda (value)
                      (cond
                       [(eq? #f value) ;; value == #f
                        value]
                       [(and (string? value)
                             (or (string=? "inet4" value)
                                 (string=? "inet6" value)))
                           value]
                       [else
                        (begin
                          (display "<opensmtpd-listen-on> fieldname 'family' must be string \"inet4\" or \"inet6\".\n")
                          (throw 'bad! value))]))))
  ;; this is a string of <authtable>
  ;; FIXME/TODO sanitize this value so the string has to begin with "<" and end with ">".
  (auth opensmtpd-listen-on-auth
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-listen-on" "auth" (list boolean? string?)))))
  ;; FIXME/TODO sanitize this value so the string has to begin with "<" and end with ">".
  (auth-optional opensmtpd-listen-on-auth-optional
                 (default #f)
                 (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-listen-on" "auth-optional" (list boolean? string?)))))
  ;; do I need a ca entry?
  ;; string
  (filter opensmtpd-listen-on-filter
          (default #f))
  ;; string
  (hostname opensmtpd-listen-on-hostname
            (default #f)
            (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-listen-on" "hostname" (list false? string?)))))
  ;; string of type <table>
  (hostnames opensmtpd-listen-on-hostnames
             (default #f)
             (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-listen-on" "hostnames" (list false? string?)))))
  (mask-src opensmtpd-listen-on-mask-src
            (default #f)
            (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-listen-on" "mask-src" (list boolean?)))))
  (no-dsn opensmtpd-listen-on-no-dsn
          (default #f))
  ;; pki record
  (pki opensmtpd-listen-on-pki
       (default #f)
       (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-listen-on" "pki" (list false? opensmtpd-pki?)))))
  (port opensmtpd-listen-on-port
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-listen-on" "port" (list false? integer?)))))
  (proxy-v2 opensmtpd-listen-on-proxy-k2
            (default #f))
  (received-auth opensmtpd-listen-on-received-auth
                 (default #f))
  ;; string or <opensmtpd-senders> record
  (senders opensmtpd-listen-on-senders
           (default #f))
  (secure-connection opensmtpd-listen-on-secure-connection
                     (default #f)
                     (sanitize (lambda (value)
                                 (cond [(boolean? value)
                                        value]
                                       [(and (string? value)
                                             (or (string=? "smtps" value)
                                                 (string=? "tls" value)
                                                 (string=? "tls-require" value)
                                                 (string=? "tls-require-verify" value)))
                                        value]
                                       [else
                                        (begin
                                          (display (string-append "<opensmtd-listen-on> fieldname 'secure-connection' can be "
                                                                  "one of the following strings: \n'smtps', 'tls', 'tls-require', "
                                                                  "or 'tls-require-verify'.\n"))
                                          (throw 'bad! value))]))))
  ;; string
  (tag opensmtpd-listen-on-tag
       (default #f))
  (protocols opensmtpd-listen-on-protocols
             (default #f))
  (ciphers opensmtpd-listen-on-ciphers
           (default #f)))

(define-record-type* <opensmtpd-listen-on-socket-configuration>
  opensmtpd-listen-on-socket-configuration make-opensmtpd-listen-on-socket-configuration
  opensmtpd-listen-on-socket-configuration?
  ;; string or <opensmtpd-filter> record or false
  (filter opensmtpd-listen-on-socket-configuration-filter
          (default #f))
  (mask-src opensmtpd-listen-on-socket-configuration-mask-src
            (default #f))
  ;; string
  (tag opensmtpd-listen-on-socket-configuration-tag
       (default #f)))

(define-record-type* <opensmtpd-match>
  opensmtpd-match make-opensmtpd-match
  opensmtpd-match?
  (name opensmtpd-match-name ;; name is a string OR it is (quote reject), in which case the match
        (default #f)    ;; rejects the incoming connection/envelope.
        (sanitize (lambda (value)
                    (if (or (string? value)
                            (eq? (quote reject) value))
                        value
                        (begin
                          (display
                           (string-append "<opensmtpd-match> fieldname 'name' is of type string or '(quote reject).\n"
                                          "If its value is '(quote reject), then the match rejects the incoming message\n"
                                          "during the SMTP dialogue.\n"))
                          (throw 'bad! value))))))
  ;;FIXME/TODO? Perhaps I should add in a reject fieldname.  If reject
  ;;is #t, then the match record will be a reject match record.  That
  ;;way it's less confusing for users to type in
  ;; (opensmtpd-match (name 'reject)).
  ;; BUT then I have to make fieldnames 'name' and 'reject' mutually exclusive.

  ;; #f (empty) or a string
  ;; eg: "for any" "! for local" "for domain gnucode.me" "! for domain <domains>" 
  ;; FIXME/TODO should I properly sanitize this? any string works now...
  (for opensmtpd-match-for
       (default #f)
       (sanitize (lambda (value)
                   (my/sanitize value "opensmtpd-match" "for" (list false? string?)))))
  ;; #f (empty) or a string
  ;; eg: "from any" "from auth" "from auth user" "! from auth <users>" "from local" "! from rdns"
  (from opensmtpd-match-from
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-match" "from" (list false? string?)))))
  (auth opensmtpd-match-auth
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-match" "auth" (list boolean? string?)))))
  (helo opensmtpd-match-helo
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-match" "helo" (list false? string?)))))
  (mail-from opensmtpd-match-mail-from
             (default #f)
             (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-match" "mail-from" (list false? string?)))))
  (rcpt-to opensmtpd-match-rcpt-to
           (default #f)
           (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-match" "rcpt-to" (list false? string?)))))
  (tag opensmtpd-match-tag
       (default #f)
       (sanitize (lambda (value)
                          (my/sanitize value "opensmtpd-match" "tag" (list false? string?)))))
  ;; hmmm.  How should I handle this?
  ;; #f would mean "! tls", #nil would mean nothing, and #t would mean "tls"
  ;; FIXME/TODO, this default value should be #nil or '(), but the last time I did that,
  ;; reconfiguring failed...
  (tls opensmtpd-match-tls
       (default '())
       (sanitize (lambda (value)
                          (my/sanitize value "opensmtpd-match" "tls" (list boolean? null?))))))

;; this is for registering an already running process for opensmtpd
(define-record-type* <opensmtpd-proc>
  opensmtpd-proc make-opensmtpd-proc
  opensmtpd-proc?
  (name opensmtpd-proc-name
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-proc" "name" (list false? string?)))))
  (command opensmtpd-proc-command
           (default #f)
           (sanitize (lambda (value)
                       (my/sanitize value "opensmtpd-proc" "command" (list false? string?))))))

(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 (value)
                       (my/sanitize value "opensmtpd-smtp-configuration" "ciphers" (list false? string?)))))
  (limit-max-mails opensmtpd-smtp-configuration-limit-max-mails
                   (default #f)
                   (sanitize (lambda (value)
                               (my/sanitize value "opensmtpd-smtp-configuration" "limit-max-mails" (list false? integer?)))))
  (limit-max-rcpt opensmtpd-smtp-configuration-limit-max-rcpt
                  (default #f)
                  (sanitize (lambda (value)
                               (my/sanitize value "opensmtpd-smtp-configuration" "limit-max-rcpt" (list false? integer?)))))
  (max-message-size opensmtpd-smtp-configuration-max-message-size
                    (default #f)
                    (sanitize (lambda (value)
                                (my/sanitize value "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 (value)
                                (my/sanitize value "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?
  (key opensmtpd-srs-configuration-key
              (default #f)
              (sanitize (lambda (value)
                          (my/sanitize value "opensmtpd-srs-configuration" "key" (list false? boolean? string?)))))
  (backup-key opensmtpd-srs-configuration-backup-key
                   (default #f)
                   (sanitize (lambda (value)
                               (my/sanitize value "opensmtpd-srs-configuration" "backup-key" (list false? integer?)))))
  (ttl-delay opensmtpd-srs-configuration-ttl-delay
                  (default #f)
                  (sanitize (lambda (value)
                              (my/sanitize value "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 (value)
                               (my/sanitize value "opensmtpd-queue-configuration" "compression" (list boolean?)))))
  (encryption opensmtpd-queue-configuration-encryption
              (default #f)
              (sanitize (lambda (value)
                          (my/sanitize value "opensmtpd-queue-configuration" "encryption" (list boolean? file-exists? string?)))))
  (ttl-delay opensmtpd-queue-configuration-ttl-delay
                  (default #f)
                  (sanitize (lambda (value)
                               (my/sanitize value "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
               ;; TODO if you change this next line to
               ;; (default (opensmtpd-configuration)
               ;; you will create an infinite recursive list of <opensmtpd-configuration>.
               ;; bug-guix doesn't really consider this a bug, but a noobie footgun.

               ;; Guile will eventually refuse to compile if you use (opensmtpd-configuration)
               ;; BUT that error message is quite lame.
               (default #f))
  (actions opensmtpd-configuration-actions
           (default (list (opensmtpd-action
                           (name "local")
                           (method (opensmtpd-local-delivery-configuration
                                    (method "mbox"))))
                          (opensmtpd-action
                           (name "outbound")
                           (method (opensmtpd-relay-configuration))))))
  ;; FIXME/TODO should I include a admd authservid entry?
  ;; string
  (bounce opensmtpd-configuration-bounce
          (default #f)
          (sanitize (lambda (value)
                             (my/sanitize value "opensmtpd-configuration" "bounce"
                                          (list false? string?)))))
  (cas opensmtpd-configuration-cas
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-configuration" "cas" (list false? list-of-opensmtpd-ca?)))))
  ;;list of many records of type opensmtpd-filter-chain
  ;; FIXME/TODO?  Perhaps I could make filter-chains accept a list like this:
  ;; (list (filter-chain (name "chain-filter")
  ;;                     (filters (list (filter-phase
  ;;                                     (name "phase")
  ;;                                     (conditions (list "rdns")))
  ;;                                    (filter-proc-exec
  ;;                                     (name "process")
  ;;                                     (command "this command"))))))
  ;; then I could get rid of fieldnames filter-phases, filter-procs, and filter-proc-execs from
  ;; opensmtpd-configuration
  (filter-chains opensmtpd-configuration-filter-chains 
                 (sanitize (lambda (value)
                             (my/sanitize value "opensmtpd-configuration" "filter-chain"
                                          (list false? list-of-opensmtpd-filter-chain?))))
                 (default #f))
  ;; list of many records of type opensmtpd-filter-phase
  (filter-phases opensmtpd-configuration-filter-phases
                 (default #f)
                 (sanitize (lambda (value)
                             (my/sanitize value "opensmtpd-configuration" "filter-phases"
                                          (list false? list-of-opensmtpd-filter-phase?)))))
  ;; list of many records of type opensmtpd-filter-proc
  (filter-procs opensmtpd-configuration-filter-procs
                (default #f))
  ;; list of many records of type opensmtpd-filter-proc-exec
  (filter-proc-execs opensmtpd-configuration-filter-proc-execs 
                     (default #f)
                     (sanitize (lambda (value)
                                 (my/sanitize value "opensmtpd-configuration" "filter-proc-execs"
                                              (list false? list-of-opensmtpd-filter-proc-exec?)))))
  ;; should I have an "include" entry?
  ;; list of many records of type opensmtpd-listen-on
  (listen-ons opensmtpd-configuration-listen-ons 
              (default (list (opensmtpd-listen-on)))
              (sanitize (lambda (value)
                          (if (list-of-opensmtpd-listen-on? value)
                              value
                              (begin
                                (display "<opensmtpd-configuration> fieldname 'listen-ons' expects a list of records ")
                                (display "of one or more <opensmtpd-listen-on> records.\n")
                                (throw 'bad! value))))))
  ;; accepts type <opensmtpd-listen-on-socket-configuration>
  (listen-on-socket opensmtpd-configuration-listen-on-socket
                    (default (opensmtpd-listen-on-socket-configuration)))
  (includes opensmtpd-configuration-includes ;; list of strings of absolute path names
            (default #f)
            (sanitize (lambda (value)
                        (my/sanitize value "opensmtpd-configuration" "includes" (list false? list-of-strings?)))))
  (matches opensmtpd-configuration-matches
           (default (list (opensmtpd-match
                           (name "local")
                           (for "for local"))
                          (opensmtpd-match
                           (name "outbound")
                           (from "from local")
                           (for "for any")))))
  ;; 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 (value)
                    (my/sanitize value "opensmtpd-configuration" "mda-wrappers" (list false? string?)))))
  (mta-max-deferred opensmtpd-configuration-mta-max-deferred
                    (default 100)
                    (sanitize (lambda (value)
                                (my/sanitize value "opensmtpd-configuration" "mta-max-deferred" (list number?)))))
  ;; list of many records of type proc
  ;; FIXME/TODO remove this fieldname.  Just use filter-proc
  ;; eg: (opensmtpd-configuration (listen-on (filters (list (filter-proc (name "name")
  ;;                                        (command "command")))))
  (procs opensmtpd-configuration-procs
         (default #f)
         (sanitize (lambda (value)
                     (my/sanitize value "opensmtpd-configuration" "procs" (list false? list-of-opensmtpd-proc?)))))
  ;; FIXME/TODO add queue, smtp, srs directives
  (queue opensmtpd-configuration-queue
         (default #f)
         (sanitize (lambda (value)
                     (my/sanitize value "opensmtpd-configuration" "queue" (list false? opensmtpd-queue-configuration?)))))
  (smtp opensmtpd-configuration-smtp
        (default #f)
        (sanitize (lambda (value)
                    (my/sanitize value "opensmtpd-configuration" "smtp" (list false? opensmtpd-smtp-configuration?)))))
  (srs opensmtpd-configuration-srs
       (default #f)
       (sanitize (lambda (value)
                   (my/sanitize value "opensmtpd-configuration" "srs" (list false? opensmtpd-srs-configuration?)))))
  ;; list of many records of type opensmtpd-table
  (tables opensmtpd-configuration-tables
          (default #f)
          (sanitize (lambda (value)
                     (my/sanitize value "opensmtpd-configuration" "procs" (list false? list-of-opensmtpd-table?))))))


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

;; FIXME/TODO? make all of this end like list-of-strings?  It has an "s" in it.
;; list-of-opensmtpd-ca -> <opensmtpd-ca>s? or opensmtpd-cas?

(define (list-of-opensmtpd-ca? list)
  (list-of-type? list opensmtpd-ca?))

(define (list-of-opensmtpd-pki? list)
  (list-of-type? list opensmtpd-pki?))

(define (list-of-opensmtpd-filter-phase? list)
  (list-of-type? list opensmtpd-filter-phase?))

(define (list-of-opensmtpd-filter-chain? list)
  (list-of-type? list opensmtpd-filter-chain?))

(define (list-of-opensmtpd-filter-proc-exec? list)
  (list-of-type? list opensmtpd-filter-proc-exec?))

(define (list-of-opensmtpd-listen-on? list)
  (list-of-type? list opensmtpd-listen-on?))

(define (list-of-opensmtpd-table? list)
  (list-of-type? list opensmtpd-table?))

(define (list-of-opensmtpd-proc? list)
  (list-of-type? list opensmtpd-proc?))

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

;; these next few functions help me to turn <table>s
;; into strings suitable to fit into "opensmtpd.conf".
;; 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 (assoc-list->string assoc-list)
  (string-drop-right 
   (let loop ([assoc-list assoc-list])
     (if (null? assoc-list)
         ""
         ;; pair is (cons "hello" "world") -> ("hello" . "world")
         (let ([pair (car assoc-list)])
           (string-append 
            "\"" (car pair)  "\""
            " = "
            "\"" (cdr pair) "\""
            ", "
            (loop (cdr assoc-list))))))
   2))

;;  The following functions convert various records into strings.
(define* (variable->string var #:key (append "") (postpend " "))
  (if var
      (string-append append var postpend)
      ""))

(define (list-of-variables->string list)
  (let loop [(list list)]
    (if (null? list)
        ""
        (string-append (variable->string (car list))
                       (list-of-variables->string (cdr list))))))

;; can be of type: (quote list-of-strings) or (quote assoc-list)
(define (opensmtpd-table->string table)
  (string-append "table " (opensmtpd-table-name table) " "
                 (let ([type (opensmtpd-table-type table)])
                   (cond [(eq? type (quote list-of-strings))
                          (string-append "{ " (list-of-strings->string (opensmtpd-table-values table)
                                                                       #:append "\""
                                                                       #:drop-right-number 3
                                                                       #:postpend "\"") " }")]
                         [(eq? type (quote assoc-list))
                          (string-append "{ " (assoc-list->string (opensmtpd-table-values table)) " }")]
                         [(eq? type (quote db))
                          (string-append "db:" (opensmtpd-table-file table))]
                         [(eq? type (quote file))
                          (string-append "file:" (opensmtpd-table-file table))]
                         [else (throw 'youMessedUp table)]))
                 " \n"))

(define (opensmtpd-listen-on->string record)
  (string-append "listen on "
                 (opensmtpd-listen-on-interface record) " "
                 (let ([hostname (opensmtpd-listen-on-hostname record)]
                       [hostnames (opensmtpd-listen-on-hostnames record)]
                       [filter (opensmtpd-listen-on-filter record)]
                       [mask-src (opensmtpd-listen-on-mask-src record)]
                       [tag (opensmtpd-listen-on-tag record)]
                       [secure-connection (opensmtpd-listen-on-secure-connection record)]
                       [port (opensmtpd-listen-on-port record)]
                       [pki (opensmtpd-listen-on-pki record)]
                       [auth (opensmtpd-listen-on-auth record)]
                       [auth-optional (opensmtpd-listen-on-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 #: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 "])
                        "")
                    (if port
                        (string-append "port " (number->string port) " ")
                        "")
                    (variable->string (opensmtpd-pki-domain pki) #:append "pki ")
                    (if auth
                        (string-append "auth "
                                       (if (string? auth)
                                           (string-append "<" auth "> ")
                                           ""))
                        "")
                    (if auth-optional
                        (string-append "auth-optional "
                                       (if (string? auth-optional)
                                           (string-append "<" auth-optional "> ")
                                           ""))
                        "")
                    "\n"))))

(define (opensmtpd-relay-configuration->string record)
  (let ([backup (opensmtpd-relay-configuration-backup record)]
        [backup-mx (opensmtpd-relay-configuration-backup-mx record)]
        [helo (opensmtpd-relay-configuration-helo record)]
        [domain (opensmtpd-relay-configuration-domain record)]
        [host (opensmtpd-relay-configuration-host record)]
        [pki (opensmtpd-relay-configuration-pki record)]
        [srs (opensmtpd-relay-configuration-srs record)]
        [tls (opensmtpd-relay-configuration-tls record)]
        [protocols (opensmtpd-relay-configuration-protocols record)]
        [ciphers (opensmtpd-relay-configuration-ciphers record)]
        [auth (opensmtpd-relay-configuration-auth record)]
        [mail-from (opensmtpd-relay-configuration-mail-from record)]
        [src (opensmtpd-relay-configuration-src record)])
    (string-append "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 ")
                   ;; TODO/FIXME add helo-src
                   (variable->string domain #:append "domain <" #:postpend "> ")
                   (variable->string host #:append "host ")
                   ;;(variable->string (opensmtpd-pki-domain pki) #:append "pki ")
                   (variable->string srs)
                   (variable->string tls #:append "tls ") 
                   (variable->string protocols #:append "protocols ") 
                   (variable->string ciphers #:append "ciphers ") 
                   (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 "
                 "\"" (opensmtpd-maildir-configuration-pathname record) "\""
                 (if (opensmtpd-maildir-configuration-junk record)
                     " junk "
                     " ")))

(define (opensmtpd-proc->string record)
  (string-append "proc "
                 (opensmtpd-proc-name record) " "
                 "\"" (opensmtpd-proc-command record) "\"\n"))

(define (opensmtpd-local-delivery-configuration->string record)
  (let ([method (opensmtpd-local-delivery-configuration-method record)]
        [alias (opensmtpd-local-delivery-configuration-alias record)]
        [ttl (opensmtpd-local-delivery-configuration-ttl record)]
        [user (opensmtpd-local-delivery-configuration-user record)]
        [userbase (opensmtpd-local-delivery-configuration-userbase record)]
        [virtual (opensmtpd-local-delivery-configuration-virtual record)]
        [wrapper (opensmtpd-local-delivery-configuration-wrapper record)])
    (string-append
     (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 "))))

(define (opensmtpd-action->string record)
  (string-append "action "
                 "\"" (opensmtpd-action-name record) "\" "
                 (cond [(opensmtpd-local-delivery-configuration? (opensmtpd-action-method record))
                        (opensmtpd-local-delivery-configuration->string (opensmtpd-action-method record))]
                       [(opensmtpd-relay-configuration? (opensmtpd-action-method record))
                        (opensmtpd-relay-configuration->string (opensmtpd-action-method record))])
                 " \n"))

(define (opensmtpd-match->string record)
  (string-append "match "
                 (let ([for (opensmtpd-match-for record)]
                       [name (opensmtpd-match-name record)]
                       [from (opensmtpd-match-from record)]
                       [auth (opensmtpd-match-auth record)]
                       [helo (opensmtpd-match-helo record)]
                       [mail-from (opensmtpd-match-mail-from record)]
                       [rcpt-to (opensmtpd-match-rcpt-to record)]
                       [tag (opensmtpd-match-tag record)]
                       [tls (opensmtpd-match-tls record)])
                   (string-append
                    (list-of-variables->string (list from for helo mail-from rcpt-to tag))
                    (if auth
                        (string-append "auth "
                                       (if (string? auth)
                                           (string-append auth " ")
                                           ""
                                           ))
                        "")
                    (cond [tls "tls "]
                          [(not tls) "! tls "]
                          [(null? tls) ""])
                    (if (string? name)
                        (string-append "action " "\"" name "\" ")
                        "reject ")
                    "\n"))))

(define (opensmtpd-ca->string record)
  (string-append "ca " (opensmtpd-ca-name record) " "
                 "cert \"" (opensmtpd-ca-file record) "\"\n"))

(define (opensmtpd-pki->string record)
  (let ([domain (opensmtpd-pki-domain record)]
        [cert (opensmtpd-pki-cert record)]
        [key (opensmtpd-pki-key record)]
        [dhe (opensmtpd-pki-dhe record)])
    (string-append "pki " domain " " "cert \"" cert "\" \n"
                   "pki " domain " " "key \"" key "\" \n"
                   (if dhe
                       (string-append
                        "pki " domain " " "dhe " dhe "\n")
                       ""))))

(define (opensmtpd-filter-chain->string record)
  (string-append "filter "
                 "\"" (opensmtpd-filter-chain-name record) "\" "
                 "chain {"
                 (list-of-strings->string (opensmtpd-filter-chain-filter-names record))
                 "}\n"))

(define (opensmtpd-filter-phase->string record)
  (let ([name (opensmtpd-filter-phase-name record)]
        [phase-name (opensmtpd-filter-phase-phase-name record)]
        [decision (opensmtpd-filter-phase-decision record)]
        [conditions (opensmtpd-filter-phase-conditions record)]
        [message (opensmtpd-filter-phase-message record)]
        [value (opensmtpd-filter-phase-value record)])
    (string-append "filter "
                   "\"" name "\" "
                   "phase " phase-name " "
                   "match "
                   (list-of-strings->string
                    conditions #:string-delimiter " " #:drop-right-number 1)
                   " "
                   decision " "
                   (if (or (string=? "reject" decision)
                           (string=? "disconnect" decision))
                       (string-append "\"" message "\"")
                       "")
                   (if (string=? "rewrite" decision)
                       (string-append "rewrite " (number->string value))
                       "")
                   "\n")))

;; 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)))
;; and of course (opensmtpd-filter-proc-exec->string would have to be rewritten to
;; (string-append "filter " \"name\" proc-exec \" ,@(command)  \" 
(define (opensmtpd-filter-proc-exec->string record)
  (string-append "filter "
                 "\"" (opensmtpd-filter-proc-exec-name record) "\" "
                 "proc-exec " "\"" (opensmtpd-filter-proc-exec-command record) "\""
                 "\n"))

;; FIXME/TODO do I need this? or want this?  I am using a lambda function
;; that works fairly well below in the ";; write out the includes" line
;; or could I just use the variable->string function?
;; something like (variable->string string #:append "include \"" #:append "\"\n")
(define (opensmtpd-configuration-listen->string string)
  (string-append
     "include \"" string "\"\n"))

;; this is basically a opensmtpd-srs->string
(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")))

;; this is basically the same thing as <opensmtpd-smtp-configuration>->string
(define (opensmtpd-configuration-smtp->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-pkis from
;; opensmtpd-configuration-listen-ons and
;; opensmtpd-configuration-actions
(define (opensmtpd-configuration-pkis record)
  ;; TODO/FIXME could opensmtpd-configuration-actions ever be #f? aka left blank by the user?  -> no? I think.

  ;; TODO/FIXME could opensmtpd-configuration-actions -> NOT have an opensmtpd-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
  ;; have an error.
  (define action-pkis
    (let loop1 ([list (opensmtpd-configuration-actions record)])
       (if (null? list)
           '()
           (if (and (opensmtpd-relay-configuration? (opensmtpd-action-method (car list)))
                    (opensmtpd-relay-configuration-pki (opensmtpd-action-method (car list))))
               (cons (opensmtpd-relay-configuration-pki (opensmtpd-action-method (car list)))
                     (loop1 (cdr list)))
               (loop1 (cdr list))))))
  ;; FIXME/TODO
  ;; this could be #f aka left blank. aka there are no listen-ons records with pkis.
  ;; aka there are no lins in the configuration like:
  ;; listen on eth0 tls pki smtp.gnucode.me
  (define listen-on-pkis
    (let loop2 ([list (opensmtpd-configuration-listen-ons record)])
       (if (null? list)
           '()
           (if (opensmtpd-listen-on-pki (car list))
               (cons (opensmtpd-listen-on-pki (car list))
                     (loop2 (cdr list)))
               (loop2 (cdr list))))))
  (delete-duplicates (append action-pkis listen-on-pkis)))


(define (opensmtpd-configuration-fieldname->string record fieldname-accessor record->string)
  (if (fieldname-accessor record)
       (begin
         (string-append
          (list-of-records->string (fieldname-accessor record) record->string) "\n"))
       ""))

(define (list-of-records->string list-of-records record->string)
  (string-append
   (cond [(not (list? list-of-records))
          (record->string list-of-records)]
         [else
          (let loop ([list list-of-records])
            (if (null? list)
                ""
                (string-append
                 (record->string (car list))
                 (loop (cdr list)))))])))

(define (opensmtpd-configuration->mixed-text-file record)
  ;; should I use this named let instead? or should I give this a name...
  ;; (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-tables opensmtpd-table->string)
  ;;                        (cons opensmtpd-configuration-pkis opensmtpd-pki->string))])
  ;;   (if (null? list)
  ;;       ""
  ;;       (string-append (opensmtpd-configuration-fieldname->string record
  ;;                                                                 (caar list)
  ;;                                                                 (cdar list))
  ;;                      (loop (cadr list)))))
  
  (mixed-text-file
   "opensmtpd.conf"
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-smtp
                                              opensmtpd-configuration-smtp->string)
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-srs
                                              opensmtpd-configuration-srs->string)
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-queue
                                              opensmtpd-configuration-queue->string)
   ;; write out the mta-max-deferred
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-mta-max-deferred
                                              (lambda (value)
                                                (string-append "mta max-deferred " (number->string value) "\n")))
   ;; write out the includes
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-includes
                                              opensmtpd-configuration-listen->string)
   ;;write out all the tables
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-tables opensmtpd-table->string) 
   ;; write out all the cas
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-cas opensmtpd-ca->string)
   ;; write out all the pkis
   ;; opensmtpd-configuration-pkis is a function that I defined.  "pkis" is not a fieldname of
   ;; <opensmtpd-configuration>
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-pkis opensmtpd-pki->string)
   ;; write out all the procs
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-procs opensmtpd-proc->string)
   ;; write all of the opensmtpd-configuration-filter-phases
   (opensmtpd-configuration-fieldname->string record
                                              opensmtpd-configuration-filter-phases opensmtpd-filter-phase->string)
   ;; write all of the opensmtpd-filter-proc-exec
   (opensmtpd-configuration-fieldname->string record
                                              opensmtpd-configuration-filter-proc-execs opensmtpd-filter-proc-exec->string)
   ;; write all of the opensmtpd-configuration-filter-chains
   (opensmtpd-configuration-fieldname->string record
                                              opensmtpd-configuration-filter-chains opensmtpd-filter-chain->string)
   ;; write out all of the opensmtpd-configuration-procs
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-procs opensmtpd-proc->string)
   ;; write all of the listen-on-records
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-listen-ons
                                              opensmtpd-listen-on->string)
   ;; write all the actions
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-actions
                                              opensmtpd-action->string)
   ;; write all of the matches
   (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-matches opensmtpd-match->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.")))