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