/
t-imap.cl
238 lines (167 loc) · 7.15 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
;; imap testing
;; requires smtp module too
(eval-when (compile load eval)
(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-imap ()
(handler-bind ((net.post-office:po-condition
#'(lambda (con)
(format t "Got imap condition: ~a~%" con))))
(test-connect)
(test-sends)
(test-flags)
(test-mailboxes)
(test-pop)
))
(if* *do-test* then (do-test :imap #'test-imap))