-
Notifications
You must be signed in to change notification settings - Fork 12
/
Copy patht-imap.cl
313 lines (247 loc) · 10.5 KB
/
t-imap.cl
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
;; See the file LICENSE for the full license governing this code.
;; imap testing
;; requires smtp module too
(eval-when (compile load eval)
(require :rfc2822)
(require :smtp)
(require :imap)
(require :test))
(in-package :test)
(defparameter *test-machine* "tiger.franz.com")
(defparameter *test-account* "jkfmail")
(defparameter *test-password* "jkf.imap")
(defparameter *test-email* (format nil "~a@~a" *test-account* *test-machine*))
(defun test-connect ()
;; test connecting and disconnecting from the server
(let ((mb (net.post-office:make-imap-connection *test-machine*
:user *test-account*
:password *test-password*)))
(unwind-protect
(progn
(test-t (not (null mb))) ; make sure we got a mailbox object
; check that we've stored resonable values in the mb object
(test-equal "/" (net.post-office:mailbox-separator mb))
(test-t (net.post-office::select-mailbox mb "inbox"))
(test-t (> (net.post-office:mailbox-uidvalidity mb) 0))
(test-t (not (null (net.post-office:mailbox-flags mb)))))
(test-t (net.post-office:close-connection mb)))))
(defun test-sends ()
;; test sending and reading mail
(let ((mb (net.post-office:make-imap-connection *test-machine*
:user *test-account*
:password *test-password*)))
(unwind-protect
(progn
(test-t (not (null mb))) ; make sure we got a mailbox object
;; go through the mailboxes and delete all letters
(dolist (mblist (net.post-office:mailbox-list mb :pattern "*"))
(if* (not (member :\\noselect (net.post-office:mailbox-list-flags mblist)))
then (net.post-office:select-mailbox mb (net.post-office:mailbox-list-name mblist))
(let ((count (net.post-office:mailbox-message-count mb)))
; remove all old mail
(if* (> count 0)
then (net.post-office:alter-flags mb `(:seq 1 ,count) :add-flags :\\deleted)
(net.post-office:expunge-mailbox mb)
(test-eql 0 (net.post-office:mailbox-message-count mb)))
; remove mailbox (except inbox)
(if* (not (equalp "inbox" (net.post-office:mailbox-list-name mblist)))
then ; must not be selected if we want to del
(net.post-office:select-mailbox mb "inbox")
(net.post-office:delete-mailbox mb (net.post-office:mailbox-list-name mblist)))
)))
;; send five letters
(dotimes (i 5)
(net.post-office:send-smtp *test-machine*
*test-email*
*test-email*
(format nil "message number ~d" (1+ i))))
; test to see if imap figures out that the letters are there
(net.post-office:select-mailbox mb "inbox")
; wait a bit for the mail to be delivered
(dotimes (i 5)
(if* (not (eql 5 (net.post-office:mailbox-message-count mb)))
then (sleep 1)
(net.post-office: noop mb)))
(test-eql 5 (net.post-office:mailbox-message-count mb))
; test the search facility
; look for the message number we put in each message.
; I hope the letters get delivered in order...
(dotimes (i 5)
(let ((mn (1+ i)))
(test-equal (list mn)
(net.post-office:search-mailbox mb
`(:body ,(format nil "~d" mn))))))
; test getting data from mail message
(let ((fetch-info (net.post-office:fetch-parts mb
1
"(envelope body[1])")))
(let ((envelope (net.post-office:fetch-field 1 "envelope" fetch-info))
(body (net.post-office:fetch-field 1 "body[1]" fetch-info)))
(test-equal "jkfmail" (net.post-office:address-mailbox
(car (net.post-office:envelope-from envelope))))
(test-nil (net.post-office:address-mailbox
(car (net.post-office:envelope-to envelope))))
(test-equal (format nil "message number 1~c" #\newline)
body))))
(test-t (net.post-office:close-connection mb)))))
(defun test-flags ()
;; test setting and getting flags
;;
;; assume we have 5 messages in inbox at this time
;;
(let ((mb (net.post-office:make-imap-connection *test-machine*
:user *test-account*
:password *test-password*)))
(unwind-protect
(progn
(net.post-office:select-mailbox mb "inbox")
(let ((flags (net.post-office:fetch-field 3
"flags"
(net.post-office:fetch-parts
mb 3 "flags"))))
(test-nil flags))
;; add flags
(let ((info (net.post-office:alter-flags mb 3 :add-flags :\\deleted)))
(test-equal '(:\\deleted)
(net.post-office:fetch-field 3 "flags" info)))
; good bye message
(test-equal '(3) (net.post-office:expunge-mailbox mb))
(net.post-office:alter-flags mb 4 :add-flags ':\\bbbb)
(test-equal '(:\\bbbb)
(net.post-office:fetch-field 4 "flags"
(net.post-office:fetch-parts mb 4
"flags")))
)
(test-t (net.post-office:close-connection mb)))))
(defun test-mailboxes ()
;; should be 4 messages now in inbox
;; let's create 4 mailboxes, one for each letter
(let ((mb (net.post-office:make-imap-connection *test-machine*
:user *test-account*
:password *test-password*)))
(unwind-protect
(progn
(net.post-office:select-mailbox mb "inbox")
(dotimes (i 4)
(let ((mbname (format nil "temp/mb~d" i)))
(test-t (net.post-office:create-mailbox mb mbname))
(net.post-office:copy-to-mailbox mb (1+ i) mbname)))
; now check that each new mailbox has one message
(dotimes (i 4)
(let ((mbname (format nil "temp/mb~d" i)))
(net.post-office:select-mailbox mb mbname)
(test-eql 1 (net.post-office:mailbox-message-count mb)))))
(test-t (net.post-office:close-connection mb)))))
(defun test-pop ()
;; test out the pop interface to the mailbox.
(let ((pb (net.post-office:make-pop-connection *test-machine*
:user *test-account*
:password *test-password*)))
; still from before
(test-eql 4 (net.post-office:mailbox-message-count pb))
(test-eql 4 (length (net.post-office:unique-id pb)))
(net.post-office:delete-letter pb '(:seq 2 3))
(test-eql 2 (length (net.post-office:unique-id pb)))
(test-eql 4 (and :second (net.post-office:mailbox-message-count pb)))
(net.post-office:noop pb)
(test-eql 2 (and :third (net.post-office:mailbox-message-count pb)))
(net.post-office:fetch-letter pb 1)
(test-err (net.post-office:fetch-letter pb 2))
(test-err (net.post-office:fetch-letter pb 3))
(net.post-office:fetch-letter pb 4)
(net.post-office:close-connection pb)
(setq pb (net.post-office:make-pop-connection *test-machine*
:user *test-account*
:password *test-password*))
(test-eql 2 (and :fourth (net.post-office:mailbox-message-count pb)))
(net.post-office:fetch-letter pb 1) ; just make sure there's no error
(net.post-office:top-lines pb 1 1) ; just make sure there's no error
(net.post-office:make-envelope-from-text (net.post-office:top-lines pb 1 0))
(net.post-office:close-connection pb)))
(defun test-mime ()
(test-equal
"foobar baz"
(net.post-office:decode-header-text "=?utf-8?q?foo?=
=?utf-8?q?bar?= baz"))
(test-equal
"before brucejones hello"
(net.post-office:decode-header-text "before =?utf-8?q?bruce?= =?utf-8?q?jones?= hello"))
(test-equal
"[Franz Wiki] Update of \"Office/EmployeeDirectory\" by SteveHaflich"
(net.post-office:decode-header-text "=?utf-8?q?=5BFranz_Wiki=5D_Update_of_=22Office/EmployeeDirectory=22_by_St?=
=?utf-8?q?eveHaflich?="))
)
(defun test-parse-email-address ()
(dolist (good `(("[email protected]" "foo" "bar.com")
("[email protected]" "layer" "franz.com")
("
[email protected]" "layer" "franz.com")
(,(replace-re "[email protected] X"
"X"
(format nil "~c" #\newline)
:single-line t)
"layer" "franz.com")
(,(replace-re "[email protected] X"
"X"
(format nil "~c" #\return)
:single-line t)
"layer" "franz.com")
;; local-part length = 64
("1234567890123456789012345678901234567890123456789012345678901234@foo.com"
"1234567890123456789012345678901234567890123456789012345678901234"
"foo.com")
))
(multiple-value-bind (local-part domain)
(net.mail:parse-email-address (first good))
(test-equal (second good) local-part)
(test-equal (third good) domain)))
(dolist (bad (list "@foo.com"
;; local-part length = 65
"12345678901234567890123456789012345678901234567890123456789012345@foo.com"
))
(test-nil (net.mail:parse-email-address bad)))
)
(defun test-rfc2822 ()
(test-t (net.mail:valid-email-domain-p "mail.upb.de"))
)
(defparameter *folded-reference-value*
(defun test-send-letter ()
;; really a test of fold-addresses
(let* ((test-addresses
(loop for i from 0 to 50 collect "[email protected]"))
(folded (net.post-office::fold-addresses test-addresses)))
(test-equal *folded-reference-value* folded)))
(defun test-imap ()
(handler-bind ((net.post-office:po-condition
#'(lambda (con)
(format t "Got imap condition: ~a~%" con))))
(test-mime)
(test-parse-email-address)
(test-rfc2822)
(test-send-letter)
;;;; Only jkf is setup to run the tests.
(when (string= "jkf" (sys:getenv "USER"))
(test-connect)
(test-sends)
(test-flags)
(test-mailboxes)
(test-pop)
)))
(if* *do-test* then (do-test :imap #'test-imap))