Package: guix-patches;
Reported by: Oleg Pykhalov <go.wigust <at> gmail.com>
Date: Wed, 7 Mar 2018 21:32:02 UTC
Severity: normal
Tags: patch
Done: Oleg Pykhalov <go.wigust <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Clément Lassieur <clement <at> lassieur.org> To: Oleg Pykhalov <go.wigust <at> gmail.com> Cc: 30744 <at> debbugs.gnu.org Subject: [bug#30744] [PATCH] tests: mail: Add test for dovecot. Date: Thu, 08 Mar 2018 10:41:27 +0100
Oleg Pykhalov <go.wigust <at> gmail.com> writes: > * gnu/tests/mail.scm (%dovecot-os, %test-dovecot): New variables. > (run-dovecot-test): New procedure. > --- > gnu/tests/mail.scm | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++- > 1 file changed, 113 insertions(+), 1 deletion(-) > > diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm > index 312df9b1c..77f273f8b 100644 > --- a/gnu/tests/mail.scm > +++ b/gnu/tests/mail.scm > @@ -29,7 +29,8 @@ > #:use-module (guix store) > #:use-module (ice-9 ftw) > #:export (%test-opensmtpd > - %test-exim)) > + %test-exim > + %test-dovecot)) > > (define %opensmtpd-os > (simple-operating-system > @@ -279,3 +280,114 @@ acl_check_data: > (name "exim") > (description "Send an email to a running an Exim server.") > (value (run-exim-test)))) > + > +(define %dovecot-os > + (simple-operating-system > + (dhcp-client-service) > + (dovecot-service #:config > + (dovecot-configuration > + (disable-plaintext-auth? #f) > + (ssl? "no") > + (auth-mechanisms '("anonymous")) > + (auth-anonymous-username "alice") > + (mail-location > + (string-append "maildir:~/Maildir" > + ":INBOX=~/Maildir/INBOX" > + ":LAYOUT=fs")))))) > + > +(define (run-dovecot-test) > + "Return a test of an OS running Dovecot service." > + (define vm > + (virtual-machine > + (operating-system (marionette-operating-system > + %dovecot-os > + #:imported-modules '((gnu services herd)))) > + (port-forwardings '((8143 . 143))))) > + > + (define test > + (with-imported-modules '((gnu build marionette)) > + #~(begin > + (use-modules (gnu build marionette) > + (ice-9 iconv) > + (ice-9 rdelim) > + (rnrs base) > + (rnrs bytevectors) > + (srfi srfi-64)) > + > + (define marionette > + (make-marionette '(#$vm))) > + > + (define* (message-length message #:key (encoding "iso-8859-1")) > + (bytevector-length (string->bytevector message encoding))) > + > + (define message "From: test <at> example.com\n\ > +Subject: Hello Nice to meet you!") > + > + (mkdir #$output) > + (chdir #$output) > + > + (test-begin "dovecot") > + > + ;; Wait for dovecot to be up and running. > + (test-eq "dovecot running" > + 'running! > + (marionette-eval > + '(begin > + (use-modules (gnu services herd)) > + (start-service 'dovecot) > + 'running!) > + marionette)) > + > + ;; Give the service time to start talking. > + (wait-for-file "/var/run/dovecot/master.pid" marionette) Could you put it in a test context (test-assert with file-exists? for example, see tests/messaging.scm)? > + (test-assert "accept an email" > + (let ((imap (socket AF_INET SOCK_STREAM 0)) > + (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143))) > + (connect imap addr) > + ;; Be greeted. > + (read-line imap) ;OK > + ;; Authenticate > + (write-line "a AUTHENTICATE ANONYMOUS" imap) > + (read-line imap) ;+ > + (write-line "c2lyaGM=" imap) > + (read-line imap) ;OK > + ;; Create a TESTBOX mailbox > + (write-line "a CREATE TESTBOX" imap) > + (read-line imap) ;OK > + ;; Append a message to a TESTBOX mailbox > + (write-line (format #f "a APPEND TESTBOX {~a}" > + (number->string (message-length message))) > + imap) > + (read-line imap) ;+ > + (write-line message imap) > + (read-line imap) ;OK > + ;; Logout > + (write-line "a LOGOUT" imap) > + (close imap) > + #t)) > + > + (test-equal "mail arrived" > + message > + (marionette-eval > + '(begin > + (use-modules (ice-9 ftw) > + (ice-9 match)) > + (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/")) > + (match (scandir TESTBOX/new) > + ((cwd .. message-file) You need to use double quotes, like ("." ".." message-file) I believe. > + (call-with-input-file > + (string-append TESTBOX/new message-file) > + get-string-all))))) > + marionette)) > + > + (test-end) > + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) > + > + (gexp->derivation "dovecot-test" test)) > + > +(define %test-dovecot > + (system-test > + (name "dovecot") > + (description "Connect to a running Dovecot server.") > + (value (run-dovecot-test))))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.