bug#26306: exim service patches (including mail-aliases-service-type)

[Carlo Zancanaro]

I've wanted to fix up the exim service given Ludo's comments on my last
few patches (see #25789), so here are some patches to introduce a
mail-aliases-service-type, to change exim-service-type to use it
(instead of doing its own thing), and to add a system test for
exim-service-type.

I haven't yet written the updates necessary to the documentation, but I
thought I'd send these now to get feedback before I do the work to fix
up the docs.

From 11a5223f4a9487d3a9a17925488e18e80baec843 Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <address@hidden>
Date: Thu, 30 Mar 2017 15:25:58 +1100
Subject: [PATCH 1/3] services: Add mail-aliases-service-type.

* gnu/services/mail.scm (mail-aliases-etc): New procedure.
(mail-aliases-service-type): New variable.
---
 gnu/services/mail.scm | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 05978e006..146ed951f 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -35,6 +35,7 @@
   #:use-module (guix gexp)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
   #:export (dovecot-service
             dovecot-service-type
             dovecot-configuration
@@ -57,6 +58,8 @@
             opensmtpd-service-type
             %default-opensmtpd-config-file
 
+            mail-aliases-service-type
+
             exim-configuration
             exim-configuration?
             exim-service-type
@@ -1662,6 +1665,31 @@ accept from local for any relay
 

 ;;;
+;;; mail aliases.
+;;;
+
+(define (mail-aliases-etc aliases)
+  `(("aliases" ,(plain-file "aliases"
+                            ;; Ideally we'd use a format string like
+                            ;; "~:{~a: ~{~a~^,~}\n~}", but it gives a
+                            ;; warning that I can't figure out how to fix,
+                            ;; so we'll just use string-join below instead.
+                            (format #f "~:{~a: ~a\n~}"
+                                    (map (lambda (entry)
+                                           (list (car entry)
+                                                 (string-join (cdr entry) 
",")))
+                                         aliases))))))
+
+(define mail-aliases-service-type
+  (service-type
+   (name 'mail-aliases)
+   (extensions
+    (list (service-extension etc-service-type mail-aliases-etc)))
+   (compose concatenate)
+   (extend append)))
+
+
+;;;
 ;;; Exim.
 ;;;
 
-- 
2.12.0

From 8ac4f5fba3420ba5525cd7dff93d30f7fed8b0ae Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <address@hidden>
Date: Thu, 30 Mar 2017 15:28:26 +1100
Subject: [PATCH 2/3] services: Make exim-service-type use
 mail-aliases-service-type

* gnu/services/mail.scm (exim-configuration)[aliases]: Remove field.
(exim-activation, exim-shepherd-service): Remove alias from matches.
(exim-etc): Remove procedure.
(exim-service-type): Extend mail-aliases-service-type instead of
etc-service-type.
---
 gnu/services/mail.scm | 24 ++++--------------------
 1 file changed, 4 insertions(+), 20 deletions(-)

diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 146ed951f..f16f7e026 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1699,9 +1699,7 @@ accept from local for any relay
   (package       exim-configuration-package ;<package>
                  (default exim))
   (config-file   exim-configuration-config-file ;file-like
-                 (default #f))
-  (aliases       exim-configuration-aliases ;; list of lists
-                 (default '())))
+                 (default #f)))
 
 (define %exim-accounts
   (list (user-group
@@ -1728,7 +1726,7 @@ exim_group = exim
 
 (define exim-shepherd-service
   (match-lambda
-    (($ <exim-configuration> package config-file aliases)
+    (($ <exim-configuration> package config-file)
      (list (shepherd-service
             (provision '(exim mta))
             (documentation "Run the exim daemon.")
@@ -1741,7 +1739,7 @@ exim_group = exim
 
 (define exim-activation
   (match-lambda
-    (($ <exim-configuration> package config-file aliases)
+    (($ <exim-configuration> package config-file)
      (with-imported-modules '((guix build utils))
        #~(begin
            (use-modules (guix build utils))
@@ -1754,20 +1752,6 @@ exim_group = exim
            (zero? (system* #$(file-append package "/bin/exim")
                            "-bV" "-C" #$(exim-computed-config-file package 
config-file))))))))
 
-(define exim-etc
-  (match-lambda
-    (($ <exim-configuration> package config-file aliases)
-     `(("aliases" ,(plain-file "aliases"
-                               ;; Ideally we'd use a format string like
-                               ;; "~:{~a: ~{~a~^,~}\n~}", but it gives a
-                               ;; warning that I can't figure out how to fix,
-                               ;; so we'll just use string-join below instead.
-                               (format #f "~:{~a: ~a\n~}"
-                                       (map (lambda (entry)
-                                              (list (car entry)
-                                                    (string-join (cdr entry) 
",")))
-                                            aliases))))))))
-
 (define exim-profile
   (compose list exim-configuration-package))
 
@@ -1779,4 +1763,4 @@ exim_group = exim
           (service-extension account-service-type (const %exim-accounts))
           (service-extension activation-service-type exim-activation)
           (service-extension profile-service-type exim-profile)
-          (service-extension etc-service-type exim-etc)))))
+          (service-extension mail-aliases-service-type (const '()))))))
-- 
2.12.0

From 984298f4cea4ac3bff530a4a767bf96567ec284f Mon Sep 17 00:00:00 2001
From: Carlo Zancanaro <address@hidden>
Date: Thu, 30 Mar 2017 15:13:56 +1100
Subject: [PATCH 3/3] tests: mail: Add test for exim

* gnu/tests/mail.scm (%exim-os, %test-exim): New variables.
(run-exim-test): New procedure.
---
 gnu/tests/mail.scm | 143 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 142 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 47328a54a..1d8c0e22e 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Sou Bunnbu <address@hidden>
+;;; Copyright © 2017 Carlo Zancanaro <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,9 @@
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (guix store)
-  #:export (%test-opensmtpd))
+  #:use-module (ice-9 ftw)
+  #:export (%test-opensmtpd
+            %test-exim))
 
 (define %opensmtpd-os
   (operating-system
@@ -157,3 +160,141 @@ accept from any for local deliver to mbox
    (name "opensmtpd")
    (description "Send an email to a running OpenSMTPD server.")
    (value (run-opensmtpd-test))))
+
+
+(define %exim-os
+  (operating-system
+    (host-name "komputilo")
+    (timezone "Europe/Berlin")
+    (locale "en_US.UTF-8")
+    (bootloader (grub-configuration (device #f)))
+    (file-systems %base-file-systems)
+    (firmware '())
+    (services (cons*
+               (dhcp-client-service)
+               (service mail-aliases-service-type '())
+               (service exim-service-type
+                        (exim-configuration
+                         (config-file
+                          (plain-file "exim.conf" "
+primary_hostname = komputilo
+domainlist local_domains = @
+domainlist relay_to_domains =
+hostlist   relay_from_hosts = localhost
+
+never_users =
+
+acl_smtp_rcpt = acl_check_rcpt
+acl_smtp_data = acl_check_data
+
+begin acl
+
+acl_check_rcpt:
+  accept
+acl_check_data:
+  accept
+"))))
+               %base-services))))
+
+(define (run-exim-test)
+  "Return a test of an OS running an Exim service."
+  (mlet* %store-monad ((command (system-qemu-image/shared-store-script
+                                 (marionette-operating-system
+                                  %exim-os
+                                  #:imported-modules '((gnu services herd)))
+                                 #:graphic? #f)))
+    (define test
+      (with-imported-modules '((gnu build marionette)
+                               (ice-9 ftw))
+        #~(begin
+            (use-modules (rnrs base)
+                         (srfi srfi-64)
+                         (ice-9 ftw)
+                         (ice-9 rdelim)
+                         (ice-9 regex)
+                         (gnu build marionette))
+
+            (define marionette
+              (make-marionette
+               ;; Enable TCP forwarding of the guest's port 25.
+               '(#$command "-net" "user,hostfwd=tcp::1025-:25")))
+
+            (define (read-reply-code port)
+              "Read a SMTP reply from PORT and return its reply code."
+              (let* ((line      (read-line port))
+                     (mo        (string-match "([0-9]+)([ -]).*" line))
+                     (code      (string->number (match:substring mo 1)))
+                     (finished? (string= " " (match:substring mo 2))))
+                (if finished?
+                    code
+                    (read-reply-code port))))
+
+            (define smtp (socket AF_INET SOCK_STREAM 0))
+            (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
+
+            (mkdir #$output)
+            (chdir #$output)
+
+            (test-begin "exim")
+
+            (test-assert "service is running"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'exim)
+                  #t)
+               marionette))
+
+            (sleep 1) ;; give the service time to start working
+
+            (connect smtp addr)
+            ;; Be greeted.
+            (test-eq "greeting received"
+              220 (read-reply-code smtp))
+            ;; Greet the server.
+            (write-line "EHLO somehost" smtp)
+            (test-eq "greeting successful"
+              250 (read-reply-code smtp))
+            ;; Set sender email.
+            (write-line "MAIL FROM: address@hidden" smtp)
+            (test-eq "sender set"
+              250 (read-reply-code smtp)) ;250
+            ;; Set recipient email.
+            (write-line "RCPT TO: address@hidden" smtp)
+            (test-eq "recipient set"
+              250 (read-reply-code smtp)) ;250
+            ;; Send message.
+            (write-line "DATA" smtp)
+            (test-eq "data begun"
+              354 (read-reply-code smtp)) ;354
+            (write-line "Subject: Hello" smtp)
+            (newline smtp)
+            (write-line "Nice to meet you!" smtp)
+            (write-line "." smtp)
+            (test-eq "message sent"
+              250 (read-reply-code smtp)) ;250
+            ;; Say goodbye.
+            (write-line "QUIT" smtp)
+            (test-eq "quit successful"
+              221 (read-reply-code smtp)) ;221
+            (close smtp)
+
+            (test-eq "the email is received"
+              1
+              (marionette-eval
+               '(begin
+                  (use-modules (ice-9 ftw))
+                  (length (scandir "/var/spool/exim/msglog"
+                                   (lambda (x) (not (string-prefix? "." x))))))
+               marionette))
+
+            (test-end)
+            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+    (gexp->derivation "exim-test" test)))
+
+(define %test-exim
+  (system-test
+   (name "exim")
+   (description "Send an email to a running an Exim server.")
+   (value (run-exim-test))))
-- 
2.12.0

signature.asc
Description: PGP signature