gnu/tests/mail.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
   3 ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
   4 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
   5 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
   6 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
   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)
  26   #:use-module (gnu system vm)
  27   #:use-module (gnu services)
  28   #:use-module (gnu services mail)
  29   #:use-module (gnu services networking)
  30   #:use-module (guix gexp)
  31   #:use-module (guix store)
  32   #:use-module (ice-9 ftw)
  33   #:export (%test-opensmtpd
  34             %test-exim
  35             %test-dovecot))
  36
  37 (define %opensmtpd-os
  38   (simple-operating-system
  39    (dhcp-client-service)
  40    (service opensmtpd-service-type
  41             (opensmtpd-configuration
  42              (config-file
  43               (plain-file "smtpd.conf" "
  44 listen on 0.0.0.0
  45 accept from any for local deliver to mbox
  46 "))))))
  47
  48 (define (run-opensmtpd-test)
  49   "Return a test of an OS running OpenSMTPD service."
  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))
  88                 (start-service 'smtpd))
  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))
 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))))
 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."
 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              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))
 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))))
 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.
 332           (test-assert "dovecot running"
 333             (marionette-eval
 334              '(begin
 335                 (use-modules (gnu services herd))
 336                 (start-service 'dovecot))
 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))))