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