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