Commit | Line | Data |
---|---|---|
a82f0b36 SB |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org> | |
950026ac | 3 | ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au> |
8b113790 | 4 | ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> |
a9079b48 | 5 | ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> |
c24b1547 | 6 | ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> |
f6b0e1f8 | 7 | ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> |
c3f146e7 | 8 | ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr> |
a82f0b36 SB |
9 | ;;; |
10 | ;;; This file is part of GNU Guix. | |
11 | ;;; | |
12 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
13 | ;;; under the terms of the GNU General Public License as published by | |
14 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
15 | ;;; your option) any later version. | |
16 | ;;; | |
17 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
18 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;;; GNU General Public License for more details. | |
21 | ;;; | |
22 | ;;; You should have received a copy of the GNU General Public License | |
23 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
24 | ||
25 | (define-module (gnu tests mail) | |
26 | #:use-module (gnu tests) | |
bf5929c5 | 27 | #:use-module (gnu packages mail) |
a82f0b36 | 28 | #:use-module (gnu system) |
a82f0b36 SB |
29 | #:use-module (gnu system vm) |
30 | #:use-module (gnu services) | |
f6b0e1f8 | 31 | #:use-module (gnu services getmail) |
a82f0b36 SB |
32 | #:use-module (gnu services mail) |
33 | #:use-module (gnu services networking) | |
34 | #:use-module (guix gexp) | |
a82f0b36 | 35 | #:use-module (guix store) |
950026ac CZ |
36 | #:use-module (ice-9 ftw) |
37 | #:export (%test-opensmtpd | |
a9079b48 | 38 | %test-exim |
f6b0e1f8 CB |
39 | %test-dovecot |
40 | %test-getmail)) | |
a82f0b36 SB |
41 | |
42 | (define %opensmtpd-os | |
892d9089 | 43 | (simple-operating-system |
39d7fdce | 44 | (service dhcp-client-service-type) |
892d9089 LC |
45 | (service opensmtpd-service-type |
46 | (opensmtpd-configuration | |
47 | (config-file | |
48 | (plain-file "smtpd.conf" " | |
a82f0b36 | 49 | listen on 0.0.0.0 |
c3f146e7 TGR |
50 | action inbound mbox |
51 | match from any for local action inbound | |
892d9089 | 52 | ")))))) |
a82f0b36 SB |
53 | |
54 | (define (run-opensmtpd-test) | |
55 | "Return a test of an OS running OpenSMTPD service." | |
8b113790 LC |
56 | (define vm |
57 | (virtual-machine | |
58 | (operating-system (marionette-operating-system | |
59 | %opensmtpd-os | |
60 | #:imported-modules '((gnu services herd)))) | |
61 | (port-forwardings '((1025 . 25))))) | |
62 | ||
63 | (define test | |
64 | (with-imported-modules '((gnu build marionette)) | |
65 | #~(begin | |
66 | (use-modules (rnrs base) | |
67 | (srfi srfi-64) | |
68 | (ice-9 rdelim) | |
69 | (ice-9 regex) | |
70 | (gnu build marionette)) | |
71 | ||
72 | (define marionette | |
73 | (make-marionette '(#$vm))) | |
74 | ||
75 | (define (read-reply-code port) | |
76 | "Read a SMTP reply from PORT and return its reply code." | |
77 | (let* ((line (read-line port)) | |
78 | (mo (string-match "([0-9]+)([ -]).*" line)) | |
79 | (code (string->number (match:substring mo 1))) | |
80 | (finished? (string= " " (match:substring mo 2)))) | |
81 | (if finished? | |
82 | code | |
83 | (read-reply-code port)))) | |
84 | ||
85 | (mkdir #$output) | |
86 | (chdir #$output) | |
87 | ||
88 | (test-begin "opensmptd") | |
89 | ||
90 | (test-assert "service is running" | |
91 | (marionette-eval | |
92 | '(begin | |
93 | (use-modules (gnu services herd)) | |
c24b1547 | 94 | (start-service 'smtpd)) |
8b113790 LC |
95 | marionette)) |
96 | ||
97 | (test-assert "mbox is empty" | |
98 | (marionette-eval | |
99 | '(and (file-exists? "/var/mail") | |
100 | (not (file-exists? "/var/mail/root"))) | |
101 | marionette)) | |
102 | ||
103 | (test-eq "accept an email" | |
104 | #t | |
105 | (let* ((smtp (socket AF_INET SOCK_STREAM 0)) | |
106 | (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))) | |
107 | (connect smtp addr) | |
108 | ;; Be greeted. | |
109 | (read-reply-code smtp) ;220 | |
110 | ;; Greet the server. | |
111 | (write-line "EHLO somehost" smtp) | |
112 | (read-reply-code smtp) ;250 | |
113 | ;; Set sender email. | |
114 | (write-line "MAIL FROM: <someone>" smtp) | |
115 | (read-reply-code smtp) ;250 | |
116 | ;; Set recipient email. | |
117 | (write-line "RCPT TO: <root>" smtp) | |
118 | (read-reply-code smtp) ;250 | |
119 | ;; Send message. | |
120 | (write-line "DATA" smtp) | |
121 | (read-reply-code smtp) ;354 | |
122 | (write-line "Subject: Hello" smtp) | |
123 | (newline smtp) | |
124 | (write-line "Nice to meet you!" smtp) | |
125 | (write-line "." smtp) | |
126 | (read-reply-code smtp) ;250 | |
127 | ;; Say goodbye. | |
128 | (write-line "QUIT" smtp) | |
129 | (read-reply-code smtp) ;221 | |
130 | (close smtp) | |
131 | #t)) | |
132 | ||
133 | (test-assert "mail arrived" | |
134 | (marionette-eval | |
135 | '(begin | |
136 | (use-modules (ice-9 popen) | |
137 | (ice-9 rdelim)) | |
138 | ||
139 | (define (queue-empty?) | |
140 | (eof-object? | |
141 | (read-line | |
bf5929c5 TGR |
142 | (open-input-pipe |
143 | (string-append #$(file-append opensmtpd "/sbin/smtpctl") | |
144 | " show queue"))))) | |
8b113790 LC |
145 | |
146 | (let wait () | |
147 | (if (queue-empty?) | |
148 | (file-exists? "/var/mail/root") | |
149 | (begin (sleep 1) (wait))))) | |
150 | marionette)) | |
151 | ||
152 | (test-end) | |
153 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
154 | ||
155 | (gexp->derivation "opensmtpd-test" test)) | |
a82f0b36 SB |
156 | |
157 | (define %test-opensmtpd | |
158 | (system-test | |
159 | (name "opensmtpd") | |
160 | (description "Send an email to a running OpenSMTPD server.") | |
161 | (value (run-opensmtpd-test)))) | |
950026ac CZ |
162 | |
163 | ||
164 | (define %exim-os | |
165 | (simple-operating-system | |
39d7fdce | 166 | (service dhcp-client-service-type) |
950026ac CZ |
167 | (service mail-aliases-service-type '()) |
168 | (service exim-service-type | |
169 | (exim-configuration | |
170 | (config-file | |
171 | (plain-file "exim.conf" " | |
172 | primary_hostname = komputilo | |
173 | domainlist local_domains = @ | |
174 | domainlist relay_to_domains = | |
175 | hostlist relay_from_hosts = localhost | |
176 | ||
177 | never_users = | |
178 | ||
179 | acl_smtp_rcpt = acl_check_rcpt | |
180 | acl_smtp_data = acl_check_data | |
181 | ||
182 | begin acl | |
183 | ||
184 | acl_check_rcpt: | |
185 | accept | |
186 | acl_check_data: | |
187 | accept | |
188 | ")))))) | |
189 | ||
190 | (define (run-exim-test) | |
191 | "Return a test of an OS running an Exim service." | |
8b113790 LC |
192 | (define vm |
193 | (virtual-machine | |
194 | (operating-system (marionette-operating-system | |
195 | %exim-os | |
196 | #:imported-modules '((gnu services herd)))) | |
197 | (port-forwardings '((1025 . 25))))) | |
198 | ||
199 | (define test | |
200 | (with-imported-modules '((gnu build marionette) | |
201 | (ice-9 ftw)) | |
202 | #~(begin | |
203 | (use-modules (rnrs base) | |
204 | (srfi srfi-64) | |
205 | (ice-9 ftw) | |
206 | (ice-9 rdelim) | |
207 | (ice-9 regex) | |
208 | (gnu build marionette)) | |
209 | ||
210 | (define marionette | |
211 | (make-marionette '(#$vm))) | |
212 | ||
213 | (define (read-reply-code port) | |
214 | "Read a SMTP reply from PORT and return its reply code." | |
215 | (let* ((line (read-line port)) | |
216 | (mo (string-match "([0-9]+)([ -]).*" line)) | |
217 | (code (string->number (match:substring mo 1))) | |
218 | (finished? (string= " " (match:substring mo 2)))) | |
219 | (if finished? | |
220 | code | |
221 | (read-reply-code port)))) | |
222 | ||
223 | (define smtp (socket AF_INET SOCK_STREAM 0)) | |
224 | (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)) | |
225 | ||
226 | (mkdir #$output) | |
227 | (chdir #$output) | |
228 | ||
229 | (test-begin "exim") | |
230 | ||
231 | (test-assert "service is running" | |
232 | (marionette-eval | |
233 | '(begin | |
234 | (use-modules (gnu services herd)) | |
c24b1547 | 235 | (start-service 'exim)) |
8b113790 LC |
236 | marionette)) |
237 | ||
238 | (sleep 1) ;; give the service time to start talking | |
239 | ||
240 | (connect smtp addr) | |
241 | ;; Be greeted. | |
242 | (test-eq "greeting received" | |
243 | 220 (read-reply-code smtp)) | |
244 | ;; Greet the server. | |
245 | (write-line "EHLO somehost" smtp) | |
246 | (test-eq "greeting successful" | |
247 | 250 (read-reply-code smtp)) | |
248 | ;; Set sender email. | |
249 | (write-line "MAIL FROM: test@example.com" smtp) | |
250 | (test-eq "sender set" | |
251 | 250 (read-reply-code smtp)) ;250 | |
252 | ;; Set recipient email. | |
253 | (write-line "RCPT TO: root@komputilo" smtp) | |
254 | (test-eq "recipient set" | |
255 | 250 (read-reply-code smtp)) ;250 | |
256 | ;; Send message. | |
257 | (write-line "DATA" smtp) | |
258 | (test-eq "data begun" | |
259 | 354 (read-reply-code smtp)) ;354 | |
260 | (write-line "Subject: Hello" smtp) | |
261 | (newline smtp) | |
262 | (write-line "Nice to meet you!" smtp) | |
263 | (write-line "." smtp) | |
264 | (test-eq "message sent" | |
265 | 250 (read-reply-code smtp)) ;250 | |
266 | ;; Say goodbye. | |
267 | (write-line "QUIT" smtp) | |
268 | (test-eq "quit successful" | |
269 | 221 (read-reply-code smtp)) ;221 | |
270 | (close smtp) | |
271 | ||
272 | (test-eq "the email is received" | |
273 | 1 | |
274 | (marionette-eval | |
275 | '(begin | |
276 | (use-modules (ice-9 ftw)) | |
277 | (length (scandir "/var/spool/exim/msglog" | |
278 | (lambda (x) (not (string-prefix? "." x)))))) | |
279 | marionette)) | |
280 | ||
281 | (test-end) | |
282 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
283 | ||
284 | (gexp->derivation "exim-test" test)) | |
950026ac CZ |
285 | |
286 | (define %test-exim | |
287 | (system-test | |
288 | (name "exim") | |
289 | (description "Send an email to a running an Exim server.") | |
290 | (value (run-exim-test)))) | |
a9079b48 OP |
291 | |
292 | (define %dovecot-os | |
293 | (simple-operating-system | |
39d7fdce | 294 | (service dhcp-client-service-type) |
a9079b48 OP |
295 | (dovecot-service #:config |
296 | (dovecot-configuration | |
297 | (disable-plaintext-auth? #f) | |
298 | (ssl? "no") | |
299 | (auth-mechanisms '("anonymous")) | |
300 | (auth-anonymous-username "alice") | |
301 | (mail-location | |
302 | (string-append "maildir:~/Maildir" | |
303 | ":INBOX=~/Maildir/INBOX" | |
304 | ":LAYOUT=fs")))))) | |
305 | ||
306 | (define (run-dovecot-test) | |
307 | "Return a test of an OS running Dovecot service." | |
308 | (define vm | |
309 | (virtual-machine | |
310 | (operating-system (marionette-operating-system | |
311 | %dovecot-os | |
312 | #:imported-modules '((gnu services herd)))) | |
313 | (port-forwardings '((8143 . 143))))) | |
314 | ||
315 | (define test | |
316 | (with-imported-modules '((gnu build marionette)) | |
317 | #~(begin | |
318 | (use-modules (gnu build marionette) | |
319 | (ice-9 iconv) | |
320 | (ice-9 rdelim) | |
321 | (rnrs base) | |
322 | (rnrs bytevectors) | |
323 | (srfi srfi-64)) | |
324 | ||
325 | (define marionette | |
326 | (make-marionette '(#$vm))) | |
327 | ||
328 | (define* (message-length message #:key (encoding "iso-8859-1")) | |
329 | (bytevector-length (string->bytevector message encoding))) | |
330 | ||
331 | (define message "From: test@example.com\n\ | |
332 | Subject: Hello Nice to meet you!") | |
333 | ||
334 | (mkdir #$output) | |
335 | (chdir #$output) | |
336 | ||
337 | (test-begin "dovecot") | |
338 | ||
339 | ;; Wait for dovecot to be up and running. | |
c24b1547 | 340 | (test-assert "dovecot running" |
a9079b48 OP |
341 | (marionette-eval |
342 | '(begin | |
343 | (use-modules (gnu services herd)) | |
c24b1547 | 344 | (start-service 'dovecot)) |
a9079b48 OP |
345 | marionette)) |
346 | ||
347 | ;; Check Dovecot service's PID. | |
348 | (test-assert "service process id" | |
349 | (let ((pid | |
350 | (number->string (wait-for-file "/var/run/dovecot/master.pid" | |
351 | marionette)))) | |
352 | (marionette-eval `(file-exists? (string-append "/proc/" ,pid)) | |
353 | marionette))) | |
354 | ||
355 | (test-assert "accept an email" | |
356 | (let ((imap (socket AF_INET SOCK_STREAM 0)) | |
357 | (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143))) | |
358 | (connect imap addr) | |
359 | ;; Be greeted. | |
360 | (read-line imap) ;OK | |
361 | ;; Authenticate | |
362 | (write-line "a AUTHENTICATE ANONYMOUS" imap) | |
363 | (read-line imap) ;+ | |
364 | (write-line "c2lyaGM=" imap) | |
365 | (read-line imap) ;OK | |
366 | ;; Create a TESTBOX mailbox | |
367 | (write-line "a CREATE TESTBOX" imap) | |
368 | (read-line imap) ;OK | |
369 | ;; Append a message to a TESTBOX mailbox | |
370 | (write-line (format #f "a APPEND TESTBOX {~a}" | |
371 | (number->string (message-length message))) | |
372 | imap) | |
373 | (read-line imap) ;+ | |
374 | (write-line message imap) | |
375 | (read-line imap) ;OK | |
376 | ;; Logout | |
377 | (write-line "a LOGOUT" imap) | |
378 | (close imap) | |
379 | #t)) | |
380 | ||
381 | (test-equal "mail arrived" | |
382 | message | |
383 | (marionette-eval | |
384 | '(begin | |
385 | (use-modules (ice-9 ftw) | |
386 | (ice-9 match)) | |
387 | (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/")) | |
388 | (match (scandir TESTBOX/new) | |
389 | (("." ".." message-file) | |
390 | (call-with-input-file | |
391 | (string-append TESTBOX/new message-file) | |
392 | get-string-all))))) | |
393 | marionette)) | |
394 | ||
395 | (test-end) | |
396 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
397 | ||
398 | (gexp->derivation "dovecot-test" test)) | |
399 | ||
400 | (define %test-dovecot | |
401 | (system-test | |
402 | (name "dovecot") | |
403 | (description "Connect to a running Dovecot server.") | |
404 | (value (run-dovecot-test)))) | |
f6b0e1f8 CB |
405 | |
406 | (define %getmail-os | |
407 | (simple-operating-system | |
408 | (service dhcp-client-service-type) | |
409 | (service dovecot-service-type | |
410 | (dovecot-configuration | |
411 | (disable-plaintext-auth? #f) | |
412 | (ssl? "no") | |
413 | (auth-mechanisms '("anonymous" "plain")) | |
414 | (auth-anonymous-username "alice") | |
415 | (mail-location | |
416 | (string-append "maildir:~/Maildir" | |
417 | ":INBOX=~/Maildir/INBOX" | |
418 | ":LAYOUT=fs")))) | |
419 | (service getmail-service-type | |
420 | (list | |
421 | (getmail-configuration | |
422 | (name 'test) | |
423 | (user "alice") | |
424 | (directory "/var/lib/getmail/alice") | |
425 | (idle '("TESTBOX")) | |
426 | (rcfile | |
427 | (getmail-configuration-file | |
428 | (retriever | |
429 | (getmail-retriever-configuration | |
430 | (type "SimpleIMAPRetriever") | |
431 | (server "localhost") | |
432 | (username "alice") | |
433 | (port 143) | |
434 | (extra-parameters | |
435 | '((password . "testpass") | |
436 | (mailboxes . ("TESTBOX")))))) | |
437 | (destination | |
438 | (getmail-destination-configuration | |
439 | (type "Maildir") | |
440 | (path "/home/alice/TestMaildir/"))) | |
441 | (options | |
442 | (getmail-options-configuration | |
443 | (read-all #f)))))))))) | |
444 | ||
445 | (define (run-getmail-test) | |
446 | "Return a test of an OS running Getmail service." | |
447 | (define vm | |
448 | (virtual-machine | |
449 | (operating-system (marionette-operating-system | |
450 | %getmail-os | |
451 | #:imported-modules '((gnu services herd)))) | |
452 | (port-forwardings '((8143 . 143))))) | |
453 | ||
454 | (define test | |
455 | (with-imported-modules '((gnu build marionette)) | |
456 | #~(begin | |
457 | (use-modules (gnu build marionette) | |
458 | (ice-9 iconv) | |
459 | (ice-9 rdelim) | |
460 | (rnrs base) | |
461 | (rnrs bytevectors) | |
462 | (srfi srfi-64)) | |
463 | ||
464 | (define marionette | |
465 | (make-marionette '(#$vm))) | |
466 | ||
467 | (define* (message-length message #:key (encoding "iso-8859-1")) | |
468 | (bytevector-length (string->bytevector message encoding))) | |
469 | ||
470 | (define message "From: test@example.com\n\ | |
471 | Subject: Hello Nice to meet you!") | |
472 | ||
473 | (mkdir #$output) | |
474 | (chdir #$output) | |
475 | ||
476 | (test-begin "getmail") | |
477 | ||
478 | ;; Wait for dovecot to be up and running. | |
479 | (test-assert "dovecot running" | |
480 | (marionette-eval | |
481 | '(begin | |
482 | (use-modules (gnu services herd)) | |
483 | (start-service 'dovecot)) | |
484 | marionette)) | |
485 | ||
486 | (test-assert "set password for alice" | |
487 | (marionette-eval | |
488 | '(system "echo -e \"testpass\ntestpass\" | passwd alice") | |
489 | marionette)) | |
490 | ||
491 | ;; Wait for getmail to be up and running. | |
492 | (test-assert "getmail-test running" | |
493 | (marionette-eval | |
494 | '(let* ((pw (getpw "alice")) | |
495 | (uid (passwd:uid pw)) | |
496 | (gid (passwd:gid pw))) | |
497 | (use-modules (gnu services herd)) | |
498 | ||
499 | (for-each | |
500 | (lambda (dir) | |
501 | (mkdir dir) | |
502 | (chown dir uid gid)) | |
503 | '("/home/alice/TestMaildir" | |
504 | "/home/alice/TestMaildir/cur" | |
505 | "/home/alice/TestMaildir/new" | |
506 | "/home/alice/TestMaildir/tmp" | |
507 | "/home/alice/TestMaildir/TESTBOX" | |
508 | "/home/alice/TestMaildir/TESTBOX/cur" | |
509 | "/home/alice/TestMaildir/TESTBOX/new" | |
510 | "/home/alice/TestMaildir/TESTBOX/tmp")) | |
511 | ||
512 | (start-service 'getmail-test)) | |
513 | marionette)) | |
514 | ||
515 | ;; Check Dovecot service's PID. | |
516 | (test-assert "service process id" | |
517 | (let ((pid | |
518 | (number->string (wait-for-file "/var/run/dovecot/master.pid" | |
519 | marionette)))) | |
520 | (marionette-eval `(file-exists? (string-append "/proc/" ,pid)) | |
521 | marionette))) | |
522 | ||
523 | (test-assert "accept an email" | |
524 | (let ((imap (socket AF_INET SOCK_STREAM 0)) | |
525 | (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143))) | |
526 | (connect imap addr) | |
527 | ;; Be greeted. | |
528 | (read-line imap) ;OK | |
529 | ;; Authenticate | |
530 | (write-line "a AUTHENTICATE ANONYMOUS" imap) | |
531 | (read-line imap) ;+ | |
532 | (write-line "c2lyaGM=" imap) | |
533 | (read-line imap) ;OK | |
534 | ;; Create a TESTBOX mailbox | |
535 | (write-line "a CREATE TESTBOX" imap) | |
536 | (read-line imap) ;OK | |
537 | ;; Append a message to a TESTBOX mailbox | |
538 | (write-line (format #f "a APPEND TESTBOX {~a}" | |
539 | (number->string (message-length message))) | |
540 | imap) | |
541 | (read-line imap) ;+ | |
542 | (write-line message imap) | |
543 | (read-line imap) ;OK | |
544 | ;; Logout | |
545 | (write-line "a LOGOUT" imap) | |
546 | (close imap) | |
547 | #t)) | |
548 | ||
549 | (sleep 1) | |
550 | ||
551 | (test-assert "mail arrived" | |
552 | (string-contains | |
553 | (marionette-eval | |
554 | '(begin | |
555 | (use-modules (ice-9 ftw) | |
556 | (ice-9 match)) | |
557 | (let ((TESTBOX/new "/home/alice/TestMaildir/new/")) | |
558 | (match (scandir TESTBOX/new) | |
559 | (("." ".." message-file) | |
560 | (call-with-input-file | |
561 | (string-append TESTBOX/new message-file) | |
562 | get-string-all))))) | |
563 | marionette) | |
564 | message)) | |
565 | ||
566 | (test-end) | |
567 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
568 | ||
569 | (gexp->derivation "getmail-test" test)) | |
570 | ||
571 | (define %test-getmail | |
572 | (system-test | |
573 | (name "getmail") | |
574 | (description "Connect to a running Getmail server.") | |
575 | (value (run-getmail-test)))) |