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 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu tests mail)
  22   #:use-module (gnu tests)
  23   #:use-module (gnu system)
  24   #:use-module (gnu system vm)
  25   #:use-module (gnu services)
  26   #:use-module (gnu services mail)
  27   #:use-module (gnu services networking)
  28   #:use-module (guix gexp)
  29   #:use-module (guix store)
  30   #:use-module (ice-9 ftw)
  31   #:export (%test-opensmtpd
  32             %test-exim))
  33
  34 (define %opensmtpd-os
  35   (simple-operating-system
  36    (dhcp-client-service)
  37    (service opensmtpd-service-type
  38             (opensmtpd-configuration
  39              (config-file
  40               (plain-file "smtpd.conf" "
  41 listen on 0.0.0.0
  42 accept from any for local deliver to mbox
  43 "))))))
  44
  45 (define (run-opensmtpd-test)
  46   "Return a test of an OS running OpenSMTPD service."
  47   (define vm
  48     (virtual-machine
  49      (operating-system (marionette-operating-system
  50                         %opensmtpd-os
  51                         #:imported-modules '((gnu services herd))))
  52      (port-forwardings '((1025 . 25)))))
  53
  54   (define test
  55     (with-imported-modules '((gnu build marionette))
  56       #~(begin
  57           (use-modules (rnrs base)
  58                        (srfi srfi-64)
  59                        (ice-9 rdelim)
  60                        (ice-9 regex)
  61                        (gnu build marionette))
  62
  63           (define marionette
  64             (make-marionette '(#$vm)))
  65
  66           (define (read-reply-code port)
  67             "Read a SMTP reply from PORT and return its reply code."
  68             (let* ((line      (read-line port))
  69                    (mo        (string-match "([0-9]+)([ -]).*" line))
  70                    (code      (string->number (match:substring mo 1)))
  71                    (finished? (string= " " (match:substring mo 2))))
  72               (if finished?
  73                   code
  74                   (read-reply-code port))))
  75
  76           (mkdir #$output)
  77           (chdir #$output)
  78
  79           (test-begin "opensmptd")
  80
  81           (test-assert "service is running"
  82             (marionette-eval
  83              '(begin
  84                 (use-modules (gnu services herd))
  85                 (start-service 'smtpd)
  86                 #t)
  87              marionette))
  88
  89           (test-assert "mbox is empty"
  90             (marionette-eval
  91              '(and (file-exists? "/var/mail")
  92                    (not (file-exists? "/var/mail/root")))
  93              marionette))
  94
  95           (test-eq "accept an email"
  96             #t
  97             (let* ((smtp (socket AF_INET SOCK_STREAM 0))
  98                    (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
  99               (connect smtp addr)
 100               ;; Be greeted.
 101               (read-reply-code smtp)              ;220
 102               ;; Greet the server.
 103               (write-line "EHLO somehost" smtp)
 104               (read-reply-code smtp)              ;250
 105               ;; Set sender email.
 106               (write-line "MAIL FROM: <someone>" smtp)
 107               (read-reply-code smtp)              ;250
 108               ;; Set recipient email.
 109               (write-line "RCPT TO: <root>" smtp)
 110               (read-reply-code smtp)              ;250
 111               ;; Send message.
 112               (write-line "DATA" smtp)
 113               (read-reply-code smtp)              ;354
 114               (write-line "Subject: Hello" smtp)
 115               (newline smtp)
 116               (write-line "Nice to meet you!" smtp)
 117               (write-line "." smtp)
 118               (read-reply-code smtp)              ;250
 119               ;; Say goodbye.
 120               (write-line "QUIT" smtp)
 121               (read-reply-code smtp)              ;221
 122               (close smtp)
 123               #t))
 124
 125           (test-assert "mail arrived"
 126             (marionette-eval
 127              '(begin
 128                 (use-modules (ice-9 popen)
 129                              (ice-9 rdelim))
 130
 131                 (define (queue-empty?)
 132                   (eof-object?
 133                    (read-line
 134                     (open-input-pipe "smtpctl show queue"))))
 135
 136                 (let wait ()
 137                   (if (queue-empty?)
 138                       (file-exists? "/var/mail/root")
 139                       (begin (sleep 1) (wait)))))
 140              marionette))
 141
 142           (test-end)
 143           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 144
 145   (gexp->derivation "opensmtpd-test" test))
 146
 147 (define %test-opensmtpd
 148   (system-test
 149    (name "opensmtpd")
 150    (description "Send an email to a running OpenSMTPD server.")
 151    (value (run-opensmtpd-test))))
 152
 153
 154 (define %exim-os
 155   (simple-operating-system
 156    (dhcp-client-service)
 157    (service mail-aliases-service-type '())
 158    (service exim-service-type
 159             (exim-configuration
 160              (config-file
 161               (plain-file "exim.conf" "
 162 primary_hostname = komputilo
 163 domainlist local_domains = @
 164 domainlist relay_to_domains =
 165 hostlist   relay_from_hosts = localhost
 166
 167 never_users =
 168
 169 acl_smtp_rcpt = acl_check_rcpt
 170 acl_smtp_data = acl_check_data
 171
 172 begin acl
 173
 174 acl_check_rcpt:
 175   accept
 176 acl_check_data:
 177   accept
 178 "))))))
 179
 180 (define (run-exim-test)
 181   "Return a test of an OS running an Exim service."
 182   (define vm
 183     (virtual-machine
 184      (operating-system (marionette-operating-system
 185                         %exim-os
 186                         #:imported-modules '((gnu services herd))))
 187      (port-forwardings '((1025 . 25)))))
 188
 189   (define test
 190     (with-imported-modules '((gnu build marionette)
 191                              (ice-9 ftw))
 192       #~(begin
 193           (use-modules (rnrs base)
 194                        (srfi srfi-64)
 195                        (ice-9 ftw)
 196                        (ice-9 rdelim)
 197                        (ice-9 regex)
 198                        (gnu build marionette))
 199
 200           (define marionette
 201             (make-marionette '(#$vm)))
 202
 203           (define (read-reply-code port)
 204             "Read a SMTP reply from PORT and return its reply code."
 205             (let* ((line      (read-line port))
 206                    (mo        (string-match "([0-9]+)([ -]).*" line))
 207                    (code      (string->number (match:substring mo 1)))
 208                    (finished? (string= " " (match:substring mo 2))))
 209               (if finished?
 210                   code
 211                   (read-reply-code port))))
 212
 213           (define smtp (socket AF_INET SOCK_STREAM 0))
 214           (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
 215
 216           (mkdir #$output)
 217           (chdir #$output)
 218
 219           (test-begin "exim")
 220
 221           (test-assert "service is running"
 222             (marionette-eval
 223              '(begin
 224                 (use-modules (gnu services herd))
 225                 (start-service 'exim)
 226                 #t)
 227              marionette))
 228
 229           (sleep 1) ;; give the service time to start talking
 230
 231           (connect smtp addr)
 232           ;; Be greeted.
 233           (test-eq "greeting received"
 234             220 (read-reply-code smtp))
 235           ;; Greet the server.
 236           (write-line "EHLO somehost" smtp)
 237           (test-eq "greeting successful"
 238             250 (read-reply-code smtp))
 239           ;; Set sender email.
 240           (write-line "MAIL FROM: test@example.com" smtp)
 241           (test-eq "sender set"
 242             250 (read-reply-code smtp))           ;250
 243           ;; Set recipient email.
 244           (write-line "RCPT TO: root@komputilo" smtp)
 245           (test-eq "recipient set"
 246             250 (read-reply-code smtp))           ;250
 247           ;; Send message.
 248           (write-line "DATA" smtp)
 249           (test-eq "data begun"
 250             354 (read-reply-code smtp))           ;354
 251           (write-line "Subject: Hello" smtp)
 252           (newline smtp)
 253           (write-line "Nice to meet you!" smtp)
 254           (write-line "." smtp)
 255           (test-eq "message sent"
 256             250 (read-reply-code smtp))           ;250
 257           ;; Say goodbye.
 258           (write-line "QUIT" smtp)
 259           (test-eq "quit successful"
 260             221 (read-reply-code smtp))           ;221
 261           (close smtp)
 262
 263           (test-eq "the email is received"
 264             1
 265             (marionette-eval
 266              '(begin
 267                 (use-modules (ice-9 ftw))
 268                 (length (scandir "/var/spool/exim/msglog"
 269                                  (lambda (x) (not (string-prefix? "." x))))))
 270              marionette))
 271
 272           (test-end)
 273           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 274
 275   (gexp->derivation "exim-test" test))
 276
 277 (define %test-exim
 278   (system-test
 279    (name "exim")
 280    (description "Send an email to a running an Exim server.")
 281    (value (run-exim-test))))