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