[bug#37222] [PATCH] gnu: services: Add dkimproxy-out.

[Julien Lepiller <julien@lepiller.eu>]

[-- Attachment #1: Type: text/plain, Size: 196 bytes --]

Hi guix, the attached patch adds the dkimproxy-out service that I use
for signing my emails (including this one, although it's probably not
valid because it went through a mailing list).

Thanks!

[-- Attachment #2: 0001-gnu-services-Add-dkimproxy-out.patch --]
[-- Type: text/x-patch, Size: 15463 bytes --]

From 114067a7134ceb49dc5bbcef820edc49d62c8d0f Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Thu, 29 Aug 2019 21:48:25 +0200
Subject: [PATCH] gnu: services: Add dkimproxy-out.

* gnu/services/mail.scm (dkimproxy-out-service-type): New variable.
* doc/guix.texi (Mail Services): Document it.
---
 doc/guix.texi         | 114 +++++++++++++++++++++++
 gnu/services/mail.scm | 211 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 324 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1998ad049b..ec0f04fdea 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17264,6 +17264,120 @@ Mailutils Manual}, for details.
 @end table
 @end deftp
 
+@subsubheading Dkimproxy Outbound Service
+@cindex Dkimproxy Outbound Service
+
+@deffn {Scheme Variable} dkimproxy-out-service-type
+This is the type of the @uref{http://dkimproxy.sourceforge.net/, dkimproxy
+outbound daemon}, whose value should be a @code{dkimproxy-out-configuration}
+object as in this example:
+
+@example
+(service dkimproxy-out-service-type
+         (dkimproxy-out-configuration
+	   (listen "127.0.0.1:10027")
+	   (relay "127.0.0.1:10028")
+	   (sender-map
+	     `(("example.com"
+	        (,(dkimproxy-out-signature-configuration
+		    (type 'dkim)
+		    (key "/etc/mail/dkim/private.key")
+		    (method "relaxed")
+		    (selector "dkim"))))))))
+@end example
+@end deffn
+
+@deftp {Data Type} dkimproxy-out-configuration
+Data type representing the configuration of @command{dkimproxy.out}.
+
+@table @asis
+@item @code{package} (default: @code{dkimproxy})
+The package that provides @command{dkimproxy.out}.
+
+@item @code{listen} (default: @code{#f})
+The interface and port on which to listen for incoming connections (messages
+to sign).
+
+@item @code{relay} (default: @code{#f})
+The interface and port on which to send (relay) the signed messages.
+
+@item @code{list-id-map} (default: @code{'()})
+A map of List-Id to configuration.  The key of the association list must be a
+string representing the content of a List-Id field in the incoming message.
+The associated value is a @code{dkimproxy-out-signature-configuration} object
+that represents configuration that must be applied to messages that contain
+the corresponding List-Id header.
+
+@item @code{sender-map} (default: @code{'()})
+A map of Sender to configuration.  The key of the association list must be a
+string representing a sender of the incoming message.  The associated value is
+a @code{dkimproxy-out-signature-configuration} object that represents
+configuration that must be applied to messages that are sent by the
+corresponding sender.
+
+Note that a @code{sender-map} is required and cannot be empty.
+
+@item @code{reject-error?} (default: @code{#f})
+This option specifies what to do if an error occurs during signing of a
+message.  If this option is set to @code{#t}, the message will be rejected
+with an SMTP error code.  This will result in the MTA sending the message
+to try again later, or bounce it back to the sender (depending on the exact
+error code used).  If this option is set to @code{#f}, the message will be
+allowed to pass through without having a signature added.
+
+A @code{list-id-map} is not required and can be empty.
+
+@item @code{config-file} (default: @code{#f})
+A file-like object that contains the full configuration for dkimproxy-out. If
+this option is not @code{#f}, every other field of this configuration will
+be ignored except the package configuration. See the man page for
+@command{dkimproxy.out} for more information.
+
+@end table
+@end deftp
+
+@deftp {Data Type} dkimproxy-out-signature-configuration
+Data type representing a signature configuration for @command{dkimproxy.out}.
+
+The @code{keyfile}, @code{method}, @code{selector} and @code{signature} of the
+first @code{dkimproxy-out-signature-configuration} in @code{sender-map} are
+taken as the default value of any subsequent configuration in @code{sender-map}
+and any configuration in @code{list-id-map}.
+
+@table @asis
+@item @code{type} (default: @code{'dkim})
+The type of signature, either @code{'dkim} or @code{'domainkey}.
+
+@item @code{key} (default: @code{#f})
+The key file that contains the private key for signing.  If @code{#f}, the
+default key file is used.  It must not be @code{#f} for the first item of
+the @code{sender-map}.
+
+@item @code{algorithm} (default: @code{#f})
+The algorithm used to sign messages, as a string.  If @code{#f}, the default
+algorithm is used.
+
+@item @code{method} (default: @code{#f})
+The canonicalization method to use.  It must not be @code{#f} for the first
+item of the @code{sender-map}.  Accepted value for @command{dkimproxy.out} are
+@code{"simple"}, @code{"relaxed"} and @code{"nofws"}.
+
+@item @code{domain} (default: @code{#f})
+The domain to use for signing.  If @code{#f}, default is to use the domain
+matched.
+
+@item @code{identity} (default: @code{#f})
+The identity to use.  If @code{#f}, default is to not use any identity.
+
+@item @code{selector} (default: @code{#f})
+The selector to use.  If @code{#f}, the default selector is used.  It must
+not be @code{#f} for the first item of the @code{sender-map}.  The selector
+is the first DNS component of the name in which the public DKIM key is
+recorded for the domain used.  For instance, if you have a
+@code{dkim._domainkey.example.com.} record, the selector is @code{dkim}.
+@end table
+@end deftp
+
 @node Messaging Services
 @subsection Messaging Services
 
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 3de0b4c2f3..670b3c33ff 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -70,7 +70,28 @@
             imap4d-configuration
             imap4d-configuration?
             imap4d-service-type
-            %default-imap4d-config-file))
+            %default-imap4d-config-file
+	    
+	    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))
 
 ;;; Commentary:
 ;;;
@@ -1825,3 +1846,191 @@ exim_group = exim
     (list (service-extension
            shepherd-root-service-type imap4d-shepherd-service)))
    (default-value (imap4d-configuration))))
+
+;;;
+;;; Dkimproxy Daemon.
+;;;
+
+(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)
+    (extensions
+      (list (service-extension account-service-type
+                               (const %dkimproxy-accounts))
+            (service-extension shepherd-root-service-type
+                               dkimproxy-out-shepherd-service)))))
-- 
2.22.0