diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/mail.scm | 135 |
1 files changed, 134 insertions, 1 deletions
diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index d5c08b7f09..247f4f667f 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 <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)))) |