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> |
a82f0b36 SB |
7 | ;;; |
8 | ;;; This file is part of GNU Guix. | |
9 | ;;; | |
10 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
11 | ;;; under the terms of the GNU General Public License as published by | |
12 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
13 | ;;; your option) any later version. | |
14 | ;;; | |
15 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
16 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;;; GNU General Public License for more details. | |
19 | ;;; | |
20 | ;;; You should have received a copy of the GNU General Public License | |
21 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | (define-module (gnu tests mail) | |
24 | #:use-module (gnu tests) | |
25 | #:use-module (gnu system) | |
a82f0b36 SB |
26 | #:use-module (gnu system vm) |
27 | #:use-module (gnu services) | |
a82f0b36 SB |
28 | #:use-module (gnu services mail) |
29 | #:use-module (gnu services networking) | |
30 | #:use-module (guix gexp) | |
a82f0b36 | 31 | #:use-module (guix store) |
950026ac CZ |
32 | #:use-module (ice-9 ftw) |
33 | #:export (%test-opensmtpd | |
a9079b48 OP |
34 | %test-exim |
35 | %test-dovecot)) | |
a82f0b36 SB |
36 | |
37 | (define %opensmtpd-os | |
892d9089 LC |
38 | (simple-operating-system |
39 | (dhcp-client-service) | |
40 | (service opensmtpd-service-type | |
41 | (opensmtpd-configuration | |
42 | (config-file | |
43 | (plain-file "smtpd.conf" " | |
a82f0b36 SB |
44 | listen on 0.0.0.0 |
45 | accept from any for local deliver to mbox | |
892d9089 | 46 | ")))))) |
a82f0b36 SB |
47 | |
48 | (define (run-opensmtpd-test) | |
49 | "Return a test of an OS running OpenSMTPD service." | |
8b113790 LC |
50 | (define vm |
51 | (virtual-machine | |
52 | (operating-system (marionette-operating-system | |
53 | %opensmtpd-os | |
54 | #:imported-modules '((gnu services herd)))) | |
55 | (port-forwardings '((1025 . 25))))) | |
56 | ||
57 | (define test | |
58 | (with-imported-modules '((gnu build marionette)) | |
59 | #~(begin | |
60 | (use-modules (rnrs base) | |
61 | (srfi srfi-64) | |
62 | (ice-9 rdelim) | |
63 | (ice-9 regex) | |
64 | (gnu build marionette)) | |
65 | ||
66 | (define marionette | |
67 | (make-marionette '(#$vm))) | |
68 | ||
69 | (define (read-reply-code port) | |
70 | "Read a SMTP reply from PORT and return its reply code." | |
71 | (let* ((line (read-line port)) | |
72 | (mo (string-match "([0-9]+)([ -]).*" line)) | |
73 | (code (string->number (match:substring mo 1))) | |
74 | (finished? (string= " " (match:substring mo 2)))) | |
75 | (if finished? | |
76 | code | |
77 | (read-reply-code port)))) | |
78 | ||
79 | (mkdir #$output) | |
80 | (chdir #$output) | |
81 | ||
82 | (test-begin "opensmptd") | |
83 | ||
84 | (test-assert "service is running" | |
85 | (marionette-eval | |
86 | '(begin | |
87 | (use-modules (gnu services herd)) | |
c24b1547 | 88 | (start-service 'smtpd)) |
8b113790 LC |
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)) | |
c24b1547 | 227 | (start-service 'exim)) |
8b113790 LC |
228 | marionette)) |
229 | ||
230 | (sleep 1) ;; give the service time to start talking | |
231 | ||
232 | (connect smtp addr) | |
233 | ;; Be greeted. | |
234 | (test-eq "greeting received" | |
235 | 220 (read-reply-code smtp)) | |
236 | ;; Greet the server. | |
237 | (write-line "EHLO somehost" smtp) | |
238 | (test-eq "greeting successful" | |
239 | 250 (read-reply-code smtp)) | |
240 | ;; Set sender email. | |
241 | (write-line "MAIL FROM: test@example.com" smtp) | |
242 | (test-eq "sender set" | |
243 | 250 (read-reply-code smtp)) ;250 | |
244 | ;; Set recipient email. | |
245 | (write-line "RCPT TO: root@komputilo" smtp) | |
246 | (test-eq "recipient set" | |
247 | 250 (read-reply-code smtp)) ;250 | |
248 | ;; Send message. | |
249 | (write-line "DATA" smtp) | |
250 | (test-eq "data begun" | |
251 | 354 (read-reply-code smtp)) ;354 | |
252 | (write-line "Subject: Hello" smtp) | |
253 | (newline smtp) | |
254 | (write-line "Nice to meet you!" smtp) | |
255 | (write-line "." smtp) | |
256 | (test-eq "message sent" | |
257 | 250 (read-reply-code smtp)) ;250 | |
258 | ;; Say goodbye. | |
259 | (write-line "QUIT" smtp) | |
260 | (test-eq "quit successful" | |
261 | 221 (read-reply-code smtp)) ;221 | |
262 | (close smtp) | |
263 | ||
264 | (test-eq "the email is received" | |
265 | 1 | |
266 | (marionette-eval | |
267 | '(begin | |
268 | (use-modules (ice-9 ftw)) | |
269 | (length (scandir "/var/spool/exim/msglog" | |
270 | (lambda (x) (not (string-prefix? "." x)))))) | |
271 | marionette)) | |
272 | ||
273 | (test-end) | |
274 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
275 | ||
276 | (gexp->derivation "exim-test" test)) | |
950026ac CZ |
277 | |
278 | (define %test-exim | |
279 | (system-test | |
280 | (name "exim") | |
281 | (description "Send an email to a running an Exim server.") | |
282 | (value (run-exim-test)))) | |
a9079b48 OP |
283 | |
284 | (define %dovecot-os | |
285 | (simple-operating-system | |
286 | (dhcp-client-service) | |
287 | (dovecot-service #:config | |
288 | (dovecot-configuration | |
289 | (disable-plaintext-auth? #f) | |
290 | (ssl? "no") | |
291 | (auth-mechanisms '("anonymous")) | |
292 | (auth-anonymous-username "alice") | |
293 | (mail-location | |
294 | (string-append "maildir:~/Maildir" | |
295 | ":INBOX=~/Maildir/INBOX" | |
296 | ":LAYOUT=fs")))))) | |
297 | ||
298 | (define (run-dovecot-test) | |
299 | "Return a test of an OS running Dovecot service." | |
300 | (define vm | |
301 | (virtual-machine | |
302 | (operating-system (marionette-operating-system | |
303 | %dovecot-os | |
304 | #:imported-modules '((gnu services herd)))) | |
305 | (port-forwardings '((8143 . 143))))) | |
306 | ||
307 | (define test | |
308 | (with-imported-modules '((gnu build marionette)) | |
309 | #~(begin | |
310 | (use-modules (gnu build marionette) | |
311 | (ice-9 iconv) | |
312 | (ice-9 rdelim) | |
313 | (rnrs base) | |
314 | (rnrs bytevectors) | |
315 | (srfi srfi-64)) | |
316 | ||
317 | (define marionette | |
318 | (make-marionette '(#$vm))) | |
319 | ||
320 | (define* (message-length message #:key (encoding "iso-8859-1")) | |
321 | (bytevector-length (string->bytevector message encoding))) | |
322 | ||
323 | (define message "From: test@example.com\n\ | |
324 | Subject: Hello Nice to meet you!") | |
325 | ||
326 | (mkdir #$output) | |
327 | (chdir #$output) | |
328 | ||
329 | (test-begin "dovecot") | |
330 | ||
331 | ;; Wait for dovecot to be up and running. | |
c24b1547 | 332 | (test-assert "dovecot running" |
a9079b48 OP |
333 | (marionette-eval |
334 | '(begin | |
335 | (use-modules (gnu services herd)) | |
c24b1547 | 336 | (start-service 'dovecot)) |
a9079b48 OP |
337 | marionette)) |
338 | ||
339 | ;; Check Dovecot service's PID. | |
340 | (test-assert "service process id" | |
341 | (let ((pid | |
342 | (number->string (wait-for-file "/var/run/dovecot/master.pid" | |
343 | marionette)))) | |
344 | (marionette-eval `(file-exists? (string-append "/proc/" ,pid)) | |
345 | marionette))) | |
346 | ||
347 | (test-assert "accept an email" | |
348 | (let ((imap (socket AF_INET SOCK_STREAM 0)) | |
349 | (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143))) | |
350 | (connect imap addr) | |
351 | ;; Be greeted. | |
352 | (read-line imap) ;OK | |
353 | ;; Authenticate | |
354 | (write-line "a AUTHENTICATE ANONYMOUS" imap) | |
355 | (read-line imap) ;+ | |
356 | (write-line "c2lyaGM=" imap) | |
357 | (read-line imap) ;OK | |
358 | ;; Create a TESTBOX mailbox | |
359 | (write-line "a CREATE TESTBOX" imap) | |
360 | (read-line imap) ;OK | |
361 | ;; Append a message to a TESTBOX mailbox | |
362 | (write-line (format #f "a APPEND TESTBOX {~a}" | |
363 | (number->string (message-length message))) | |
364 | imap) | |
365 | (read-line imap) ;+ | |
366 | (write-line message imap) | |
367 | (read-line imap) ;OK | |
368 | ;; Logout | |
369 | (write-line "a LOGOUT" imap) | |
370 | (close imap) | |
371 | #t)) | |
372 | ||
373 | (test-equal "mail arrived" | |
374 | message | |
375 | (marionette-eval | |
376 | '(begin | |
377 | (use-modules (ice-9 ftw) | |
378 | (ice-9 match)) | |
379 | (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/")) | |
380 | (match (scandir TESTBOX/new) | |
381 | (("." ".." message-file) | |
382 | (call-with-input-file | |
383 | (string-append TESTBOX/new message-file) | |
384 | get-string-all))))) | |
385 | marionette)) | |
386 | ||
387 | (test-end) | |
388 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | |
389 | ||
390 | (gexp->derivation "dovecot-test" test)) | |
391 | ||
392 | (define %test-dovecot | |
393 | (system-test | |
394 | (name "dovecot") | |
395 | (description "Connect to a running Dovecot server.") | |
396 | (value (run-dovecot-test)))) |