projects/guix·blob python-team · refs

817 lines · 28.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016 Sou Bunnbu <[email protected]>
3;;; Copyright © 2017 Carlo Zancanaro <[email protected]>
4;;; Copyright © 2017, 2020, 2021 Ludovic Courtès <[email protected]>
5;;; Copyright © 2018 Oleg Pykhalov <[email protected]>
6;;; Copyright © 2018 Clément Lassieur <[email protected]>
7;;; Copyright © 2019 Christopher Baines <[email protected]>
8;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <[email protected]>
9;;; Copyright © 2023 Thomas Ieong <[email protected]>
10;;;
11;;; This file is part of GNU Guix.
12;;;
13;;; GNU Guix is free software; you can redistribute it and/or modify it
14;;; under the terms of the GNU General Public License as published by
15;;; the Free Software Foundation; either version 3 of the License, or (at
16;;; your option) any later version.
17;;;
18;;; GNU Guix is distributed in the hope that it will be useful, but
19;;; WITHOUT ANY WARRANTY; without even the implied warranty of
20;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;;; GNU General Public License for more details.
22;;;
23;;; You should have received a copy of the GNU General Public License
24;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
25
26(define-module (gnu tests mail)
27 #:use-module (gnu tests)
28 #:use-module (gnu packages mail)
29 #:use-module (gnu system)
30 #:use-module (gnu system accounts)
31 #:use-module (gnu system shadow)
32 #:use-module (gnu system vm)
33 #:use-module (gnu services)
34 #:use-module (gnu services base)
35 #:use-module (gnu services getmail)
36 #:use-module (gnu services mail)
37 #:use-module (gnu services networking)
38 #:use-module (guix gexp)
39 #:use-module (guix store)
40 #:use-module (ice-9 ftw)
41 #:export (%test-opensmtpd
42 %test-exim
43 %test-dovecot
44 %test-getmail
45 %test-rspamd
46
47 %test-radicale
48 %test-radicale-htpasswd-bcrypt))
49
50(define %qemu-static-networking-no-nameserver
51 ;; Networking configuration for QEMU without nameserver.
52 (static-networking
53 (addresses (list (network-address
54 (device "eth0")
55 (value "10.0.2.15/24"))))
56 (routes (list (network-route
57 (destination "default")
58 (gateway "10.0.2.2"))))
59 (requirement '())
60 (provision '(networking))
61 (name-servers '())))
62
63(define %opensmtpd-os
64 (simple-operating-system
65 (service static-networking-service-type
66 (list %qemu-static-networking-no-nameserver))
67 (service opensmtpd-service-type
68 (opensmtpd-configuration
69 (config-file
70 (plain-file "smtpd.conf" "
71listen on 0.0.0.0
72action inbound mbox
73match from any for local action inbound
74"))))))
75
76(define (run-opensmtpd-test)
77 "Return a test of an OS running OpenSMTPD service."
78 (define vm
79 (virtual-machine
80 (operating-system (marionette-operating-system
81 %opensmtpd-os
82 #:imported-modules '((gnu services herd))))
83 (port-forwardings '((1025 . 25)))))
84
85 (define test
86 (with-imported-modules '((gnu build marionette))
87 #~(begin
88 (use-modules (rnrs base)
89 (srfi srfi-64)
90 (ice-9 rdelim)
91 (ice-9 regex)
92 (gnu build marionette))
93
94 (define marionette
95 (make-marionette '(#$vm)))
96
97 (define (read-reply-code port)
98 "Read a SMTP reply from PORT and return its reply code."
99 (let* ((line (read-line port))
100 (mo (string-match "([0-9]+)([ -]).*" line))
101 (code (string->number (match:substring mo 1)))
102 (finished? (string= " " (match:substring mo 2))))
103 (if finished?
104 code
105 (read-reply-code port))))
106
107 (test-runner-current (system-test-runner #$output))
108 (test-begin "opensmptd")
109
110 (test-assert "service is running"
111 (marionette-eval
112 '(begin
113 (use-modules (gnu services herd))
114 (start-service 'smtpd))
115 marionette))
116
117 (test-assert "mbox is empty"
118 (marionette-eval
119 '(and (file-exists? "/var/mail")
120 (not (file-exists? "/var/mail/root")))
121 marionette))
122
123 (test-eq "accept an email"
124 #t
125 (let* ((smtp (socket AF_INET SOCK_STREAM 0))
126 (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
127 (connect smtp addr)
128 ;; Be greeted.
129 (read-reply-code smtp) ;220
130 ;; Greet the server.
131 (write-line "EHLO somehost" smtp)
132 (read-reply-code smtp) ;250
133 ;; Set sender email.
134 (write-line "MAIL FROM: <someone>" smtp)
135 (read-reply-code smtp) ;250
136 ;; Set recipient email.
137 (write-line "RCPT TO: <root>" smtp)
138 (read-reply-code smtp) ;250
139 ;; Send message.
140 (write-line "DATA" smtp)
141 (read-reply-code smtp) ;354
142 (write-line "Subject: Hello" smtp)
143 (newline smtp)
144 (write-line "Nice to meet you!" smtp)
145 (write-line "." smtp)
146 (read-reply-code smtp) ;250
147 ;; Say goodbye.
148 (write-line "QUIT" smtp)
149 (read-reply-code smtp) ;221
150 (close smtp)
151 #t))
152
153 (test-assert "mail arrived"
154 (marionette-eval
155 '(begin
156 (use-modules (ice-9 popen)
157 (ice-9 rdelim))
158
159 (define (queue-empty?)
160 (let* ((pipe (open-pipe* OPEN_READ
161 #$(file-append opensmtpd
162 "/sbin/smtpctl")
163 "show" "queue"))
164 (line (read-line pipe)))
165 (close-pipe pipe)
166 (eof-object? line)))
167
168 (let wait ((n 20))
169 (cond ((queue-empty?)
170 (file-exists? "/var/mail/root"))
171 ((zero? n)
172 (error "root mailbox didn't show up"))
173 (else
174 (sleep 1) (wait (- n 1))))))
175 marionette))
176
177 (test-end))))
178
179 (gexp->derivation "opensmtpd-test" test))
180
181(define %test-opensmtpd
182 (system-test
183 (name "opensmtpd")
184 (description "Send an email to a running OpenSMTPD server.")
185 (value (run-opensmtpd-test))))
186
187
188(define %exim-os
189 (simple-operating-system
190 (service dhcpcd-service-type)
191 (service mail-aliases-service-type '())
192 (service exim-service-type
193 (exim-configuration
194 (config-file
195 (plain-file "exim.conf" "
196primary_hostname = komputilo
197domainlist local_domains = @
198domainlist relay_to_domains =
199hostlist relay_from_hosts = localhost
200
201never_users =
202
203acl_smtp_rcpt = acl_check_rcpt
204acl_smtp_data = acl_check_data
205
206begin acl
207
208acl_check_rcpt:
209 accept
210acl_check_data:
211 accept
212"))))))
213
214(define (run-exim-test)
215 "Return a test of an OS running an Exim service."
216 (define vm
217 (virtual-machine
218 (operating-system (marionette-operating-system
219 %exim-os
220 #:imported-modules '((gnu services herd))))
221 (port-forwardings '((1025 . 25)))))
222
223 (define test
224 (with-imported-modules '((gnu build marionette))
225 #~(begin
226 (use-modules (rnrs base)
227 (srfi srfi-64)
228 (ice-9 ftw)
229 (ice-9 rdelim)
230 (ice-9 regex)
231 (gnu build marionette))
232
233 (define marionette
234 (make-marionette '(#$vm)))
235
236 (define (read-reply-code port)
237 "Read a SMTP reply from PORT and return its reply code."
238 (let* ((line (read-line port))
239 (mo (string-match "([0-9]+)([ -]).*" line))
240 (code (string->number (match:substring mo 1)))
241 (finished? (string= " " (match:substring mo 2))))
242 (if finished?
243 code
244 (read-reply-code port))))
245
246 (define smtp (socket AF_INET SOCK_STREAM 0))
247 (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
248
249 (test-runner-current (system-test-runner #$output))
250 (test-begin "exim")
251
252 (test-assert "service is running"
253 (marionette-eval
254 '(begin
255 (use-modules (gnu services herd))
256 (start-service 'exim))
257 marionette))
258
259 (sleep 1) ;; give the service time to start talking
260
261 (connect smtp addr)
262 ;; Be greeted.
263 (test-eq "greeting received"
264 220 (read-reply-code smtp))
265 ;; Greet the server.
266 (write-line "EHLO somehost" smtp)
267 (test-eq "greeting successful"
268 250 (read-reply-code smtp))
269 ;; Set sender email.
270 (write-line "MAIL FROM: [email protected]" smtp)
271 (test-eq "sender set"
272 250 (read-reply-code smtp)) ;250
273 ;; Set recipient email.
274 (write-line "RCPT TO: root@komputilo" smtp)
275 (test-eq "recipient set"
276 250 (read-reply-code smtp)) ;250
277 ;; Send message.
278 (write-line "DATA" smtp)
279 (test-eq "data begun"
280 354 (read-reply-code smtp)) ;354
281 (write-line "Subject: Hello" smtp)
282 (newline smtp)
283 (write-line "Nice to meet you!" smtp)
284 (write-line "." smtp)
285 (test-eq "message sent"
286 250 (read-reply-code smtp)) ;250
287 ;; Say goodbye.
288 (write-line "QUIT" smtp)
289 (test-eq "quit successful"
290 221 (read-reply-code smtp)) ;221
291 (close smtp)
292
293 (test-eq "the email is received"
294 1
295 (marionette-eval
296 '(begin
297 (use-modules (ice-9 ftw))
298 (length (scandir "/var/spool/exim/msglog"
299 (lambda (x) (not (string-prefix? "." x))))))
300 marionette))
301
302 (test-end))))
303
304 (gexp->derivation "exim-test" test))
305
306(define %test-exim
307 (system-test
308 (name "exim")
309 (description "Send an email to a running an Exim server.")
310 (value (run-exim-test))))
311
312(define %dovecot-os
313 (simple-operating-system
314 (service dhcpcd-service-type)
315 (service dovecot-service-type
316 (dovecot-configuration
317 (extensions (list dovecot-pigeonhole))
318 (disable-plaintext-auth? #f)
319 ;; Required for sieve!
320 (postmaster-address "postmaster@komputilo")
321 (ssl? "no")
322 (auth-mechanisms '("anonymous"))
323 (auth-anonymous-username "alice")
324 (protocols
325 (list (protocol-configuration
326 (name "imap")
327 (mail-plugins '("$mail_plugins" "imap_sieve"))
328 (imap-metadata? #t))))
329
330 (plugin-configuration
331 (plugin-configuration
332 (entries (list
333 (cons 'sieve-global "/tmp")
334 (cons 'sieve-extensions "+editheader")
335
336 (cons 'imapsieve-mailbox1-name "*")
337 (cons 'imapsieve-mailbox1-causes "APPEND")
338 ;; Run the script *before* the user scripts
339 (cons 'imapsieve-mailbox1-before "file:/tmp/main.sieve")
340 ;; We want to automatically remove original email
341 (cons 'imapsieve-expunge-discarded "yes")
342
343 (cons 'sieve-trace-debug "yes")
344 (cons 'sieve-trace-dir "/tmp")
345 (cons 'sieve-trace-level "tests")
346 (cons 'sieve-plugins "sieve_imapsieve")
347 ;; You cannot run scripts anywhere you want
348 ;; Sieve allows you to only run scripts under
349 ;; sieve_pipe_bin_dir.
350 (cons 'sieve-pipe-bin-dir "/tmp")))))
351
352 (mail-location
353 (string-append "maildir:~/Maildir"
354 ":INBOX=~/Maildir/INBOX"
355 ":LAYOUT=fs"))))))
356
357(define (run-dovecot-test)
358 "Return a test of an OS running Dovecot service."
359 (define vm
360 (virtual-machine
361 (operating-system (marionette-operating-system
362 %dovecot-os
363 #:imported-modules '((gnu services herd))))
364 (port-forwardings '((8143 . 143)))))
365
366 (define test
367 (with-imported-modules '((gnu build marionette))
368 #~(begin
369 (use-modules (gnu build marionette)
370 (ice-9 iconv)
371 (ice-9 rdelim)
372 (rnrs base)
373 (rnrs bytevectors)
374 (srfi srfi-64))
375
376 (define marionette
377 (make-marionette '(#$vm)))
378
379 (define* (message-length message #:key (encoding "iso-8859-1"))
380 (bytevector-length (string->bytevector message encoding)))
381
382 (define message "From: [email protected]\n\
383Subject: Hello Nice to meet you!")
384
385 (define sieve-script
386 "require \"editheader\";\n
387addheader \"X-Sieve-Filtered\" \"Guix\";
388")
389 ;; Install our sieve script
390 (marionette-eval
391 `(begin
392 (with-output-to-file "/tmp/main.sieve"
393 (lambda ()
394 (display ,sieve-script))))
395 marionette)
396
397 (test-runner-current (system-test-runner #$output))
398 (test-begin "dovecot")
399
400 ;; Wait for dovecot to be up and running.
401 (test-assert "dovecot running"
402 (marionette-eval
403 '(begin
404 (use-modules (gnu services herd))
405 (start-service 'dovecot))
406 marionette))
407
408 ;; Check Dovecot service's PID.
409 (test-assert "service process id"
410 (let ((pid
411 (number->string (wait-for-file "/var/run/dovecot/master.pid"
412 marionette))))
413 (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
414 marionette)))
415
416 (test-assert "accept an email"
417 (let ((imap (socket AF_INET SOCK_STREAM 0))
418 (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143)))
419 (connect imap addr)
420 ;; Be greeted.
421 (read-line imap) ;OK
422 ;; Authenticate
423 (write-line "a AUTHENTICATE ANONYMOUS" imap)
424 (read-line imap) ;+
425 (write-line "c2lyaGM=" imap)
426 (read-line imap) ;OK
427 ;; Create a TESTBOX mailbox
428 (write-line "a CREATE TESTBOX" imap)
429 (read-line imap) ;OK
430 ;; Select mailbox. This is required so that dovecot did
431 ;; synchronization correctly.
432 (write-line "a SELECT TESTBOX" imap)
433 ;; ("* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)\r")
434 ;; ("* OK [PERMANENTFLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft \\*)] Flags permitted.\r")
435 ;; ("* 1 EXISTS\r")
436 ;; ("* 1 RECENT\r")
437 ;; ("* OK [UNSEEN 1] First unseen.\r")
438 ;; ("* OK [UIDVALIDITY 1732177859] UIDs valid\r")
439 ;; ("* OK [UIDNEXT 3] Predicted next UID\r")
440 (for-each (lambda (n)
441 (read-line imap))
442 (iota 7))
443 ;; Append a message to a TESTBOX mailbox
444 (write-line (format #f "a APPEND TESTBOX {~a}"
445 (number->string (message-length message)))
446 imap)
447 (read-line imap) ;+
448 (write-line message imap)
449 (read-line imap) ;OK
450 ;; Logout
451 (write-line "a LOGOUT" imap)
452 (close imap)
453 #t))
454
455 (test-equal "mail arrived"
456 (string-join (list "X-Sieve-Filtered: Guix" message) "\n")
457 (marionette-eval
458 '(begin
459 (use-modules (ice-9 ftw)
460 (ice-9 match)
461 (rnrs io ports))
462 ;; XXX: We expect a new email in /cur directory
463 (let ((TESTBOX/cur "/home/alice/Maildir/TESTBOX/cur/"))
464 (match (scandir TESTBOX/cur)
465 (("." ".." message-file)
466 (call-with-input-file
467 (string-append TESTBOX/cur message-file)
468 get-string-all)))))
469 marionette))
470
471 (test-end))))
472
473 (gexp->derivation "dovecot-test" test))
474
475(define %test-dovecot
476 (system-test
477 (name "dovecot")
478 (description "Connect to a running Dovecot server.")
479 (value (run-dovecot-test))))
480
481(define %getmail-os
482 (operating-system
483 (inherit (simple-operating-system))
484
485 ;; Set a password for the user account; the test needs it.
486 (users (cons (user-account
487 (name "alice")
488 (password (crypt "testpass" "$6$abc"))
489 (comment "Bob's sister")
490 (group "users")
491 (supplementary-groups '("wheel" "audio" "video")))
492 %base-user-accounts))
493
494 (services (cons* (service dhcpcd-service-type)
495 (service dovecot-service-type
496 (dovecot-configuration
497 (disable-plaintext-auth? #f)
498 (ssl? "no")
499 (auth-mechanisms '("anonymous" "plain"))
500 (auth-anonymous-username "alice")
501 (mail-location
502 (string-append "maildir:~/Maildir"
503 ":INBOX=~/Maildir/INBOX"
504 ":LAYOUT=fs"))
505 (namespaces
506 (list
507 (namespace-configuration
508 (name "main")
509 (inbox? #t)
510 (mailboxes
511 (list
512 (mailbox-configuration
513 (name "TESTBOX")
514 (auto "create")))))))))
515 (service getmail-service-type
516 (list
517 (getmail-configuration
518 (name 'test)
519 (user "alice")
520 (directory "/var/lib/getmail/alice")
521 (idle '("TESTBOX"))
522 (rcfile
523 (getmail-configuration-file
524 (retriever
525 (getmail-retriever-configuration
526 (type "SimpleIMAPRetriever")
527 (server "localhost")
528 (username "alice")
529 (port 143)
530 (extra-parameters
531 '((password . "testpass")
532 (mailboxes . ("TESTBOX"))))))
533 (destination
534 (getmail-destination-configuration
535 (type "Maildir")
536 (path "/home/alice/TestMaildir/")))
537 (options
538 (getmail-options-configuration
539 (read-all #f))))))))
540 %base-services))))
541
542(define (run-getmail-test)
543 "Return a test of an OS running Getmail service."
544 (define vm
545 (virtual-machine
546 (operating-system (marionette-operating-system
547 %getmail-os
548 #:imported-modules '((gnu services herd))))
549 (port-forwardings '((8143 . 143)))))
550
551 (define test
552 (with-imported-modules '((gnu build marionette))
553 #~(begin
554 (use-modules (gnu build marionette)
555 (ice-9 iconv)
556 (ice-9 rdelim)
557 (rnrs base)
558 (rnrs bytevectors)
559 (srfi srfi-64))
560
561 (define marionette
562 (make-marionette '(#$vm)))
563
564 (define* (message-length message #:key (encoding "iso-8859-1"))
565 (bytevector-length (string->bytevector message encoding)))
566
567 (define message "From: [email protected]\n\
568Subject: Hello Nice to meet you!")
569
570 (test-runner-current (system-test-runner #$output))
571 (test-begin "getmail")
572
573 ;; Wait for dovecot to be up and running.
574 (test-assert "dovecot running"
575 (marionette-eval
576 '(begin
577 (use-modules (gnu services herd))
578 (start-service 'dovecot))
579 marionette))
580
581 ;; Wait for getmail to be up and running.
582 (test-assert "getmail-test running"
583 (marionette-eval
584 '(let* ((pw (getpw "alice"))
585 (uid (passwd:uid pw))
586 (gid (passwd:gid pw)))
587 (use-modules (gnu services herd))
588
589 (for-each
590 (lambda (dir)
591 (mkdir dir)
592 (chown dir uid gid))
593 '("/home/alice/TestMaildir"
594 "/home/alice/TestMaildir/cur"
595 "/home/alice/TestMaildir/new"
596 "/home/alice/TestMaildir/tmp"
597 "/home/alice/TestMaildir/TESTBOX"
598 "/home/alice/TestMaildir/TESTBOX/cur"
599 "/home/alice/TestMaildir/TESTBOX/new"
600 "/home/alice/TestMaildir/TESTBOX/tmp"))
601
602 (start-service 'getmail-test))
603 marionette))
604
605 ;; Check Dovecot service's PID.
606 (test-assert "service process id"
607 (let ((pid
608 (number->string (wait-for-file "/var/run/dovecot/master.pid"
609 marionette))))
610 (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
611 marionette)))
612
613 (test-assert "accept an email"
614 (let ((imap (socket AF_INET SOCK_STREAM 0))
615 (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143)))
616 (connect imap addr)
617 ;; Be greeted.
618 (read-line imap) ;OK
619 ;; Authenticate
620 (write-line "a AUTHENTICATE ANONYMOUS" imap)
621 (read-line imap) ;+
622 (write-line "c2lyaGM=" imap)
623 (read-line imap) ;OK
624 ;; Append a message to a TESTBOX mailbox
625 (write-line (format #f "a APPEND TESTBOX {~a}"
626 (number->string (message-length message)))
627 imap)
628 (read-line imap) ;+
629 (write-line message imap)
630 (read-line imap) ;OK
631 ;; Logout
632 (write-line "a LOGOUT" imap)
633 (close imap)
634 #t))
635
636 (sleep 1)
637
638 (test-assert "mail arrived"
639 (string-contains
640 (marionette-eval
641 '(begin
642 (use-modules (ice-9 ftw)
643 (ice-9 match)
644 (rnrs io ports))
645
646 (let ((TESTBOX/new "/home/alice/TestMaildir/new/"))
647 (match (scandir TESTBOX/new)
648 (("." ".." message-file)
649 (call-with-input-file
650 (string-append TESTBOX/new message-file)
651 get-string-all)))))
652 marionette)
653 message))
654
655 (test-end))))
656
657 (gexp->derivation "getmail-test" test))
658
659(define %test-getmail
660 (system-test
661 (name "getmail")
662 (description "Connect to a running Getmail server.")
663 (value (run-getmail-test))))
664
665(define %rspamd-os
666 (simple-operating-system
667 (service rspamd-service-type)))
668
669(define (run-rspamd-test)
670 "Return a test of an OS running Rspamd service."
671
672 (define vm
673 (virtual-machine
674 (marionette-operating-system
675 %rspamd-os
676 #:imported-modules '((gnu services herd)))))
677
678 (define test
679 (with-imported-modules '((gnu build marionette))
680 #~(begin
681 (use-modules (srfi srfi-64)
682 (gnu build marionette))
683
684 (define marionette
685 (make-marionette '(#$vm)))
686
687 (test-runner-current (system-test-runner #$output))
688 (test-begin "rspamd")
689
690 (test-assert "service is running"
691 (marionette-eval
692 '(begin
693 (use-modules (gnu services herd))
694 (start-service 'rspamd))
695 marionette))
696
697 (test-assert "rspamd socket ready"
698 (wait-for-unix-socket
699 "/var/lib/rspamd/rspamd.sock"
700 marionette))
701
702 (test-assert "rspamd log file"
703 (wait-for-file "/var/log/rspamd/rspamd.log" marionette))
704
705 ;; Check that we can access the web ui
706
707 (test-equal "http-get"
708 200
709 (marionette-eval
710 '(begin
711 (use-modules (web client)
712 (web response))
713 ;; HEAD returns 500 internal server error, so use GET even though
714 ;; only the headers are relevant
715 (response-code (http-get "http://localhost:11334")))
716 marionette))
717
718 (test-end))))
719
720 (gexp->derivation "rspamd-test" test))
721
722(define %test-rspamd
723 (system-test
724 (name "rspamd")
725 (description "Basic rspamd service test.")
726 (value (run-rspamd-test))))
727
728(define %radicale-create-bcrypt-htpasswd
729 #~(begin
730 (call-with-output-file "/etc/radicale/htpasswd"
731 (lambda (port)
732 ;; guix shell httpd -- htpasswd -Bnb test test
733 (display "test:$2y$05$B1FUMJ7W3FhAqjHZV2OiD.yOpZ5X2kRxQGbFG2o0V6.1O/7164mpC" port)))))
734
735(define %radicale-os-with-bcrypt-htpasswd
736 (simple-operating-system
737 (simple-service 'create-htpasswd
738 activation-service-type
739 %radicale-create-bcrypt-htpasswd)
740 (service dhcpcd-service-type)
741 (service radicale-service-type
742 (radicale-configuration
743 (auth (radicale-auth-configuration
744 (type 'htpasswd)
745 (htpasswd-encryption 'bcrypt)
746 (htpasswd-filename "/etc/radicale/htpasswd")))))))
747
748(define %radicale-os-default
749 (simple-operating-system
750 (service dhcpcd-service-type)
751 (service radicale-service-type)))
752
753(define (run-radicale-test name os)
754 "Return a test of an OS running Radicale service."
755
756 (define forwarded-port 5232)
757
758 (define vm
759 (virtual-machine
760 (operating-system
761 (marionette-operating-system
762 os
763 #:imported-modules '((gnu services herd))))
764 (port-forwardings `((5232 . ,forwarded-port)))))
765
766 (define test
767 (with-imported-modules '((gnu build marionette))
768 #~(begin
769 (use-modules (srfi srfi-64)
770 (gnu build marionette))
771
772 (define marionette
773 (make-marionette '(#$vm)))
774
775 (test-runner-current (system-test-runner #$output))
776 (test-begin "Radicale")
777
778 (test-assert "Radicale service is running"
779 (marionette-eval
780 '(begin
781 (use-modules (gnu services herd))
782 (wait-for-service 'radicale))
783 marionette))
784
785 (test-assert "Radicale TCP port ready, IPv4"
786 (wait-for-tcp-port #$forwarded-port marionette))
787
788 (test-equal "Radicale internal web interface works"
789 200
790 (marionette-eval
791 '(begin
792 (use-modules (web client)
793 (web response))
794 (response-code (http-get "http://localhost:5232/.web/index.html")))
795 marionette))
796
797 (test-assert "Radicale configuration action"
798 (marionette-eval '(with-shepherd-action 'radicale ('configuration)
799 results
800 (file-exists? (car results)))
801 marionette))
802
803 (test-end))))
804
805 (gexp->derivation name test))
806
807(define %test-radicale
808 (system-test
809 (name "radicale")
810 (description "Service starts with default configuration.")
811 (value (run-radicale-test name %radicale-os-default))))
812
813(define %test-radicale-htpasswd-bcrypt
814 (system-test
815 (name "radicale-htpasswd-bcrypt")
816 (description "Service starts with bcrypt htpasswd authentication.")
817 (value (run-radicale-test name %radicale-os-with-bcrypt-htpasswd))))