path: root/src/org/euandre/queue.scm

(define-module (org euandre queue)
  #:use-module ((gnu build linux-container) #:prefix container:)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module ((srfi srfi-1) #:prefix s1:)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system python)
  #:use-module (guix build-system trivial)
  #:use-module (guix download)
  #:use-module (guix gexp)
  #:use-module (guix git-download)
  #:use-module (guix least-authority)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix utils)
  #:use-module (gnu)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages check)
  #:use-module (gnu packages cpio)
  #:use-module (gnu packages cups)
  #:use-module (gnu packages cyrus-sasl)
  #:use-module (gnu packages dbm)
  #:use-module (gnu packages image)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages mail)
  #:use-module (gnu packages m4)
  #:use-module (gnu packages onc-rpc)
  #:use-module (gnu packages package-management)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages python-build)
  #:use-module (gnu packages python-crypto)
  #:use-module (gnu packages python-web)
  #:use-module (gnu packages python-xyz)
  #:use-module (gnu packages time)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages version-control)
  #:use-module (gnu packages xml)
  #:use-module (gnu services certbot)
  #:use-module (gnu services cgit)
  #:use-module (gnu services mail)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services web)
  #:use-module (gnu system setuid)
  #:export (<shadow-group-configuration>
             shadow-group-configuration
        make-shadow-group-configuration
             shadow-group-configuration?
             shadow-group-configuration-group

             shadow-group-activation
             shadow-group-accounts
             shadow-group-service-type


            <cyrus-service-configuration>
             cyrus-service-configuration
        make-cyrus-service-configuration
             cyrus-service-configuration?
             cyrus-service-configuration-name
             cyrus-service-configuration-authmech
             cyrus-service-configuration-log-level
             cyrus-service-configuration-raw-file

            <cyrus-sasl-configuration>
             cyrus-sasl-configuration
        make-cyrus-sasl-configuration
             cyrus-sasl-configuration?
             cyrus-sasl-configuration-package
             cyrus-sasl-configuration-user
             cyrus-sasl-configuration-group
             cyrus-sasl-configuration-supplementary-groups
             cyrus-sasl-configuration-authmech
             cyrus-sasl-configuration-services
             cyrus-sasl-configuration-config-dirname
             cyrus-sasl-configuration-run-directory
             cyrus-sasl-configuration-run-in-container?
             cyrus-sasl-configuration-container-name
             cyrus-sasl-configuration-container-namespaces
             cyrus-sasl-configuration-extra-mappings

             cyrus-sasl-etc-files
             cyrus-sasl-activation
             cyrus-sasl-accounts
             cyrus-sasl-shepherd-service
             cyrus-sasl-service-type


            <dkimproxyout-configuration>
             dkimproxyout-configuration
        make-dkimproxyout-configuration
             dkimproxyout-configuration?
             dkimproxyout-configuration-package
             dkimproxyout-configuration-user
             dkimproxyout-configuration-group
             dkimproxyout-configuration-supplementary-groups
             dkimproxyout-configuration-config-name
             dkimproxyout-configuration-config-extra
             dkimproxyout-configuration-raw-file
             dkimproxyout-configuration-listen
             dkimproxyout-configuration-relay
             dkimproxyout-configuration-domains
             dkimproxyout-configuration-selector
             dkimproxyout-configuration-key-size
             dkimproxyout-configuration-data-directory
             dkimproxyout-configuration-run-in-container?
             dkimproxyout-configuration-container-name
             dkimproxyout-configuration-container-namespaces
             dkimproxyout-configuration-extra-mappings

             dkimproxyout-etc-files
             dkimproxyout-accounts
             dkimproxyout-activation
             dkimproxyout-shepherd-service
             dkimproxyout-service-type


            <postfix-configuration>
             postfix-configuration
        make-postfix-configuration
             postfix-configuration?

             postfix-configuration-postfix
             postfix-configuration-mail-in-home?
             postfix-configuration-enable-submission?
             postfix-configuration-set-sendmail?
             postfix-configuration-master.cf-file
             postfix-configuration-main.cf-file
             postfix-configuration-master.cf-extra
             postfix-configuration-main.cf-extra
             postfix-configuration-config-dirname
             postfix-configuration-data-directory
             postfix-configuration-queue-directory
             postfix-configuration-user
             postfix-configuration-group
             postfix-configuration-setgid-group
             postfix-configuration-root-aliases
             postfix-configuration-cert-file
             postfix-configuration-key-file
             postfix-configuration-hostname
             postfix-configuration-run-in-container?
             postfix-configuration-container-name
             postfix-configuration-container-namespaces
             postfix-configuration-extra-mappings

             postfix-aliases
             postfix-accounts
             postfix-activation
             postfix-etc-files
             postfix-setuid-programs
             postfix-shepherd-service
       local-postfix-service-type
    internet-postfix-service-type


             dovecot-service-type
             dovecot-configuration

             cgit-pre-configuration))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; packages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define-public postfix
  (package
    (name "postfix")
    (version "3.8-20221023")
    (source
      (origin
        (method url-fetch)
        (uri
          (string-append
           "http://cdn.postfix.johnriley.me/mirrors/postfix-release/experimental/postfix-"
           version
           ".tar.gz"))
        (sha256
          (base32 "0aaylhn81n9z3kidx53kzf2jrilr3lgwfxsk1r4hn7nkrp62bcwm"))))
    (build-system gnu-build-system)
    (arguments
      (list
       #:tests? #f
       #:modules `((srfi srfi-26)
                   ,@%gnu-build-system-modules)
       #:phases
       #~(modify-phases %standard-phases
           (add-before 'configure 'patch-/bin/sh
             (lambda _
               (substitute* (find-files "." "^Makefile")
                 (("/bin/sh")
                  (which "sh")))))
           (add-before 'configure 'patch-bdb-include
             (lambda* (#:key inputs #:allow-other-keys)
               (substitute* "makedefs"
                 (("/usr/include")
                  (string-append (assoc-ref inputs "bdb")
                                 "/include")))))
           (add-before 'configure 'dont-hardcode-PATH
             (lambda _
               (substitute* '("postfix-install"
                              "conf/post-install")
                 (("^PATH=")
                  "# PATH="))))
           (add-before 'configure 'fix-strict-PATH
             (lambda _
               (substitute* "src/util/sys_defs.h"
                 (("^#define (ROOT_PATH|_PATH_DEFPATH|_PATH_STDPATH).*")
                    "#define ROOT_PATH \"/run/setuid-programs:/run/current-system/profile/bin:/run/current-system/profile/sbin\"\n"))))
           (add-before 'configure 'use-relative-symlink-to-store
             (lambda _
               (substitute* "postfix-install"
                 (("ln -sf")
                   "ln -rsf"))))
           (add-before 'configure 'fix-absolute-path-to-setuid-programs
             (lambda _
               (substitute* "conf/postfix-script"
                 (("\\$command_directory/postqueue")
                   "/run/setuid-programs/postqueue")
                 (("\\$command_directory/postdrop")
                   "/run/setuid-programs/postdrop"))))
           (add-before 'configure 'disable-warning-on-non-writable-config-files
             (lambda _
               (substitute* "conf/postfix-script"
                 (("find \\$todo \\\\\\( -perm -020 -o -perm -002 \\\\\\) \\\\\n")
                   " # find $todo \\( -perm -020 -o -perm -002 \\)"))))
           (add-before 'configure 'disable-write-to-/etc/postfix
             (lambda _
               (substitute* "src/postconf/postconf_edit.c"
                 (("pcf_set_config_dir.*")
                  "return;"))))
           (add-before 'configure 'setup-environment
             (lambda* (#:key outputs inputs #:allow-other-keys)
               (setenv "CCARGS" (string-append "-DUSE_TLS -DUSE_SASL_AUTH -DUSE_CYRUS_SASL -I"
                                               (assoc-ref inputs "cyrus-sasl")
                                               "/include/sasl"))
               (setenv "AUXLIBS" "-lnsl -lcrypto -lssl -lsasl2")
               (let* ((out  (assoc-ref outputs "out"))
                      (bin     (string-append out "/bin"))
                      (sbin    (string-append out "/sbin"))
                      (lib     (string-append out "/lib/postfix"))
                      (libexec (string-append out "/libexec/postfix"))
                      (etc     (string-append out "/etc/postfix"))
                      (man     (string-append out "/share/man"))
                      (doc     (string-append out "/share/doc/postfix-" #$version))
                      (html    (string-append doc "/html")))
                 (setenv "install_root"         "wip-prefix")
                 (setenv "newaliases_path"      (string-append bin  "/newaliases"))
                 (setenv "mailq_path"           (string-append bin  "/mailq"))
                 (setenv "sendmail_path"        (string-append sbin "/sendmail"))
                 (setenv "command_directory"    sbin)
                 (setenv "shlib_directory"      lib)
                 (setenv "daemon_directory"     libexec)
                 (setenv "meta_directory"       etc)
                 (setenv "sample_directory"     etc)
                 (setenv "manpage_directory"    man)
                 (setenv "readme_directory"     doc)
                 (setenv "html_directory"       html)
                 (setenv "sample_directory"     (string-append out "/share/postfix")))))
           (replace 'configure
             (lambda _
               (invoke "make" "makefiles"
                              "pie=yes"
                              "dynamicmaps=yes")))
           (replace 'install
             (lambda* (#:key outputs #:allow-other-keys)
               (let ((out (assoc-ref outputs "out")))
                 (invoke "make" "non-interactive-package")
                 (delete-file-recursively "wip-prefix/var")
                 (copy-recursively "wip-prefix/etc" (string-append out "/etc"))
                 (copy-recursively (string-append "wip-prefix" out) out)))))))
    (inputs
      (list bdb
            cyrus-sasl
            libnsl
            openssl
            perl))
    (native-inputs
      (list m4))
    (home-page "https://www.postfix.org")
    (synopsis "sendmail compatible MTA")
    (description
     "Postfix is Wietse Venema's mail server that started life at IBM research
as an alternative to the widely-used Sendmail program.  Now at Google, Wietse
continues to support Postfix.

Postfix attempts to be fast, easy to administer, and secure.  The outside has a
definite Sendmail-ish flavor, but the inside is completely different.")
    (license (list license:ibmpl1.0
                   license:epl2.0))))

(define-public mailutils-sendmail
  (package
    (inherit mailutils)
    (name "mailutils-sendmail")
    (arguments
      (substitute-keyword-arguments (package-arguments mailutils)
        ((#:configure-flags flags)
         #~(append '("CFLAGS=-DPATH_SENDMAIL=\\\"/run/setuid-programs/sendmail\\\"") #$flags))))))

(define-public rottlog-mailutils-sendmail
  (package
    (inherit rottlog)
    (name "rottlog-mailutils-sendmail")
    (inputs
      (list coreutils
            mailutils-sendmail))))



(define-public python-pytest-tornado5
  (package
    (name "python-pytest-tornado5")
    (version "2.0.0")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "pytest-tornado5" version))
        (sha256
         (base32 "0qb62jw2w0xr6y942yp0qxiy755bismjfpnxaxjjm05gy2pymr8d"))))
    (build-system python-build-system)
    (propagated-inputs (list python-pytest python-tornado))
    (home-page "https://github.com/vidartf/pytest-tornado")
    (synopsis
     "A py.test plugin providing fixtures and markers to simplify testing of asynchronous tornado applications.")
    (description
     "This package provides a py.test plugin providing fixtures and markers to
simplify testing of asynchronous tornado applications.")
    (license license:asl2.0)))

;; FIXME
#;
(define-public python-futures
  (package
    (name "python-futures")
    (version "3.3.0")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "futures" version))
        (sha256
          (base32 "154pvaybk9ncyb1wpcnzgd7ayvvhhzk92ynsas7gadaydbvkl0vy"))))
    (build-system python-build-system)
    (home-page "https://github.com/agronholm/pythonfutures")
    (synopsis "Backport of the concurrent.futures package from Python 3")
    (description "Backport of the concurrent.futures package from Python 3")
    (license #f)))

(define-public python-ordereddict
  (package
    (name "python-ordereddict")
    (version "1.1")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "ordereddict" version))
        (sha256
          (base32 "07qvy11nvgxpzarrni3wrww3vpc9yafgi2bch4j2vvvc42nb8d8w"))))
    (build-system python-build-system)
    (arguments
      `(#:phases
        (modify-phases %standard-phases
          (delete 'sanity-check))))
    (home-page "UNKNOWN")
    (synopsis
     "A drop-in substitute for Py2.7's new collections.OrderedDict that works in Python 2.4-2.6.")
    (description "This package provides a drop-in substitute for Py2.7's new
collections.OrderedDict that works in Python 2.4-2.6.")
    (license #f)))

(define-public python-funcsigs
  (package
    (name "python-funcsigs")
    (version "1.0.2")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "funcsigs" version))
        (sha256
          (base32 "0l4g5818ffyfmfs1a924811azhjj8ax9xd1cffr1mzd3ycn0zfx7"))))
    (build-system python-build-system)
    (propagated-inputs
      (list python-ordereddict))
    (native-inputs
      (list python-unittest2))
    (home-page "http://funcsigs.readthedocs.org")
    (synopsis
     "Python function signatures from PEP362 for Python 2.6, 2.7 and 3.2+")
    (description
     "Python function signatures from PEP362 for Python 2.6, 2.7 and 3.2+")
    (license #f)))

(define-public python-apscheduler
  (package
    (name "python-apscheduler")
    (version "3.9.1")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "APScheduler" version))
        (sha256
          (base32 "1qzi1pr7q72vs49p7vr1mp350zaggs52lpq43lvqsjcmcd5mgrk5"))))
    (build-system python-build-system)
    (arguments
      `(#:tests? #f))
    (propagated-inputs
      (list python-funcsigs
            ; python-futures
            python-pytz
            python-setuptools
            python-six
            python-tzlocal))
    (native-inputs
      (list python-mock
            python-pytest
            python-pytest-asyncio
            python-pytest-cov
            python-pytest-tornado5
            python-setuptools-scm))
    (home-page "https://github.com/agronholm/apscheduler")
    (synopsis "In-process task scheduler with Cron-like capabilities")
    (description "In-process task scheduler with Cron-like capabilities")
    (license license:expat)))

(define-public python-telegram-bot
  (package
    (name "python-telegram-bot")
    (version "13.12")
    (source
      (origin
        (method url-fetch)
        (uri
          (pypi-uri "python-telegram-bot" version))
        (sha256
          (base32 "1rbdyr1f9mndlh83in47k8if65yp9n1dy4px2wipbf0qyjv5zxfs"))))
    (build-system python-build-system)
    (arguments
      `(#:tests? #f
        #:phases
        (modify-phases %standard-phases
          (delete 'sanity-check))))
    (native-inputs
      (list python-apscheduler))
    (propagated-inputs
      (list python-apscheduler
            python-cachetools
            python-certifi
            python-pytz
            python-tornado))
    (home-page "https://python-telegram-bot.org/")
    (synopsis "Python library to interface with the Telegram Bot API")
    (description "We have made you a wrapper you can't refuse")
    (license #f)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; services ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define-record-type* <shadow-group-configuration>
  shadow-group-configuration
  make-shadow-group-configuration
  shadow-group-configuration?
  (group shadow-group-configuration-group (default "etc-shadow")))

(define (shadow-group-activation config)
  (match-record config <shadow-group-configuration>
      (group)
    #~(begin
        (use-modules (guix build utils))
        (format (current-error-port)
         "Setting ownership and permission for \"/etc/shadow\".~%")
        (chown "/etc/shadow"
               (passwd:uid (getpwnam "root"))
               (group:gid  (getgrnam #$group)))
        (chmod "/etc/shadow" #o640))))

(define (shadow-group-accounts config)
  (match-record config <shadow-group-configuration>
      (group)
    (list
     (user-group
       (name group)
       (system? #t)))))

(define shadow-group-service-type
  (service-type
    (name 'shadow-group)
    (extensions
      (list
       (service-extension activation-service-type
                          shadow-group-activation)
       (service-extension account-service-type
                          shadow-group-accounts)))
    (default-value (shadow-group-configuration))
    (description "Provide the infrastructure to allow access to the
@file{/etc/shadow} file without requiring superuser privileges, by:

@itemize
@item adding a dedicated group to the system (default: @code{etc-shadow});
@item granting said group @emph{read-only access} to the @file{/etc/shadow}
file.
@end itemize

The goal is to allow unprivileged processes to perform password authentication
against the @file{/etc/passwd} database, by adding the @code{etc-shadow} group
to the list of supplementary groups of the user of such running process.")))


(define-record-type* <cyrus-service-configuration>
  cyrus-service-configuration
  make-cyrus-service-configuration
  cyrus-service-configuration?
  (name      cyrus-service-configuration-name)
  (authmech  cyrus-service-configuration-authmech  (default "saslauthd"))
  (log-level cyrus-service-configuration-log-level (default 7))
  (raw-file  cyrus-service-configuration-raw-file  (default #f)))

(define-record-type* <cyrus-sasl-configuration>
  cyrus-sasl-configuration
  make-cyrus-sasl-configuration
  cyrus-sasl-configuration?
  (package              cyrus-sasl-configuration-package              (default cyrus-sasl))
  (user                 cyrus-sasl-configuration-user                 (default "cyrus-sasl"))
  (group                cyrus-sasl-configuration-group                (default "cyrus-sasl"))
  (supplementary-groups cyrus-sasl-configuration-supplementary-groups (default '("etc-shadow")))
  (authmech             cyrus-sasl-configuration-authmech             (default "shadow"))
  (services             cyrus-sasl-configuration-services             (default '()))
  (config-dirname       cyrus-sasl-configuration-config-dirname       (default "sasl2"))
  (run-directory        cyrus-sasl-configuration-run-directory        (default "/var/run/saslauthd"))
  (run-in-container?    cyrus-sasl-configuration-run-in-container?    (default #t))
  (container-name       cyrus-sasl-configuration-container-name       (default "saslauthd"))
  (container-namespaces cyrus-sasl-configuration-container-namespaces (default container:%namespaces))
  (extra-mappings       cyrus-sasl-configuration-extra-mappings       (default '())))

(define (cyrus-sasl-etc-files config)
  (match-record config <cyrus-sasl-configuration>
      (services config-dirname run-directory)
    `((,config-dirname
       ,(file-union
         config-dirname
         (map (lambda (service-config)
                (match-record service-config <cyrus-service-configuration>
                    (name authmech log-level raw-file)
                  `(,name ,(plain-file
                            name
                            (or raw-file
                               (format #f
                                "pwcheck_method: ~a~%saslauthd_path: ~a/mux~%log_level: ~a~%"
                                authmech
                                run-directory
                                log-level))))))
              services))))))

(define (cyrus-sasl-activation config)
  (match-record config <cyrus-sasl-configuration>
      (user run-directory)
    #~(begin
        (use-modules (guix build utils))
        (format (current-error-port)
         "Creating Cyrus SASL socket directory: \"~a\".~%" #$run-directory)
        (mkdir-p/perms #$run-directory (getpwnam #$user) #o755))))

(define (cyrus-sasl-accounts config)
  (match-record config <cyrus-sasl-configuration>
      (user group supplementary-groups)
    (list
     (user-account
       (name user)
       (group group)
       (supplementary-groups supplementary-groups)
       (comment "Cyrus SASL system user")
       (home-directory "/var/empty")
       (create-home-directory? #f)
       (shell
         (file-append shadow "/sbin/nologin"))
       (system? #t))
     (user-group
       (name group)
       (system? #t)))))

(define (cyrus-sasl-shepherd-service config)
  (match-record config <cyrus-sasl-configuration>
      (package user group supplementary-groups authmech config-dirname run-directory
       services run-in-container? container-name container-namespaces extra-mappings)
    (let* ((bin (file-append package "/sbin/saslauthd"))
           (cmd (if (not run-in-container?)
                  bin
                  (least-authority-wrapper
                   bin
                   #:name container-name
                   #:namespaces container-namespaces
                   #:mappings (append
                               (list
                                (file-system-mapping
                                  (source run-directory)
                                  (target source)
                                  (writable? #t))
                                (file-system-mapping
                                  (source "/etc/passwd")
                                  (target source))
                                (file-system-mapping
                                  (source "/etc/shadow")
                                  (target source)))
                                extra-mappings)))))
      (list
       (shepherd-service
         (provision '(cyrus-sasl))
         (documentation "Run the saslauthd daemon of Cyrus SASL.")
         (start #~(make-forkexec-constructor
                   (list #$cmd "-a" #$authmech "-d" "-m" #$run-directory)
                   #:user #$user
                   #:group #$group
                   #:supplementary-groups '(#$@supplementary-groups)))
         (stop #~(make-kill-destructor))
         (actions
           (list
            (shepherd-action
              (name 'configuration)
              (documentation "Display the name of all registered configuration files.")
              (procedure
                (let ((names (map cyrus-service-configuration-name services)))
                  #~(lambda _
                      (for-each (lambda (name)
                                  (format #t "/etc/~a/~a~%" #$config-dirname name))
                                '#$names))))))))))))

(define cyrus-sasl-service-type
  (service-type
    (name 'cyrus-sasl)
    (extensions
      (list
       (service-extension etc-service-type
                          cyrus-sasl-etc-files)
       (service-extension activation-service-type
                          cyrus-sasl-activation)
       (service-extension profile-service-type
                          (compose list cyrus-sasl-configuration-package))
       (service-extension account-service-type
                          cyrus-sasl-accounts)
       (service-extension shepherd-root-service-type
                          cyrus-sasl-shepherd-service)))
    (compose s1:concatenate)
    (extend (lambda (config services)
              (cyrus-sasl-configuration
                (inherit config)
                (services
                  (append
                   (cyrus-sasl-configuration-services config)
                   services)))))
    (default-value (cyrus-sasl-configuration))
    (description "Run the @code{saslauthd} daemon from the Cyrus SASL package.

Services can extend @code{cyrus-sasl-service-type}, and provide their own list
of @code{cyrus-service-configuration} entries to be registered in this service.

For the @code{saslauthd} daemon to be able to authenticate using the \"shadow\"
@code{authmech}, it needs read access to the @file{/etc/shadow} file.  This is
accomplished by default by adding the @code{etc-shadow} group to the list of
supplementary groups of the running daemon, and by enabling the
@code{shadow-group-service-type} service.

By default, the daemon runs in a container.")))


(define-record-type* <dkimproxyout-configuration>
  dkimproxyout-configuration
  make-dkimproxyout-configuration
  dkimproxyout-configuration?
  (package              dkimproxyout-configuration-package              (default dkimproxy))
  (user                 dkimproxyout-configuration-user                 (default "dkimproxyout"))
  (group                dkimproxyout-configuration-group                (default "dkimproxyout"))
  (supplementary-groups dkimproxyout-configuration-supplementary-groups (default '()))
  (config-name          dkimproxyout-configuration-config-name          (default "dkimproxyout.conf"))
  (config-extra         dkimproxyout-configuration-config-extra         (default ""))
  (raw-file             dkimproxyout-configuration-raw-file             (default #f))
  (listen               dkimproxyout-configuration-listen               (default "127.0.0.1:10027"))
  (relay                dkimproxyout-configuration-relay                (default "127.0.0.1:10028"))
  (domains              dkimproxyout-configuration-domains              (default (list (gethostname))))
  (selector             dkimproxyout-configuration-selector             (default "dkimproxyout"))
  (key-size             dkimproxyout-configuration-key-size             (default 2048))
  (data-directory       dkimproxyout-configuration-data-directory       (default "/var/lib/dkimproxyout"))
  (run-in-container?    dkimproxyout-configuration-run-in-container?    (default #t))
  (container-name       dkimproxyout-configuration-container-name       (default "dkimproxyout"))
  (container-namespaces dkimproxyout-configuration-container-namespaces (default (s1:fold delq container:%namespaces '(net))))
  (extra-mappings       dkimproxyout-configuration-extra-mappings       (default '())))

(define (generate-out.cf config)
  (match-record config <dkimproxyout-configuration>
      (config-extra listen relay domains selector data-directory)
    (format #f
"listen ~a
relay ~a

domain ~a
selector ~a

signature dkim(c=relaxed/relaxed)

keyfile ~a/private.key
~a"
       listen
       relay
       (string-join domains ",")
       selector
       data-directory
       config-extra)))

(define (dkimproxyout-etc-files config)
  (match-record config <dkimproxyout-configuration>
      (config-name raw-file)
    `((,config-name ,(plain-file config-name
                                 (or raw-file
                                     (generate-out.cf config)))))))

(define (dkimproxyout-accounts config)
  (match-record config <dkimproxyout-configuration>
      (user group supplementary-groups)
    (list
     (user-account
       (name user)
       (group group)
       (supplementary-groups supplementary-groups)
       (comment "DKIMproxy.out signing system user")
       (home-directory "/var/empty")
       (create-home-directory? #f)
       (shell
         (file-append shadow "/sbin/nologin"))
       (system? #t))
     (user-group
       (name group)
       (system? #t)))))

(define (dkimproxyout-activation config)
  (match-record config <dkimproxyout-configuration>
      (user data-directory key-size)
    #~(begin
        (use-modules (guix build utils))
        (let* ((user (getpwnam #$user))
               (uid (passwd:uid user))
               (gid (passwd:gid user))
               (private-key (string-append #$data-directory "/private.key"))
               (public-key  (string-append #$data-directory "/public.key")))
          (format (current-error-port)
           "Creating DKIMproxy.out data directory: \"~a\".~%" #$data-directory)
          (mkdir-p/perms #$data-directory user #o755)
          (unless (file-exists? private-key)
            (format (current-error-port)
             "The public/private keypair doesn't exist yet.  Generating one...~%")
            (cond
              ((zero? (system* #$(file-append openssl "/bin/openssl")
                               "genrsa"
                               "-out"
                               private-key
                               (number->string #$key-size)))
               (format (current-error-port)
                "DKIMproxy.out private key file created: \"~a\".~%" private-key)
               (invoke #$(file-append openssl "/bin/openssl")
                       "rsa"
                       "-in"
                       private-key
                       "-pubout"
                       "-out"
                       public-key)
               (format (current-error-port)
                "Setting permissions for the public/private DKIMproxy.out keypair: \"~a/{public,private}.key\".~%" #$data-directory)
               (chown private-key uid gid)
               (chown public-key  uid gid)
               (chmod private-key #o400)
               (chmod public-key  #o644))
              (else
               (format (current-error-port)
                "ERROR: failed to create DKIMproxy.out private key file: \"~a\".~%" private-key))))))))

(define (dkimproxyout-shepherd-service config)
  (match-record config <dkimproxyout-configuration>
      (package user group supplementary-groups config-name data-directory
       run-in-container? container-name container-namespaces extra-mappings)
    (let* ((config-file (string-append "/etc/" config-name))
           (bin (file-append package "/bin/dkimproxy.out"))
           (cmd (if (not run-in-container?)
                  bin
                  (least-authority-wrapper
                   bin
                   #:name container-name
                   #:namespaces container-namespaces
                   #:mappings (append
                               (list
                                (file-system-mapping
                                  (source "/etc/protocols")
                                  (target source))
                                (file-system-mapping
                                  (source config-file)
                                  (target source))
                                (file-system-mapping
                                  (source
                                    (string-append data-directory "/private.key"))
                                  (target source)))
                               extra-mappings)))))
      (list
       (shepherd-service
         (provision '(dkimproxyout))
         (documentation "Run the outbound DKIMProxy.out daemon.")
         (start #~(make-forkexec-constructor
                   (list #$cmd "--conf_file" #$config-file)
                   #:user #$user
                   #:group #$group
                   #:supplementary-groups '(#$@supplementary-groups)))
         (stop #~(make-kill-destructor))
         (actions
           (list
            (shepherd-action
              (name 'configuration)
              (documentation "Display the name of the configuration file being used.")
              (procedure
                #~(lambda _
                    (format #t "~a~%" #$config-file)))))))))))

(define-public dkimproxyout-service-type
  (service-type
    (name 'dkimproxyout)
    (extensions
      (list
       (service-extension etc-service-type
                          dkimproxyout-etc-files)
       (service-extension account-service-type
                          dkimproxyout-accounts)
       (service-extension activation-service-type
                          dkimproxyout-activation)
       (service-extension profile-service-type
                          (compose list dkimproxyout-configuration-package))
       (service-extension shepherd-root-service-type
                          dkimproxyout-shepherd-service)))
    (default-value (dkimproxyout-configuration))
    (description "Run the @code{dkimproxy.out} SMTP outbound proxy for adding
DKIM signature headers to emails.  This daemon is meant to be used in companiong
with an SMTP server, such as Postfix.

On startup, it creates the keypair to be used for signing if the keypair doesn't
exist yet.  The corresponding public.key is kept in the same directory as the
private key.  The default location for the private key is
@file{/var/lib/dkimproxyout/private.key}, so the public key is kept at
@file{/var/lib/dkimproxyout/public.key}, so that it can be added as a TXT DNS
entry.

By default, the daemon runs in a container.")))









;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Postfix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define-record-type* <postfix-configuration>
  postfix-configuration
  make-postfix-configuration
  postfix-configuration?
  (postfix              postfix-configuration-postfix              (default postfix))
  (mail-in-home?        postfix-configuration-mail-in-home?        (default #f))
  (enable-submission?   postfix-configuration-enable-submission?   (default #f))
  (set-sendmail?        postfix-configuration-set-sendmail?        (default #t))
  (master.cf-file       postfix-configuration-master.cf-file       (default #f))
  (main.cf-file         postfix-configuration-main.cf-file         (default #f))
  (master.cf-extra      postfix-configuration-master.cf-extra      (default ""))
  (main.cf-extra        postfix-configuration-main.cf-extra        (default ""))
  (config-dirname       postfix-configuration-config-dirname       (default "postfix"))
  (data-directory       postfix-configuration-data-directory       (default "/var/lib/postfix"))
  (queue-directory      postfix-configuration-queue-directory      (default "/var/spool/postfix"))
  (user                 postfix-configuration-user                 (default "postfix"))
  (group                postfix-configuration-group                (default "postfix"))
  (setgid-group         postfix-configuration-setgid-group         (default "postdrop"))
  (root-aliases         postfix-configuration-root-aliases         (default '("abuse" "admin" "hostmaster" "postmaster")))
  (cert-file            postfix-configuration-cert-file            (default #f))
  (key-file             postfix-configuration-key-file             (default #f))
  (hostname             postfix-configuration-hostname             (default (gethostname)))
  (run-in-container?    postfix-configuration-run-in-container?    (default #f))
  (container-name       postfix-configuration-container-name       (default "postfix"))
  (container-namespaces postfix-configuration-container-namespaces (default (s1:fold delq container:%namespaces '(net))))
  (extra-mappings       postfix-configuration-extra-mappings       (default '())))



(define submission-config "
submission  inet       n        -       n       -        -        smtpd -o syslog_name=postfix/submission
  -o smtpd_tls_security_level=encrypt
  -o content_filter=dksign:[127.0.0.1]:10027")

(define dksign-filter "
  -o content_filter=dksign:[127.0.0.1]:10027")

; FIXME: doesn't work for sendmail -t in localhost
(define dksign-config "

dksign      unix       -        -       n       -        -        smtp
  -o syslog_name=postfix/dkimproxyout-listen
  -o smtp_send_xforward_command=yes
  -o smtp_discard_ehlo_keywords=8bitmime,starttls

127.0.0.1:10028 inet   n        -       n       -        -        smtpd
  -o syslog_name=postfix/dkimproxyout-relay
  -o content_filter=
  -o receive_override_options=no_unknown_recipient_checks,no_header_body_checks
  -o smtpd_helo_restrictions=
  -o smtpd_client_restrictions=
  -o smtpd_sender_restrictions=
  -o smtpd_recipient_restrictions=permit_mynetworks,reject
  -o mynetworks=127.0.0.0/8
  -o smtpd_authorized_xforward_hosts=127.0.0.0/8
")

; FIXME: hardcoded value of dkimproxy listen and relay
; FIXME: replace 127.0.0.1 with localhost
(define (generate-master.cf config)
  (match-record config <postfix-configuration>
      (enable-submission? master.cf-extra)
    (format #f
      "# ============================================================================================================
# service   type       private  unpriv  chroot  wakeup   maxproc  command + args
#                      (yes)    (yes)   (no)    (never)  (100)
# =============================================================================================================

anvil       unix       -        -       n       -        1        anvil
bounce      unix       -        -       n       -        0        bounce
cleanup     unix       n        -       n       -        0        cleanup
defer       unix       -        -       n       -        0        bounce
discard     unix       -        -       n       -        -        discard
error       unix       -        -       n       -        -        error
flush       unix       n        -       n       1000?    0        flush
lmtp        unix       -        -       n       -        -        lmtp
local       unix       -        n       n       -        -        local
pickup      unix       n        -       n       60       1        pickup~a
proxymap    unix       -        -       n       -        -        proxymap
proxywrite  unix       -        -       n       -        1        proxymap
qmgr        unix       n        -       n       300      1        qmgr
relay       unix       -        -       n       -        -        smtp
retry       unix       -        -       n       -        -        error
rewrite     unix       -        -       n       -        -        trivial-rewrite
scache      unix       -        -       n       -        1        scache
showq       unix       n        -       n       -        -        showq
smtp        inet       n        -       n       -        -        smtpd -o syslog_name=postfix/smtp
smtp        unix       -        -       n       -        -        smtp
tlsmgr      unix       -        -       n       1000?    1        tlsmgr
trace       unix       -        -       n       -        0        bounce
verify      unix       -        -       n       -        1        verify
virtual     unix       -        n       n       -        -        virtual
postlog     unix-dgram n        -       n       -        1        postlogd
~a~a~a"
     (if enable-submission? dksign-filter "")
     (if enable-submission? submission-config "")
     (if enable-submission? dksign-config "")
     master.cf-extra)))

(define (cert-for prefix config)
  (match-record config <postfix-configuration>
      (cert-file hostname)
    (or cert-file (format #f "/etc/letsencrypt/live/~a~a/fullchain.pem" prefix hostname))))

(define (key-for prefix config)
  (match-record config <postfix-configuration>
      (key-file hostname)
    (or key-file (format #f "/etc/letsencrypt/live/~a~a/privkey.pem" prefix hostname))))

(define (main.cf-internet-extra hostname cert key)
;; FIXME: shouldn't smtpd_tls_security_level be 'encrypt'?
;; smtpd_sasl_security_options = FIXME: deny all
;; smtpd_milters = FIXME
  (format #f
  "
myhostname = ~a

smtpd_use_tls = yes
smtpd_tls_cert_file = ~a
smtpd_tls_key_file  = ~a
smtp_use_tls       = $smtpd_use_tls
smtp_tls_cert_file = $smtpd_tls_cert_file
smtp_tls_key_file  = $smtpd_tls_key_file

smtp_tls_security_level  = may

recipient_delimiter = +

smtpd_sasl_tls_security_options = noanonymous
smtpd_tls_security_level = may
smtpd_tls_auth_only = yes

smtpd_relay_restrictions = $smtpd_recipient_restrictions
smtpd_recipient_restrictions = permit_mynetworks,
  permit_sasl_authenticated, reject_unauth_destination
smtpd_sasl_auth_enable = yes
cyrus_sasl_config_path = /etc/sasl2
debug_peer_list = 127.0.0.1

milter_default_action = accept
"
  hostname
  cert
  key))
(define main.cf-local-extra
  "
mynetworks = 127.0.0.0/8
")

#;
"
sender_dependent_relayhost_maps = hash:/var/lib/private/postfix/relayhosts-maps
smtp_sasl_password_maps = hash:/var/lib/private/postfix/sasl-password
smtp_sasl_auth_enable = yes
smtp_sasl_security_options = noanonymous
smtp_tls_security_level = encrypt
smtp_tls_note_starttls_offer = yes
smtp_use_tls = yes
smtp_sender_dependent_authentication = yes
smtp_sasl_mechanism_filter = login, plain
"
;; postfix -> package
(define (generate-main.cf config)
  (match-record config <postfix-configuration>
      (postfix mail-in-home? enable-submission? queue-directory data-directory
       user setgid-group hostname main.cf-extra)
    (format #f
      "compatibility_level = 3.6

queue_directory = ~a
data_directory = ~a
mail_owner = ~a
setgid_group = ~a

header_checks = regexp:{ { /^Received:.*/ IGNORE }, { /^X-Originating-IP:.*/ IGNORE } }

~a
~a~a"

     queue-directory
     data-directory
     user
     setgid-group

     (if mail-in-home?
       "home_mailbox = Mail/Inbox/"
       "mail_spool_directory = /var/mail/")
     main.cf-extra
     (if enable-submission?
       (main.cf-internet-extra
        hostname
        (cert-for "" config)
        (key-for  "" config))
       main.cf-local-extra))))

(define (postfix-etc-files config)
  (match-record config <postfix-configuration>
      (master.cf-file main.cf-file config-dirname)
    `((,config-dirname
       ,(file-union
         config-dirname
         `(("master.cf" ,(plain-file "master.cf" (or master.cf-file (generate-master.cf config))))
           ("main.cf"   ,(plain-file "main.cf"   (or main.cf-file   (generate-main.cf   config))))))))))

(define (postfix-accounts config)
  (match-record config <postfix-configuration>
      (user group setgid-group)
    (list
     (user-account
       (name user)
       (group group)
       (comment "Postfix system user")
       (home-directory "/var/empty")
       (create-home-directory? #f)
       (shell
         (file-append shadow "/sbin/nologin"))
       (system? #t))
     (user-group
       (name group)
       (system? #t))
     (user-group
       (name setgid-group)
       (system? #t)))))

(define (postfix-setuid-programs config)
  (match-record config <postfix-configuration>
      (postfix setgid-group set-sendmail?)
    (append
     (list
      (setuid-program
        (program (file-append postfix "/sbin/postdrop"))
        (setuid? #f)
        (setgid? #t)
        (group setgid-group))
      (setuid-program
        (program (file-append postfix "/sbin/postqueue"))
        (setuid? #f)
        (setgid? #t)
        (group setgid-group)))
     (if set-sendmail?
       (list
        (setuid-program
          (program (file-append postfix "/sbin/sendmail"))
          (setuid? #f)
          (setgid? #t)
          (group setgid-group)))
       '()))))

;; FIXME: parameterize /var/mail
(define (postfix-activation config)
  (match-record config <postfix-configuration>
      (queue-directory)
    #~(begin
        (use-modules (guix build utils))
        (let ((user (getpwnam "root")))
          (format (current-error-port)
           "Creating Postfix queue directory: \"~a\".~%" #$queue-directory)
          (mkdir-p/perms #$queue-directory user #o755)
          (unless (directory-exists? "/var/mail")
            (format (current-error-port)
             "Creating email spool director: \"/var/mail\".~%")
            (mkdir-p/perms "/var/mail" user #o755))
          (format (current-error-port)
           "Updating /etc/aliases: FIXME.~%")
          ;; FIXME: add -c option
#;
          (invoke #$(file-append postfix "/sbin/postalias") "/etc/aliases")))))

(define (postfix-shepherd-service config)
  (match-record config <postfix-configuration>
      (postfix config-dirname data-directory queue-directory
       run-in-container? container-name container-namespaces extra-mappings)
    (let* ((config-dir (string-append "/etc/" config-dirname))
           (bin (file-append postfix "/sbin/postfix"))
           (cmd (if (not run-in-container?)
                  bin
                  (least-authority-wrapper
                   bin
                   #:name container-name
                   #:mappings (append
                               (list
                                (file-system-mapping
                                  (source data-directory)
                                  (target source)
                                  (writable? #t))
                                (file-system-mapping
                                  (source queue-directory)
                                  (target source)
                                  (writable? #t)))
                                extra-mappings)
                   #:namespaces container-namespaces))))
      (list
       (shepherd-service
         (provision '(postfix))
         (documentation
            "-
             Run the Postfix MTA.

             This is the entrypoint for starting the \"master\" process.  Then the
             \"master\" process itself takes responsability of starting all the
             required daemons and commands.")
         (start #~(make-forkexec-constructor
                   (list
                    #$(file-append postfix "/sbin/postfix")
                    "-c"
                    #$config-dir
                    "start-fg")
                   #:pid-file "/var/lib/postfix/master.lock"))
         (stop #~(make-kill-destructor SIGKILL))
         (actions
           (list
            (shepherd-action
              (name 'configuration)
              (documentation "FIXME:DOCUMENTATION")
              (procedure
                #~(lambda _
                    (format #t "~a/master.cf~%" #$config-dir)
                    (format #t "~a/main.cf~%"   #$config-dir))))
            (shepherd-action
              (name 'reload)
              (documentation
                 "
                  Re-read the \"master.cf\" and \"main.cf\" configuration files.

                  Daemon processes terminate when possible, and when restarted
                  use the values of the new configuration files.

                  This live-reload option is usually preferable over a stop/start
                  cycle, as it incurs in no interruption of the running service.")
              (procedure
                #~(lambda _
                    (invoke #$(file-append postfix "/sbin/postfix")
                            "-c"
                            #$config-dir
                            "reload")))))))))))

(define (postfix-aliases config)
  (match-record config <postfix-configuration>
      (root-aliases)
    (map (lambda (alias)
           `(,alias "root"))
         root-aliases)))


(define (postfix-nginx-locations config)
  (match-record config <postfix-configuration>
      (hostname)
    (list
     (nginx-server-configuration
       (server-name (list (string-append "mta-sts." hostname)))
       (listen '("[::]:443 ssl http2" "443 ssl http2"))
       (ssl-certificate     (cert-for "mta-sts." config))
       (ssl-certificate-key (key-for  "mta-sts." config))
       (locations
         (list
          (nginx-location-configuration
            (uri "= /.well-known/mta-sts.txt")
            (body
              (list
               (list "alias "
                     (plain-file
                      "mta-sts.txt"
                      (format #f "version: STSv1
mode: enforce
mx: ~a
max_age: 604800
"
                       hostname))
                     ";"))))))))))

(define (postfix-certificates config)
  (match-record config <postfix-configuration>
      (hostname)
    (list
     (certificate-configuration
       (domains (list (string-append "mta-sts." hostname)))))))

(define (postfix-sasl-services _config)
  (list
   (cyrus-service-configuration
     (name "smtpd.conf"))))

(define local-postfix-service-extensions
  (list
   (service-extension etc-service-type
                      postfix-etc-files)
   (service-extension account-service-type
                      postfix-accounts)
   (service-extension setuid-program-service-type
                      postfix-setuid-programs)
   (service-extension activation-service-type
                      postfix-activation)
   (service-extension profile-service-type
                      (compose list postfix-configuration-postfix))
   (service-extension shepherd-root-service-type
                      postfix-shepherd-service)))

(define local-postfix-service-type
  (service-type
    (name 'postfix)
    (extensions local-postfix-service-extensions)
    (default-value (postfix-configuration))
    (description
       "
        Run the Postfix MTA.

        This is the top-level system service for Postfix.

        It includes:
        - populating /etc/postfix/ with read-only configuration files;
        - the user and groups used by Postfix when handling email delivery;
        - the special setgid binaries for daily usage, such as \"sendmail\";
        - the Shepherd service for starting, stopping and *reloading* the
          service without restarting it;
        - the activation script for creating the required directories and
          configuring them with the correct permissions;
        - the binaries in the system profile so that one doesn't need to explicilty
          include the package when the service is already enabled.

        An extension to the log-rotation service isn't included: the default
        rottlog configuration already includes /var/log/maillog in its routine,
        so it is kept out.

        The defaults of <postfix-configuration> provide sane default values for
        most things, such as group names, data and queue directories, etc.  When
        used as-is, it creates a Postfix server that sends email from local users
        of the domain provided by \"/etc/hostname\".")))

(define internet-postfix-service-type
  (service-type
    (name 'postfix)
    (extensions
      (append
       local-postfix-service-extensions
       (list
        (service-extension mail-aliases-service-type
                           postfix-aliases)
        (service-extension nginx-service-type
                           postfix-nginx-locations)
        (service-extension certbot-service-type
                           postfix-certificates)
        (service-extension cyrus-sasl-service-type
                           postfix-sasl-services))))
    (default-value (postfix-configuration
                     (enable-submission? #t)))
    (description
       "
        Run the Postfix MTA.

        This is the top-level system service for Postfix.

        It includes:
        - populating /etc/postfix/ with read-only configuration files;
        - the user and groups used by Postfix when handling email delivery;
        - the special setgid binaries for daily usage, such as \"sendmail\";
        - the Shepherd service for starting, stopping and *reloading* the
          service without restarting it;
        - the activation script for creating the required directories and
          configuring them with the correct permissions;
        - the binaries in the system profile so that one doesn't need to explicilty
          include the package when the service is already enabled.

        An extension to the log-rotation service isn't included: the default
        rottlog configuration already includes /var/log/maillog in its routine,
        so it is kept out.

        The defaults of <postfix-configuration> provide sane default values for
        most things, such as group names, data and queue directories, etc.  When
        used as-is, it creates a Postfix server that sends email from local users
        of the domain provided by \"/etc/hostname\".")))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Dovecot ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define-record-type* <dovecot-configuration>
  dovecot-configuration
  make-dovecot-configuration
  dovecot-configuration?
  (dovecot           dovecot-configuration-dovecot          (default dovecot))
  (mail-in-home?     dovecot-configuration-mail-in-home?     (default #f))
  (raw-file          dovecot-configuration-raw-file          (default #f))
  (extra-content     dovecot-configuration-extra-content     (default ""))
  (config-name       dovecot-configuration-config-name       (default "dovecot.conf"))
  (user              dovecot-configuration-user              (default "dovecot"))
  (group             dovecot-configuration-group             (default "dovecot"))
  (auth-worker-group dovecot-configuration-auth-worker-group (default "etc-shadow"))
  (untrusted-user    dovecot-configuration-untrusted-user    (default "dovenull"))
  (untrusted-group   dovecot-configuration-untrusted-group   (default "dovenull"))
  (base-dir          dovecot-configuration-base-dir          (default "/var/run/dovecot"))
  (state-dir         dovecot-configuration-state-dir         (default "/var/lib/dovecot"))
  (hostname          dovecot-configuration-hostname          (default (gethostname))))


;; FIXME:
;; mail_plugins
(define (generate-dovecot-config config)
  (match-record config <dovecot-configuration>
      (mail-in-home? user group auth-worker-group untrusted-user
       hostname base-dir state-dir extra-content)
    (format #f
      "protocols = imap

default_internal_user = ~a
default_internal_group = ~a
default_login_user = ~a
auth_mechanisms = plain login
auth_username_format = %n

passdb {
  driver = shadow
}
userdb {
  driver = passwd
}
service auth-worker {
  group = ~a
}

ssl = required
ssl_cert = </etc/letsencrypt/live/~a/fullchain.pem
ssl_key  = </etc/letsencrypt/live/~a/privkey.pem
ssl_dh = <~a/dhparam.pem

base_dir = ~a
state_dir = ~a

verbose_proctitle = yes

mail_location = maildir:~a:INBOX=~a:LAYOUT=fs

namespace inbox {
  inbox = yes
  mailbox Drafts {
    special_use = \\Drafts
    auto = subscribe
  }
  mailbox Sent {
    special_use = \\Sent
    auto = subscribe
  }
  mailbox Archive {
    special_use = \\Archive
    auto = subscribe
  }
  mailbox Junk {
    special_use = \\Junk
    auto = subscribe
    autoexpunge = 30d
  }
  mailbox Trash {
    special_use = \\Trash
    auto = subscribe
  }
}
~a"
     user
     group
     untrusted-user
     auth-worker-group
     hostname
     hostname
     state-dir
     base-dir
     state-dir

     (if mail-in-home? "~/Mail"       "/var/mail/%u")
     (if mail-in-home? "~/Mail/Inbox" "/var/mail/%u")

     extra-content)))

(define (dovecot-etc-files config)
  (match-record config <dovecot-configuration>
      (raw-file config-name)
    `((,config-name ,(plain-file config-name
                                 (or raw-file
                                     (generate-dovecot-config config)))))))

(define (dovecot-accounts config)
  (match-record config <dovecot-configuration>
      (user group untrusted-user untrusted-group)
    (list
     (user-account
       (name user)
       (group group)
       (comment "Dovecot system user")
       (home-directory "/var/empty")
       (create-home-directory? #f)
       (shell
         (file-append shadow "/sbin/nologin"))
       (system? #t))
     (user-account
       (name untrusted-user)
       (group untrusted-group)
       (comment "Dovecot user for untrusted logins")
       (home-directory "/var/empty")
       (create-home-directory? #f)
       (shell
         (file-append shadow "/sbin/nologin"))
       (system? #t))
     (user-group
       (name group)
       (system? #t))
     (user-group
       (name untrusted-group)
       (system? #t)))))

(define (dovecot-activation config)
  (match-record config <dovecot-configuration>
      (base-dir state-dir)
    #~(begin
        (use-modules (guix build utils))
        (let ((user (getpwnam "root")))
          (format (current-error-port)
           "Creating Dovecot base_dir directory: \"~a\".~%" #$base-dir)
          (mkdir-p/perms #$base-dir user #o755)
          (let ((dhparam.pem (string-append #$state-dir "/dhparam.pem")))
            (mkdir-p/perms #$state-dir user #o755)
            (unless (file-exists? dhparam.pem)
              (format (current-error-port)
               "dhparam.pem file doesn't exist yet.  Generating one...~%")
              (cond
               ((zero? (system* (string-append #$openssl "/bin/openssl")
                                "dhparam" "-out" dhparam.pem "2048"))
                (format (current-error-port)
                 "Dovecot2 dhparam.pem file created: \"~a\".~%" dhparam.pem))
               (else
                (format (current-error-port)
                        "Failed to create dhparam.pem file: \"~a\".~%" dhparam.pem)))))))))

(define (dovecot-shepherd-service config)
  (match-record config <dovecot-configuration>
      (dovecot config-name)
    (let ((config-file (string-append "/etc/" config-name)))
      (list
       (shepherd-service
         (provision '(dovecot))
         (documentation "")
         (start #~(make-forkexec-constructor
                   (list
                    #$(file-append dovecot "/sbin/dovecot")
                    "-F"
                    "-c"
                    #$config-file)))
         (stop #~(make-kill-destructor))
         (actions
           (list
            (shepherd-action
              (name 'configuration)
              (documentation "FIXME:DOCUMENTATION: heredoc syntax")
              (procedure
                #~(lambda _
                    (format #t "~a~%" #$config-file))))
            (shepherd-action
              (name 'reload)
              (documentation "FIXME:DOCUMENTATION: heredoc syntax")
              (procedure
                #~(lambda _
                    (invoke #$(file-append dovecot "/bin/doveadm")
                            "-c"
                            #$config-file
                            "reload")))))))))))

(define dovecot-service-type
  (service-type
    (name 'dovecot)
    (extensions
      (list
       (service-extension etc-service-type
                          dovecot-etc-files)
       (service-extension account-service-type
                          dovecot-accounts)
       (service-extension activation-service-type
                          dovecot-activation)
       (service-extension profile-service-type
                          (compose list dovecot-configuration-dovecot))
       (service-extension shepherd-root-service-type
                          dovecot-shepherd-service)))
    (default-value (dovecot-configuration))
    (description "")))

;; FIXME
;; automate personal server with:
;; - euandreh:git-service-type
;; - euandreh:mail-service-type

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; OS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define cgit-pre-configuration
  (cgit-configuration
    (nginx '())
    (source-filter (file-append cgit "/lib/cgit/filters/syntax-highlighting.py"))
    (about-filter  (file-append cgit "/lib/cgit/filters/about-formatting.sh"))
    (virtual-root "/git/")
    (remove-suffix? #t)
    (nocache? #t)
    (enable-commit-graph? #t)
    (enable-follow-links? #t)
    (enable-index-links? #t)
    (enable-index-owner? #f)
    (enable-log-filecount? #t)
    (enable-log-linecount? #t)
    (enable-remote-branches? #t)
    (enable-subject-links? #t)
    (snapshots '("tar.gz" "tar.xz"))
    (root-desc "Patches welcome!")
    (root-title (string-append (gethostname) " repositories"))
    (logo    "/git/static/cgit.png")
    (favicon "/git/static/favicon.ico")
    (css     "/git/static/cgit.css")
    (extra-options
      '("enable-blame=1"
        "readme=:README.md"
        "readme=:README"))))


(list
 mailutils-sendmail
 rottlog-mailutils-sendmail
 postfix
 python-telegram-bot)