;;; GNU Guix --- Functional package management for GNU

;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This file is part of GNU Guix.

;;;

;;; GNU Guix is free software; you can redistribute it and/or modify it

;;; under the terms of the GNU General Public License as published by

;;; the Free Software Foundation; either version 3 of the License, or (at

;;; your option) any later version.

;;;

;;; GNU Guix is distributed in the hope that it will be useful, but

;;; WITHOUT ANY WARRANTY; without even the implied warranty of

;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

;;; GNU General Public License for more details.

;;;

;;; You should have received a copy of the GNU General Public License

;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;;;

;;; Some of the help text was taken from the default dovecot.conf files.

(define-module (services mail)

  #:use-module (gnu services)

  #:use-module (gnu services base)

  #:use-module (gnu services configuration)

  #:use-module (gnu services shepherd)

  #:use-module (gnu system pam)

  #:use-module (gnu system shadow)

  #:use-module (gnu packages admin)

  #:use-module (gnu packages mail)

  #:use-module (guix gexp)

  #:use-module (guix records)

  #:use-module (ice-9 match)

  #:export (dkimproxy-out-service-type

            dkimproxy-out-signature-configuration

            dkimproxy-out-signature-configuration-type

            dkimproxy-out-signature-configuration-key

            dkimproxy-out-signature-configuration-algorithm

            dkimproxy-out-signature-configuration-method

            dkimproxy-out-signature-configuration-domain

            dkimproxy-out-signature-configuration-identity

            dkimproxy-out-signature-configuration-selector

            dkimproxy-out-configuration

            dkimproxy-out-configuration-package

            dkimproxy-out-configuration-listen

            dkimproxy-out-configuration-relay

            dkimproxy-out-configuration-list-id-map

            dkimproxy-out-configuration-sender-map

            dkimproxy-out-configuration-reject-error?

            dkimproxy-out-configuration-config-file))

(define-record-type* <dkimproxy-out-signature-configuration>

  dkimproxy-out-signature-configuration make-dkimproxy-out-signature-configuration

  dkimproxy-out-signature-configuration?

  (type      dkimproxy-out-signature-configuration-type

             (default 'dkim))

  (key       dkimproxy-out-signature-configuration-key

             (default #f))

  (algorithm dkimproxy-out-signature-configuration-algorithm

             (default #f))

  (method    dkimproxy-out-signature-configuration-method

             (default #f))

  (domain    dkimproxy-out-signature-configuration-domain

             (default #f))

  (identity  dkimproxy-out-signature-configuration-identity

             (default #f))

  (selector  dkimproxy-out-signature-configuration-selector

             (default #f)))

(define generate-dkimproxy-out-signature-configuration

  (match-lambda

    (($ <dkimproxy-out-signature-configuration>

        type key algorithm method domain identity selector)

     (string-append

       (match type

         ('dkim "dkim")

         ('domainkeys "domainkeys"))

       (if (or key algorithm method domain identity selector)

           (string-append

             "("

             (string-join

              `(

                ,@(if key

                    (list (string-append "key=" key))

                    '())

               ,@(if algorithm

                   (list (string-append "a=" algorithm))

                   '())

               ,@(if method

                   (list (string-append "c=" method))

                   '())

               ,@(if domain

                   (list (string-append "d=" domain))

                   '())

               ,@(if identity

                   (list (string-append "i=" identity))

                   '())

               ,@(if selector

                   (list (string-append "s=" selector))

                   '()))

              ",")

             ")")

           "")))))

(define-record-type* <dkimproxy-out-configuration>

  dkimproxy-out-configuration make-dkimproxy-out-configuration

  dkimproxy-out-configuration?

  (package     dkimproxy-out-configuration-package

               (default dkimproxy))

  (listen      dkimproxy-out-configuration-listen

               (default #f))

  (relay       dkimproxy-out-configuration-relay

               (default #f))

  (list-id-map dkimproxy-out-configuration-list-id-map

               (default '()))

  (sender-map  dkimproxy-out-configuration-sender-map

               (default '()))

  (reject-error? dkimproxy-out-configuration-sender-reject-error?

                 (default #f))

  (config-file dkimproxy-out-configuration-config-file

               (default #f)))

(define (generate-map-file config filename)

  (apply plain-file filename

         (map (lambda (config)

                (match config

                  ((selector (config ...))

                   (string-append

                     selector " "

                     (string-join

                       (map generate-dkimproxy-out-signature-configuration config)

                       "\n")))

                  ((selector config)

                   (string-append

                     selector " "

                     (generate-dkimproxy-out-signature-configuration config)))))

              config)))

(define dkimproxy-out-shepherd-service

  (match-lambda

    (($ <dkimproxy-out-configuration> package listen relay list-id-map sender-map

        reject-error? config-file)

     (list (shepherd-service

             (provision '(dkimproxy-out))

             (requirement '(loopback))

             (documentation "Outbound DKIM proxy.")

             (start (let ((proxy (file-append package "/bin/dkimproxy.out")))

                      (if config-file

                        #~(make-forkexec-constructor

                            (list #$proxy (string-append "--conf_file=" #$config-file)

                                  "--pidfile=/var/run/dkimproxy.out.pid"

                                  "--user=dkimproxy" "--group=dkimproxy")

                            #:pid-file "/var/run/dkimproxy.out.pid")

                        (let* ((first-signature (match sender-map

                                                 (((sender (signature _ ...)) _ ...)

                                                   signature)

                                                 (((sender signature) _ ...)

                                                   signature)))

                               (domains

                                 (apply append

                                   (map

                                     (lambda (sender)

                                       (match sender

                                         (((domains ...) config)

                                          domains)

                                         ((domain config)

                                          domain)))

                                     sender-map)))

                               (sender-map (generate-map-file sender-map

                                                              "sender.map"))

                               (listid-map

                                 (if (null? list-id-map)

                                     #f

                                     (generate-map-file list-id-map "listid.map")))

                               (keyfile

                                 (dkimproxy-out-signature-configuration-key

                                   first-signature))

                               (selector

                                 (dkimproxy-out-signature-configuration-selector

                                   first-signature))

                               (method

                                 (dkimproxy-out-signature-configuration-method

                                   first-signature))

                               (signature

                                 (match (dkimproxy-out-signature-configuration-type

                                          first-signature)

				   ('dkim "dkim")

				   ('domainkeys "domainkeys"))))

                          #~(make-forkexec-constructor

                              `(,#$proxy "--pidfile=/var/run/dkimproxy.out.pid"

                                "--user=dkimproxy" "--group=dkimproxy"

                                ,(string-append "--listen=" #$listen)

                                ,(string-append "--relay=" #$relay)

                                ,(string-append "--sender_map=" #$sender-map)

                                ,@(if #$listid-map

                                    (list

                                      (string-append "--listid_map=" #$listid-map))

                                    '())

                                ,(string-append "--domain=" #$domains)

                                ,(string-append "--keyfile=" #$keyfile)

                                ,(string-append "--selector=" #$selector)

                                ,@(if #$method

                                      (list

                                        (string-append "--method=" #$method))

                                      '())

                                ,@(if #$reject-error?

                                      '("--reject_error")

                                      '())

                                ,@(if #$signature

                                      (list

                                        (string-append "--signature=" #$signature))

                                      '())))))))

             (stop #~(make-kill-destructor)))))))

(define %dkimproxy-accounts

  (list (user-group

          (name "dkimproxy")

          (system? #t))

        (user-account

          (name "dkimproxy")

          (group "dkimproxy")

          (system? #t)

          (comment "Dkimproxy user")

          (home-directory "/var/empty")

          (shell (file-append shadow "/sbin/nologin")))))

(define dkimproxy-out-service-type

  (service-type

    (name 'dkimproxy-out)

    (description "dkimproxy-out service")

    (extensions

      (list (service-extension account-service-type

                               (const %dkimproxy-accounts))

            (service-extension shepherd-root-service-type

                               dkimproxy-out-shepherd-service)))))