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> |
a82f0b36 SB |
6 | ;;; |
7 | ;;; This file is part of GNU Guix. | |
8 | ;;; | |
9 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
10 | ;;; under the terms of the GNU General Public License as published by | |
11 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
12 | ;;; your option) any later version. | |
13 | ;;; | |
14 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
15 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;;; GNU General Public License for more details. | |
18 | ;;; | |
19 | ;;; You should have received a copy of the GNU General Public License | |
20 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | (define-module (gnu tests mail) | |
23 | #:use-module (gnu tests) | |
24 | #:use-module (gnu system) | |
a82f0b36 SB |
25 | #:use-module (gnu system vm) |
26 | #:use-module (gnu services) | |
a82f0b36 SB |
27 | #:use-module (gnu services mail) |
28 | #:use-module (gnu services networking) | |
29 | #:use-module (guix gexp) | |
a82f0b36 | 30 | #:use-module (guix store) |
950026ac CZ |
31 | #:use-module (ice-9 ftw) |
32 | #:export (%test-opensmtpd | |
a9079b48 OP |
33 | %test-exim |
34 | %test-dovecot)) | |
a82f0b36 SB |
35 | |
36 | (define %opensmtpd-os | |
892d9089 LC |
37 | (simple-operating-system |
38 | (dhcp-client-service) | |
39 | (service opensmtpd-service-type | |
40 | (opensmtpd-configuration | |
41 | (config-file | |
42 | (plain-file "smtpd.conf" " | |
a82f0b36 SB |
43 | listen on 0.0.0.0 |
44 | accept from any for local deliver to mbox | |
892d9089 | 45 | ")))))) |
a82f0b36 SB |
46 | |
47 | (define (run-opensmtpd-test) | |
48 | "Return a test of an OS running OpenSMTPD service." | |
8b113790 LC |
49 | (define vm |
50 | (virtual-machine | |
51 | (operating-system (marionette-operating-system | |
52 | %opensmtpd-os | |
53 | #:imported-modules '((gnu services herd)))) | |
54 | (port-forwardings '((1025 . 25))))) | |
55 | ||
56 | (define test | |
57 | (with-imported-modules '((gnu build marionette)) | |
58 | #~(begin | |
59 | (use-modules (rnrs base) | |
60 | (srfi srfi-64) | |
61 | (ice-9 rdelim) | |
62 | (ice-9 regex) | |
63 | (gnu build marionette)) | |
64 | ||
65 | (define marionette | |
66 | (make-marionette '(#$vm))) | |
67 | ||
68 | (define (read-reply-code port) | |
69 | "Read a SMTP reply from PORT and return its reply code." | |
70 | (let* ((line (read-line port)) | |
71 | (mo (string-match "([0-9]+)([ -]).*" line)) | |
72 | (code (string->number (match:substring mo 1))) | |
73 | (finished? (string= " " (match:substring mo 2)))) | |
74 | (if finished? | |
75 | code | |
76 | (read-reply-code port)))) | |
77 | ||
78 | (mkdir #$output) | |
79 | (chdir #$output) | |
80 | ||
81 | (test-begin "opensmptd") | |
82 | ||
83 | (test-assert "service is running" | |
84 | (marionette-eval | |
85 | '(begin | |
86 | (use-modules (gnu services herd)) | |
87 | (start-service 'smtpd) | |
88 | #t) | |
89 | marionette)) | |
90 | ||
91 | (test-assert "mbox is empty" | |
92 | (marionette-eval | |
93 | '(and (file-exists? "/var/mail") | |
94 | (not (file-exists? "/var/mail/root"))) | |
95 | marionette)) | |
96 | ||
97 | (test-eq "accept an email" | |
98 | #t | |
99 | (let* ((smtp (socket AF_INET SOCK_STREAM 0)) | |
100 | (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))) | |
101 | (connect smtp addr) | |
102 | ;; Be greeted. | |
103 | (read-reply-code smtp) ;220 | |
104 | ;; Greet the server. | |
105 | (write-line "EHLO somehost" smtp) | |
106 | (read-reply-code smtp) ;250 | |
107 | ;; Set sender email. | |
108 | (write-line "MAIL FROM: <someone>" smtp) | |
109 | (read-reply-code smtp) ;250 | |
110 | ;; Set recipient email. | |
111 | (write-line "RCPT TO: <root>" smtp) | |
112 | (read-reply-code smtp) ;250 | |
113 | ;; Send message. | |
114 | (write-line "DATA" smtp) | |
115 | (read-reply-code smtp) ;354 | |
116 | (write-line "Subject: Hello" smtp) | |
117 | (newline smtp) | |
118 | (write-line "Nice to meet you!" smtp) | |
119 | (write-line "." smtp) | |
120 | (read-reply-code smtp) ;250 | |
121 | ;; Say goodbye. | |
122 | (write-line "QUIT" smtp) | |
123 | (read-reply-code smtp) ;221 | |
124 | (close smtp) | |
125 | #t)) | |
126 | ||
127 | (test-assert "mail arrived" | |
128 | (marionette-eval | |
129 | '(begin | |
130 | (use-modules (ice-9 popen) | |
131 | (ice-9 rdelim)) | |
132 | ||
133 | (define (queue-empty?) | |
134 | (eof-object? | |
135 | (read-line | |
136 | (open-input-pipe "smtpctl show queue")))) | |
137 | ||
138 | (let wait () | |
139 | (if (queue-empty?) | |
140 | (file-exists? "/var/mail/root") | |
141 | (begin (sleep 1) (wait))))) | |
142 | marionette)) | |
143 | ||
144 | (test-end) | |
145 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
146 | ||
147 | (gexp->derivation "opensmtpd-test" test)) | |
a82f0b36 SB |
148 | |
149 | (define %test-opensmtpd | |
150 | (system-test | |
151 | (name "opensmtpd") | |
152 | (description "Send an email to a running OpenSMTPD server.") | |
153 | (value (run-opensmtpd-test)))) | |
950026ac CZ |
154 | |
155 | ||
156 | (define %exim-os | |
157 | (simple-operating-system | |
158 | (dhcp-client-service) | |
159 | (service mail-aliases-service-type '()) | |
160 | (service exim-service-type | |
161 | (exim-configuration | |
162 | (config-file | |
163 | (plain-file "exim.conf" " | |
164 | primary_hostname = komputilo | |
165 | domainlist local_domains = @ | |
166 | domainlist relay_to_domains = | |
167 | hostlist relay_from_hosts = localhost | |
168 | ||
169 | never_users = | |
170 | ||
171 | acl_smtp_rcpt = acl_check_rcpt | |
172 | acl_smtp_data = acl_check_data | |
173 | ||
174 | begin acl | |
175 | ||
176 | acl_check_rcpt: | |
177 | accept | |
178 | acl_check_data: | |
179 | accept | |
180 | ")))))) | |
181 | ||
182 | (define (run-exim-test) | |
183 | "Return a test of an OS running an Exim service." | |
8b113790 LC |
184 | (define vm |
185 | (virtual-machine | |
186 | (operating-system (marionette-operating-system | |
187 | %exim-os | |
188 | #:imported-modules '((gnu services herd)))) | |
189 | (port-forwardings '((1025 . 25))))) | |
190 | ||
191 | (define test | |
192 | (with-imported-modules '((gnu build marionette) | |
193 | (ice-9 ftw)) | |
194 | #~(begin | |
195 | (use-modules (rnrs base) | |
196 | (srfi srfi-64) | |
197 | (ice-9 ftw) | |
198 | (ice-9 rdelim) | |
199 | (ice-9 regex) | |
200 | (gnu build marionette)) | |
201 | ||
202 | (define marionette | |
203 | (make-marionette '(#$vm))) | |
204 | ||
205 | (define (read-reply-code port) | |
206 | "Read a SMTP reply from PORT and return its reply code." | |
207 | (let* ((line (read-line port)) | |
208 | (mo (string-match "([0-9]+)([ -]).*" line)) | |
209 | (code (string->number (match:substring mo 1))) | |
210 | (finished? (string= " " (match:substring mo 2)))) | |
211 | (if finished? | |
212 | code | |
213 | (read-reply-code port)))) | |
214 | ||
215 | (define smtp (socket AF_INET SOCK_STREAM 0)) | |
216 | (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)) | |
217 | ||
218 | (mkdir #$output) | |
219 | (chdir #$output) | |
220 | ||
221 | (test-begin "exim") | |
222 | ||
223 | (test-assert "service is running" | |
224 | (marionette-eval | |
225 | '(begin | |
226 | (use-modules (gnu services herd)) | |
227 | (start-service 'exim) | |
228 | #t) | |
229 | marionette)) | |
230 | ||
231 | (sleep 1) ;; give the service time to start talking | |
232 | ||
233 | (connect smtp addr) | |
234 | ;; Be greeted. | |
235 | (test-eq "greeting received" | |
236 | 220 (read-reply-code smtp)) | |
237 | ;; Greet the server. | |
238 | (write-line "EHLO somehost" smtp) | |
239 | (test-eq "greeting successful" | |
240 | 250 (read-reply-code smtp)) | |
241 | ;; Set sender email. | |
242 | (write-line "MAIL FROM: test@example.com" smtp) | |
243 | (test-eq "sender set" | |
244 | 250 (read-reply-code smtp)) ;250 | |
245 | ;; Set recipient email. | |
246 | (write-line "RCPT TO: root@komputilo" smtp) | |
247 | (test-eq "recipient set" | |
248 | 250 (read-reply-code smtp)) ;250 | |
249 | ;; Send message. | |
250 | (write-line "DATA" smtp) | |
251 | (test-eq "data begun" | |
252 | 354 (read-reply-code smtp)) ;354 | |
253 | (write-line "Subject: Hello" smtp) | |
254 | (newline smtp) | |
255 | (write-line "Nice to meet you!" smtp) | |
256 | (write-line "." smtp) | |
257 | (test-eq "message sent" | |
258 | 250 (read-reply-code smtp)) ;250 | |
259 | ;; Say goodbye. | |
260 | (write-line "QUIT" smtp) | |
261 | (test-eq "quit successful" | |
262 | 221 (read-reply-code smtp)) ;221 | |
263 | (close smtp) | |
264 | ||
265 | (test-eq "the email is received" | |
266 | 1 | |
267 | (marionette-eval | |
268 | '(begin | |
269 | (use-modules (ice-9 ftw)) | |
270 | (length (scandir "/var/spool/exim/msglog" | |
271 | (lambda (x) (not (string-prefix? "." x)))))) | |
272 | marionette)) | |
273 | ||
274 | (test-end) | |
275 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
276 | ||
277 | (gexp->derivation "exim-test" test)) | |
950026ac CZ |
278 | |
279 | (define %test-exim | |
280 | (system-test | |
281 | (name "exim") | |
282 | (description "Send an email to a running an Exim server.") | |
283 | (value (run-exim-test)))) | |
a9079b48 OP |
284 | |
285 | (define %dovecot-os | |
286 | (simple-operating-system | |
287 | (dhcp-client-service) | |
288 | (dovecot-service #:config | |
289 | (dovecot-configuration | |
290 | (disable-plaintext-auth? #f) | |
291 | (ssl? "no") | |
292 | (auth-mechanisms '("anonymous")) | |
293 | (auth-anonymous-username "alice") | |
294 | (mail-location | |
295 | (string-append "maildir:~/Maildir" | |
296 | ":INBOX=~/Maildir/INBOX" | |
297 | ":LAYOUT=fs")))))) | |
298 | ||
299 | (define (run-dovecot-test) | |
300 | "Return a test of an OS running Dovecot service." | |
301 | (define vm | |
302 | (virtual-machine | |
303 | (operating-system (marionette-operating-system | |
304 | %dovecot-os | |
305 | #:imported-modules '((gnu services herd)))) | |
306 | (port-forwardings '((8143 . 143))))) | |
307 | ||
308 | (define test | |
309 | (with-imported-modules '((gnu build marionette)) | |
310 | #~(begin | |
311 | (use-modules (gnu build marionette) | |
312 | (ice-9 iconv) | |
313 | (ice-9 rdelim) | |
314 | (rnrs base) | |
315 | (rnrs bytevectors) | |
316 | (srfi srfi-64)) | |
317 | ||
318 | (define marionette | |
319 | (make-marionette '(#$vm))) | |
320 | ||
321 | (define* (message-length message #:key (encoding "iso-8859-1")) | |
322 | (bytevector-length (string->bytevector message encoding))) | |
323 | ||
324 | (define message "From: test@example.com\n\ | |
325 | Subject: Hello Nice to meet you!") | |
326 | ||
327 | (mkdir #$output) | |
328 | (chdir #$output) | |
329 | ||
330 | (test-begin "dovecot") | |
331 | ||
332 | ;; Wait for dovecot to be up and running. | |
333 | (test-eq "dovecot running" | |
334 | 'running! | |
335 | (marionette-eval | |
336 | '(begin | |
337 | (use-modules (gnu services herd)) | |
338 | (start-service 'dovecot) | |
339 | 'running!) | |
340 | marionette)) | |
341 | ||
342 | ;; Check Dovecot service's PID. | |
343 | (test-assert "service process id" | |
344 | (let ((pid | |
345 | (number->string (wait-for-file "/var/run/dovecot/master.pid" | |
346 | marionette)))) | |
347 | (marionette-eval `(file-exists? (string-append "/proc/" ,pid)) | |
348 | marionette))) | |
349 | ||
350 | (test-assert "accept an email" | |
351 | (let ((imap (socket AF_INET SOCK_STREAM 0)) | |
352 | (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143))) | |
353 | (connect imap addr) | |
354 | ;; Be greeted. | |
355 | (read-line imap) ;OK | |
356 | ;; Authenticate | |
357 | (write-line "a AUTHENTICATE ANONYMOUS" imap) | |
358 | (read-line imap) ;+ | |
359 | (write-line "c2lyaGM=" imap) | |
360 | (read-line imap) ;OK | |
361 | ;; Create a TESTBOX mailbox | |
362 | (write-line "a CREATE TESTBOX" imap) | |
363 | (read-line imap) ;OK | |
364 | ;; Append a message to a TESTBOX mailbox | |
365 | (write-line (format #f "a APPEND TESTBOX {~a}" | |
366 | (number->string (message-length message))) | |
367 | imap) | |
368 | (read-line imap) ;+ | |
369 | (write-line message imap) | |
370 | (read-line imap) ;OK | |
371 | ;; Logout | |
372 | (write-line "a LOGOUT" imap) | |
373 | (close imap) | |
374 | #t)) | |
375 | ||
376 | (test-equal "mail arrived" | |
377 | message | |
378 | (marionette-eval | |
379 | '(begin | |
380 | (use-modules (ice-9 ftw) | |
381 | (ice-9 match)) | |
382 | (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/")) | |
383 | (match (scandir TESTBOX/new) | |
384 | (("." ".." message-file) | |
385 | (call-with-input-file | |
386 | (string-append TESTBOX/new message-file) | |
387 | get-string-all))))) | |
388 | marionette)) | |
389 | ||
390 | (test-end) | |
391 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
392 | ||
393 | (gexp->derivation "dovecot-test" test)) | |
394 | ||
395 | (define %test-dovecot | |
396 | (system-test | |
397 | (name "dovecot") | |
398 | (description "Connect to a running Dovecot server.") | |
399 | (value (run-dovecot-test)))) |