@@ 1,5 1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
+;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
;;;
;;; This file is part of GNU Guix.
;;;
@@ 26,7 27,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
(simple-operating-system
@@ 146,3 149,133 @@ 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
+ (simple-operating-system
+ (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
+"))))))
+
+(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 talking
+
+ (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: test@example.com" smtp)
+ (test-eq "sender set"
+ 250 (read-reply-code smtp)) ;250
+ ;; Set recipient email.
+ (write-line "RCPT TO: root@komputilo" 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))))