summaryrefslogtreecommitdiff
path: root/tests/email.scm
blob: a91ab1652e523874c1ac43c51b6cd9b4642c24dc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
;;; guile-email --- Guile email parser
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file was adapted from guile-debbugs and is part of guile-email.
;;;
;;; guile-email is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; guile-email is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with guile-email.  If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; This is an adaptation of "ext/rfc/test.scm" from Gauche Scheme.
;;; The file is under the BSD-3 license, reproduced below:
;;;
;;;   Copyright (c) 2000-2017  Shiro Kawai  <shiro@acm.org>
;;;
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;
;;;    1. Redistributions of source code must retain the above copyright
;;;       notice, this list of conditions and the following disclaimer.
;;;
;;;    2. Redistributions in binary form must reproduce the above copyright
;;;       notice, this list of conditions and the following disclaimer in the
;;;       documentation and/or other materials provided with the distribution.
;;;
;;;    3. Neither the name of the authors nor the names of its contributors
;;;       may be used to endorse or promote products derived from this
;;;       software without specific prior written permission.
;;;
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(use-modules (email email)
             (srfi srfi-19)
             (srfi srfi-64))

(test-begin "email")

(test-equal "parse email headers"
  (parse-email-headers
   "Received: by foo.bar.com id ZZZ55555; Thu, 31 May 2001 16:38:04 -1000 (HST)
Received: from ooo.ooo.com (ooo.ooo.com [1.2.3.4])
\tby foo.bar.com (9.9.9+3.2W/3.7W-) with ESMTP id ZZZ55555
\tfor <yoo@bar.com>; Thu, 31 May 2001 16:38:02 -1000 (HST)
Received: from zzz ([1.2.3.5]) by ooo.ooo.com  with Maccrosoft SMTPSVC(5.5.1877.197.19);
\t Thu, 31 May 2001 22:33:16 -0400
Message-ID: <beefbeefbeefbeef@ooo.ooo.com>
Subject: Bogus Tester
From: Bogus Sender <bogus@ooo.com>
To: You <you@bar.com>, Another <another@ooo.com>
Date: Fri, 01 Jun 2001 02:37:31 +0530
Mime-Version: 1.0
Content-Type: text/html
Content-Transfer-Encoding: quoted-printable
X-MSMail-Priority: Normal
X-mailer: FooMail 4.0 4.03 (SMT460B92F)
Content-Length: 4349
")
  `((trace (received " by foo.bar.com id ZZZ55555"
                     ,(make-date 0 4 38 16 31 5 2001 -36000))
           (received " from ooo.ooo.com \tby foo.bar.com  with ESMTP id ZZZ55555\tfor <yoo@bar.com>"
                     ,(make-date 0 2 38 16 31 5 2001 -36000))
           (received " from zzz  by ooo.ooo.com  with Maccrosoft SMTPSVC"
                     ,(make-date 0 16 33 22 31 5 2001 -14400)))
    (message-id . "beefbeefbeefbeef@ooo.ooo.com")
    (subject . "Bogus Tester")
    (from ((name . "Bogus Sender")
           (address . "bogus@ooo.com")))
    (to ((name . "You")
         (address . "you@bar.com"))
        ((name . "Another")
         (address . "another@ooo.com")))
    (date . ,(make-date 0 31 37 2 1 6 2001 19800))
    (mime-version . "1.0")
    (content-type (type . text)
                  (subtype . html)
                  (charset . "utf-8"))
    (content-transfer-encoding . quoted-printable)
    (x-msmail-priority . "Normal")
    (x-mailer . "FooMail 4.0 4.03 (SMT460B92F)")
    (content-length . "4349")))

(test-equal "handle truncated multipart message gracefully"
  ((module-ref (resolve-module '(email email))
               'body->mime-entities)
   "--boundary
Content-Type: text/plain

foo
"
   "boundary")
  (list "Content-Type: text/plain

foo
"))

(test-equal "parse name-addr email address"
  (parse-email-address "Foo <foo@example.org>")
  '((name . "Foo") (address . "foo@example.org")))

(test-equal "parse addr-spec email address"
  (parse-email-address "foo@example.org")
  '((address . "foo@example.org")))

(test-equal "parse emacs message mode parens style email address"
  (parse-email-address "foo@example.org (Foo)")
  '((name . "Foo") (address . "foo@example.org")))

(test-end "email")