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-mail-directory
             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-configuration>
             dovecot-configuration
        make-dovecot-configuration
             dovecot-configuration?

             dovecot-configuration-package
             dovecot-configuration-mail-in-home?
             dovecot-configuration-mail-location
             dovecot-configuration-raw-file
             dovecot-configuration-extra-content
             dovecot-configuration-config-dirname
             dovecot-configuration-config-filename
             dovecot-configuration-user
             dovecot-configuration-group
             dovecot-configuration-supplementary-groups
             dovecot-configuration-auth-worker-group
             dovecot-configuration-untrusted-user
             dovecot-configuration-untrusted-group
             dovecot-configuration-untrusted-supplementary-groups
             dovecot-configuration-base-dir
             dovecot-configuration-state-dir
             dovecot-configuration-hostname
             dovecot-configuration-run-in-container?
             dovecot-configuration-container-name
             dovecot-configuration-container-namespaces
             dovecot-configuration-extra-mappings

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


             cgit-pre-configuration))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; finished 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-join (list
                                     "-DNO_NIS"
                                     "-DUSE_TLS"
                                     "-DUSE_SASL_AUTH"
                                     "-DUSE_CYRUS_SASL"
                                     "-I"
                                     (string-append
                                      (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))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; WIP packages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



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



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


(define-record-type* <postfix-configuration>
  postfix-configuration
  make-postfix-configuration
  postfix-configuration?
  (package              postfix-configuration-package              (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"))
  (mail-directory       postfix-configuration-mail-directory       (default "/var/mail/"))
  (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"))
  (supplementary-groups postfix-configuration-supplementary-groups (default '()))
  (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)))
  (dkim-filter-listen   postfix-configuration-dkim-filter-listen   (default "[127.0.0.1]:10027"))
  (dkim-filter-relay    postfix-configuration-dkim-filter-relay    (default "127.0.0.1:10028"))
  (sasl-dirname         postfix-configuration-sasl-dirname         (default "/etc/sasl2"))
  (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 (dksign-filter dkim-filter-listen)
  (format #f
   "
  -o content_filter=dksign:~a"
   dkim-filter-listen))

(define (submission-config dkim-filter-listen)
  (format #f
   "
submission  inet       n        -       n       -        -        smtpd -o syslog_name=postfix/submission
  -o smtpd_tls_security_level=encrypt
  -o content_filter=dksign:~a"
   dkim-filter-listen))

(define (dksign-config dkim-filter-relay)
  (format #f
   "

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

~a 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
"
   dkim-filter-relay))

(define (generate-master.cf config)
  (match-record config <postfix-configuration>
      (enable-submission? master.cf-extra dkim-filter-listen dkim-filter-relay)
    (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 dkim-filter-listen)      "")
     (if enable-submission? (submission-config dkim-filter-listen)  "")
     (if enable-submission? (dksign-config dkim-filter-relay)       "")
     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 sasl-dirname)
  (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 = ~a
debug_peer_list = 127.0.0.1

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

(define (generate-main.cf config)
  (match-record config <postfix-configuration>
      (mail-in-home? enable-submission? mail-directory queue-directory data-directory
       user setgid-group hostname main.cf-extra sasl-dirname)
    (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/"
       (string-append "mail_spool_directory = " mail-directory))
     main.cf-extra
     (if enable-submission?
       (main.cf-internet-extra
        hostname
        (cert-for "" config)
        (key-for  "" config)
        sasl-dirname)
       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 supplementary-groups setgid-group)
    (list
     (user-account
       (name user)
       (group group)
       (supplementary-groups supplementary-groups)
       (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>
      (package setgid-group set-sendmail?)
    (append
     (list
      (setuid-program
        (program (file-append package "/sbin/postdrop"))
        (setuid? #f)
        (setgid? #t)
        (group setgid-group))
      (setuid-program
        (program (file-append package "/sbin/postqueue"))
        (setuid? #f)
        (setgid? #t)
        (group setgid-group)))
     (if set-sendmail?
       (list
        (setuid-program
          (program (file-append package "/sbin/sendmail"))
          (setuid? #f)
          (setgid? #t)
          (group setgid-group)))
       '()))))

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

(define (postfix-shepherd-service config)
  (match-record config <postfix-configuration>
      (package 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 package "/sbin/postfix"))
           (cmd (if (not run-in-container?)
                  bin
                  (least-authority-wrapper
                   bin
                   #:name container-name
                   #:namespaces container-namespaces
                   #: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)))))
      (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 #$cmd "-c" #$config-dir "start-fg")
                   #:pid-file "/var/lib/postfix/master.lock"))
         (stop #~(make-kill-destructor SIGKILL))
         (actions
           (list
            (shepherd-action
              (name 'configuration)
              (documentation "Display the name of the \"master.cf\" and \"main.cf\" file being used.")
              (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 #$cmd "-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-package))
   (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, targeted at \"local\"
installations, that is, not internet-facing, usually for delivery of cronjob
emails, or for offline email sending in a laptop via a relay.

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

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

The defaults of @code{<postfix-configuration>} provides 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 locally-only, and one can
add relaying configuration via the @code{main.cf-extra} parameter.")))

(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, targeted at \"internet\"
installations, that is, internet-facing SMTP servers, for sending and receiving
emails to other servers, as well as local delivery of emails between users or by
system users such as cronjobs.

It includes everything from @code{local-postfix-service-type}, plus:
@itemize
@item nginx configuration for answering the @code{mta-sts.$domain} HTTP
      subdomain, specifically the @code{.well-known/mta-sts.txt} URL;
@item certbot extension for acquiring the certificate for @code{mta-sts.$domain}
      so that the item above happens via HTTPS;
@item best-practices email aliases for administering a SMTP server;
@item cyrus-sasl extension for authenticating SMTP users via the Cyrus SASL
      @code{saslauthd} daemon.
@end itemize

The defaults of @code{<postfix-configuration>} provides sane default values for
most things, hostname, certificates, permissions, etc.  When used as-is, it
creates a Postfix server that can send and receive emails from the internet
correctly.")))



(define-record-type* <dovecot-configuration>
  dovecot-configuration
  make-dovecot-configuration
  dovecot-configuration?
  (package                        dovecot-configuration-package                        (default dovecot))
  (mail-in-home?                  dovecot-configuration-mail-in-home?                  (default #f))
  (mail-location                  dovecot-configuration-mail-location                  (default "/var/mail/"))
  (raw-file                       dovecot-configuration-raw-file                       (default #f))
  (extra-content                  dovecot-configuration-extra-content                  (default ""))
  (config-dirname                 dovecot-configuration-config-dirname                 (default "dovecot"))
  (config-filename                dovecot-configuration-config-filename                (default "dovecot.conf"))
  (user                           dovecot-configuration-user                           (default "dovecot"))
  (group                          dovecot-configuration-group                          (default "dovecot"))
  (supplementary-groups           dovecot-configuration-supplementary-groups           (default '()))
  (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"))
  (untrusted-supplementary-groups dovecot-configuration-untrusted-supplementary-groups (default '()))
  (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)))
  (run-in-container?              dovecot-configuration-run-in-container?              (default #f))
  (container-name                 dovecot-configuration-container-name                 (default "dovecot"))
  (container-namespaces           dovecot-configuration-container-namespaces           (default (s1:fold delq container:%namespaces '(net))))
  (extra-mappings                 dovecot-configuration-extra-mappings                 (default '())))

(define (generate-dovecot-config config)
  (match-record config <dovecot-configuration>
      (mail-in-home? mail-location 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"       (string-append mail-location "%u"))
     (if mail-in-home? "~/Mail/Inbox" (string-append mail-location "%u"))

     extra-content)))

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

(define (dovecot-accounts config)
  (match-record config <dovecot-configuration>
      (          user           group           supplementary-groups
       untrusted-user untrusted-group untrusted-supplementary-groups)
    (list
     (user-account
       (name user)
       (group group)
       (supplementary-groups supplementary-groups)
       (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)
       (supplementary-groups untrusted-supplementary-groups)
       (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"))
              (dhparam.pem (string-append #$state-dir "/dhparam.pem")))
          (format (current-error-port)
           "Creating Dovecot base_dir directory: \"~a\".~%" #$base-dir)
          (mkdir-p/perms #$base-dir  user #o755)
          (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>
      (package config-dirname config-filename
       run-in-container? container-name container-namespaces extra-mappings)
    (let* ((config-file (string-append "/etc/" config-dirname "/" config-filename))
           (bin (file-append package "/sbin/dovecot"))
           (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/shadow")
                                  (target source)))
                               extra-mappings)))))
      (list
       (shepherd-service
         (provision '(dovecot))
         (documentation "Run the Dovecot daemon.")
         (start #~(make-forkexec-constructor
                   (list #$cmd "-F" "-c" #$config-file)))
         (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))))
            (shepherd-action
              (name 'reload)
              (documentation "Re-read the configuration file without restarting the running dovecot daemon.")
              (procedure
                #~(lambda _
                    (invoke #$(file-append package "/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-package))
       (service-extension shepherd-root-service-type
                          dovecot-shepherd-service)))
    (default-value (dovecot-configuration))
    (description "Run the Dovecot IMAP @code{dovecot} daemon.

This is the top-level system service for Dovecot, using the UNIX password stored
at @file{/etc/shadow} for authenticating IMAP connections.

It includes:
@itemize
@item creating the configuration file at @file{/etc/dovecot/dovecot.conf} by
      default;
@item the user and groups used by Dovecot both system and untrusted users;
@item the activation script for creating the required directories and the
      @file{dhparam.pem} file if it is missing;
@item the Shepherd service for starting, stopping and @emph{reloading} the
      service without restarting it;
@item the binaries in the system profile so that one doesn't need to explicilty
      include the package when the service is already enabled.
@end itemize

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

The defaults of @code{<dovecot-configuration>} provides sane default values for
most things, such as group names, data and mail directories, etc.  When used
as-is, it creates a Dovecot server that and serve and authenticate IMAP
connections correctly.")))


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