From 0fceb276035151132df57dd30ee13e0b6c48cfaa Mon Sep 17 00:00:00 2001 From: Alexey Abramov Date: Thu, 21 Nov 2024 12:25:58 +0000 Subject: tests: dovecot: Add sieve. * gnu/tests/mail.scm (%dovecot-os): Add dovecot-pigeonhole and simple imapsieve configuration. * gnu/tests/mail.scm (run-dovecot-test): Define simple sieve script. Add SELECT TESTBOX step to let dovecot properly do mailbox synchronization. --- gnu/tests/mail.scm | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 62 insertions(+), 5 deletions(-) diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index 176e7c1d07..3b498b5b57 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -297,10 +297,42 @@ acl_check_data: (service dhcp-client-service-type) (service dovecot-service-type (dovecot-configuration + (extensions (list dovecot-pigeonhole)) (disable-plaintext-auth? #f) + ;; Required for sieve! + (postmaster-address "postmaster@komputilo") (ssl? "no") (auth-mechanisms '("anonymous")) (auth-anonymous-username "alice") + (protocols + (list (protocol-configuration + (name "imap") + (mail-plugins '("$mail_plugins" "imap_sieve")) + (imap-metadata? #t)))) + + (plugin-configuration + (plugin-configuration + (entries (list + (cons 'sieve-global "/tmp") + (cons 'sieve-extensions "+editheader") + + (cons 'imapsieve-mailbox1-name "*") + (cons 'imapsieve-mailbox1-causes "APPEND") + ;; Run the script *before* the user scripts + (cons 'imapsieve-mailbox1-before "file:/tmp/main.sieve") + ;; We want to automatically remove original email + (cons 'imapsieve-expunge-discarded "yes") + + (cons 'sieve-trace-debug "yes") + (cons 'sieve-trace-dir "/tmp") + (cons 'sieve-trace-level "tests") + (cons 'sieve-plugins "sieve_imapsieve") + ;; You cannot run scripts anywhere you want + ;; Sieve allows you to only run scripts under + ;; sieve_pipe_bin_dir. + (cons 'sieve-pipe-bin-dir "/tmp") + )))) + (mail-location (string-append "maildir:~/Maildir" ":INBOX=~/Maildir/INBOX" @@ -334,6 +366,18 @@ acl_check_data: (define message "From: test@example.com\n\ Subject: Hello Nice to meet you!") + (define sieve-script + "require \"editheader\";\n +addheader \"X-Sieve-Filtered\" \"Guix\"; +") + ;; Install our sieve script + (marionette-eval + `(begin + (with-output-to-file "/tmp/main.sieve" + (lambda () + (display ,sieve-script)))) + marionette) + (test-runner-current (system-test-runner #$output)) (test-begin "dovecot") @@ -367,6 +411,19 @@ Subject: Hello Nice to meet you!") ;; Create a TESTBOX mailbox (write-line "a CREATE TESTBOX" imap) (read-line imap) ;OK + ;; Select mailbox. This is required so that dovecot did + ;; synchronization correctly. + (write-line "a SELECT TESTBOX" imap) + ;; ("* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)\r") + ;; ("* OK [PERMANENTFLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft \\*)] Flags permitted.\r") + ;; ("* 1 EXISTS\r") + ;; ("* 1 RECENT\r") + ;; ("* OK [UNSEEN 1] First unseen.\r") + ;; ("* OK [UIDVALIDITY 1732177859] UIDs valid\r") + ;; ("* OK [UIDNEXT 3] Predicted next UID\r") + (for-each (lambda (n) + (read-line imap)) + (iota 7)) ;; Append a message to a TESTBOX mailbox (write-line (format #f "a APPEND TESTBOX {~a}" (number->string (message-length message))) @@ -380,18 +437,18 @@ Subject: Hello Nice to meet you!") #t)) (test-equal "mail arrived" - message + (string-join (list "X-Sieve-Filtered: Guix" message) "\n") (marionette-eval '(begin (use-modules (ice-9 ftw) (ice-9 match) (rnrs io ports)) - - (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/")) - (match (scandir TESTBOX/new) + ;; XXX: We expect a new email in /cur directory + (let ((TESTBOX/cur "/home/alice/Maildir/TESTBOX/cur/")) + (match (scandir TESTBOX/cur) (("." ".." message-file) (call-with-input-file - (string-append TESTBOX/new message-file) + (string-append TESTBOX/cur message-file) get-string-all))))) marionette)) -- cgit v1.2.3