1"======================================================================
2|
3|   POP3 protocol support
4|
5|
6 ======================================================================"
7
8"======================================================================
9|
10| Based on code copyright (c) Kazuki Yasumatsu, and in the public domain
11| Copyright (c) 2002 Free Software Foundation, Inc.
12| Adapted by Paolo Bonzini.
13|
14| This file is part of the GNU Smalltalk class library.
15|
16| The GNU Smalltalk class library is free software; you can redistribute it
17| and/or modify it under the terms of the GNU Lesser General Public License
18| as published by the Free Software Foundation; either version 2.1, or (at
19| your option) any later version.
20|
21| The GNU Smalltalk class library is distributed in the hope that it will be
22| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
24| General Public License for more details.
25|
26| You should have received a copy of the GNU Lesser General Public License
27| along with the GNU Smalltalk class library; see the file COPYING.LIB.
28| If not, write to the Free Software Foundation, 59 Temple Place - Suite
29| 330, Boston, MA 02110-1301, USA.
30|
31 ======================================================================"
32
33
34
35Namespace current: NetClients.POP [
36
37NetResponse subclass: POPResponse [
38
39    <comment: '
40Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
41'>
42    <category: 'NetClients-POP3'>
43
44    printStatusOn: aStream [
45	<category: 'printing'>
46	status notNil
47	    ifTrue:
48		[status = 1
49		    ifTrue: [aStream nextPutAll: '+OK ']
50		    ifFalse: [aStream nextPutAll: '-ERR ']].
51	statusMessage notNil ifTrue: [aStream nextPutAll: statusMessage]
52    ]
53
54    parseStatusLine: aClient [
55	"Returned string is: '+OK ok message' or '-ERR error message'"
56
57	<category: 'private'>
58	| stream |
59	stream := aClient nextLine readStream.
60	"status = 1 (OK), status = 0 (ERR)"
61	stream next = $+ ifTrue: [status := 1] ifFalse: [status := 0].
62	stream skipTo: Character space.
63	stream skipSeparators.
64	statusMessage := stream upToEnd
65    ]
66]
67
68]
69
70
71
72Namespace current: NetClients.POP [
73
74NetClient subclass: POPClient [
75    | loggedInUser |
76
77    <import: MIME>
78    <comment: '
79Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
80'>
81    <category: 'NetClients-POP3'>
82
83    POPClient class >> defaultPortNumber [
84	<category: 'constants'>
85	^110
86    ]
87
88    POPClient class >> example2Host: host username: username password: password [
89	<category: 'examples'>
90
91	[self
92	    exampleHost: host
93	    username: username
94	    password: password]
95		on: LoginIncorrectError
96		do:
97		    [:ex |
98		    'Login incorrect' printNl.
99		    ex return]
100    ]
101
102    POPClient class >> exampleHost: host username: username password: password [
103	<category: 'examples'>
104	| client |
105	client := POPClient connectToHost: host.
106
107	[client username: username password: password.
108	client login.
109	Transcript showCr: 'New messages: ' , client newMessagesCount printString.
110	Transcript showCr: 'bytes ' , client newMessagesSize printString.
111	Transcript showCr: 'ids ' , client newMessagesIds printString.
112	Transcript showCr: 'sizes ' , client newMessages printString.
113	client getNewMailMessages: [:m | m inspect] delete: false]
114		ensure: [client close]
115    ]
116
117    login [
118	<category: 'accessing'>
119	loggedInUser = self user ifTrue: [^self].
120	loggedInUser isNil ifFalse: [self logout].
121	self connect.
122	self clientPI popUser: self username.
123	self clientPI popPassword: self password.
124	loggedInUser := self user
125    ]
126
127    logout [
128	<category: 'accessing'>
129	self clientPI popQuit
130    ]
131
132    newMessagesCount [
133	<category: 'accessing'>
134	^self clientPI popStatus key
135    ]
136
137    newMessagesSize [
138	<category: 'accessing'>
139	^self clientPI popStatus value
140    ]
141
142    newMessagesIds [
143	<category: 'accessing'>
144	^self clientPI popList keys asSortedCollection asArray
145    ]
146
147    newMessages [
148	<category: 'accessing'>
149	^self clientPI popList
150    ]
151
152    sizeAt: id [
153	<category: 'accessing'>
154	^self clientPI popList: id
155    ]
156
157    headersAt: id [
158	<category: 'accessing'>
159	^self clientPI popTop: id lines: 1
160    ]
161
162    at: id [
163	<category: 'accessing'>
164	^self clientPI popRetrieve: id
165    ]
166
167    getNewMailHeaders: messageBlock delete: delete [
168	<category: 'accessing'>
169	| count entity |
170	self login.
171	count := self clientPI popStatus key.
172	count = 0
173	    ifFalse:
174		[1 to: count
175		    do:
176			[:i |
177			entity := self clientPI popTop: i lines: 1.
178			messageBlock value: entity].
179		delete ifTrue: [1 to: count do: [:i | self clientPI popDelete: i]]]
180    ]
181
182    getNewMailMessages: messageBlock delete: delete [
183	<category: 'accessing'>
184	| count entity |
185	self login.
186	count := self clientPI popStatus key.
187	count = 0
188	    ifFalse:
189		[1 to: count
190		    do:
191			[:i |
192			entity := self clientPI popRetrieve: i.
193			messageBlock value: entity].
194		delete ifTrue: [1 to: count do: [:i | self clientPI popDelete: i]]]
195    ]
196
197    getNewMailStreams: streamBlock delete: delete [
198	<category: 'accessing'>
199	| count |
200	self connectIfClosed.
201	self clientPI popUser: self username.
202	self clientPI popPassword: self password.
203	count := self clientPI popStatus.
204	count = 0
205	    ifFalse:
206		[1 to: count do: [:i | self clientPI popRetrieve: i into: streamBlock value].
207		delete ifTrue: [1 to: count do: [:i | self clientPI popDelete: i]]]
208    ]
209
210    protocolInterpreter [
211	<category: 'private'>
212	^POPProtocolInterpreter
213    ]
214]
215
216]
217
218
219
220Namespace current: NetClients.POP [
221
222NetProtocolInterpreter subclass: POPProtocolInterpreter [
223
224    <import: MIME>
225    <comment: '
226Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
227'>
228    <category: 'NetClients-POP3'>
229
230    POPProtocolInterpreter class >> defaultResponseClass [
231	<category: 'private-attributes'>
232	^POPResponse
233    ]
234
235    connect [
236	<category: 'pop protocol'>
237	super connect.
238	self checkResponse
239    ]
240
241    popDelete: anInteger [
242	<category: 'pop protocol'>
243	self
244	    nextPutAll: 'DELE ' , anInteger printString;
245	    cr.
246	self checkResponse
247    ]
248
249    popList [
250	<category: 'pop protocol'>
251	| stream dictionary assoc |
252	self
253	    nextPutAll: 'LIST';
254	    cr.
255	self checkResponse.
256	dictionary := LookupTable new.
257	stream := ReadWriteStream on: (String new: 100).
258	self receiveMessageUntilPeriodInto: stream.
259	stream reset.
260
261	[assoc := self parseSizeDataFrom: stream nextLine readStream.
262	assoc key > 0]
263		whileTrue: [dictionary add: assoc].
264	^dictionary
265    ]
266
267    popList: anInteger [
268	<category: 'pop protocol'>
269	| stream response |
270	self
271	    nextPutAll: 'LIST ' , anInteger printString;
272	    cr.
273	response := self getResponse.
274	self checkResponse: response.
275	response statusMessage == nil ifTrue: [^0].
276	stream := response statusMessage readStream.
277	^(self parseSizeDataFrom: stream) value
278    ]
279
280    popPassword: password [
281	<category: 'pop protocol'>
282	| response |
283	self
284	    nextPutAll: 'PASS ' , password;
285	    cr.
286	response := self getResponse.
287	self checkResponse: response
288	    ifError: [self loginIncorrectError: response statusMessage]
289    ]
290
291    popQuit [
292	<category: 'pop protocol'>
293	self
294	    nextPutAll: 'QUIT';
295	    cr.
296	self checkResponse
297    ]
298
299    popRetrieve: anInteger [
300	<category: 'pop protocol'>
301	self
302	    nextPutAll: 'RETR ' , anInteger printString;
303	    cr.
304	self checkResponse.
305	^MIME.MimeEntity readFromClient: self connectionStream
306    ]
307
308    popRetrieve: anInteger into: aStream [
309	<category: 'pop protocol'>
310	self
311	    nextPutAll: 'RETR ' , anInteger printString;
312	    cr.
313	self checkResponse.
314	self receiveMessageUntilPeriodInto: aStream
315    ]
316
317    popStatus [
318	"Check status and return a number of messages."
319
320	<category: 'pop protocol'>
321	| response stream |
322	self
323	    nextPutAll: 'STAT';
324	    cr.
325	response := self getResponse.
326	self checkResponse: response.
327	response statusMessage == nil ifTrue: [^0 -> 0].
328	stream := response statusMessage readStream.
329	^self parseSizeDataFrom: stream
330    ]
331
332    popTop: anInteger lines: linesInteger [
333	<category: 'pop protocol'>
334	self
335	    nextPutAll: 'TOP ' , anInteger printString;
336	    nextPutAll: ' ' , linesInteger printString;
337	    cr.
338	self checkResponse.
339	^MIME.MimeEntity readFromClient: self connectionStream
340    ]
341
342    popTop: anInteger lines: linesInteger into: aStream [
343	<category: 'pop protocol'>
344	self
345	    nextPutAll: 'TOP ' , anInteger printString;
346	    nextPutAll: ' ' , linesInteger printString;
347	    cr.
348	self checkResponse.
349	self receiveMessageUntilPeriodInto: aStream
350    ]
351
352    popUser: user [
353	<category: 'pop protocol'>
354	self
355	    nextPutAll: 'USER ' , user;
356	    cr.
357	self checkResponse
358    ]
359
360    checkResponse: response ifError: errorBlock [
361	<category: 'private'>
362	| status |
363	status := response status.
364	status = 1
365	    ifTrue:
366		["OK"
367
368		^self].
369	^errorBlock value
370    ]
371
372    parseSizeDataFrom: stream [
373	<category: 'private'>
374	| count size |
375	stream skipSeparators.
376	count := Integer readFrom: stream.
377	stream skipSeparators.
378	size := Integer readFrom: stream.
379	^count -> size
380    ]
381]
382
383]
384
385