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