1"======================================================================
2|
3|   SMTP 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, 2009 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.SMTP [
36
37NetClient subclass: SMTPClient [
38
39    <import: MIME>
40    <comment: '
41Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
42'>
43    <category: 'NetClients-SMTP'>
44
45    SMTPClient class >> defaultPortNumber [
46	<category: 'constants'>
47	^25
48    ]
49
50    SMTPClient class >> example2Host: host [
51	"self example2Host: 'localhost'."
52
53	<category: 'examples'>
54	| user message client |
55	user := '%1@%2' %
56			{Smalltalk getenv: 'USER'.
57			IPAddress localHostName}.
58	message := MIME.MimeEntity
59		    readFrom: ('From: ' , user , '
60To: ' , user , '
61To: foo' , user , '
62Bcc: '
63			    , user
64				, '
65Subject: Test mail from Smalltalk (SMTPClient)
66
67This is a test mail from Smalltalk (SMTPClient).
68')
69				readStream.
70	client := SMTPClient connectToHost: host.
71
72	[[client sendMessage: message] on: SMTPNoSuchRecipientError
73	    do:
74		[:ex |
75		ex
76		    inspect;
77		    return]]
78		ensure: [client close]
79    ]
80
81    SMTPClient class >> exampleHost: host [
82	"self exampleHost: 'localhost'."
83
84	<category: 'examples'>
85	| user message client |
86	user := '%1@%2' %
87			{Smalltalk getenv: 'USER'.
88			IPAddress localHostName}.
89	message := MIME.MimeEntity
90		    readFrom: ('From: ' , user , '
91To: ' , user , '
92Bcc: ' , user
93			    , '
94Subject: Test mail from Smalltalk (SMTPClient)
95
96This is a test mail from Smalltalk (SMTPClient).
97')
98				readStream.
99	client := SMTPClient connectToHost: host.
100	[client sendMessage: message] ensure: [client close]
101    ]
102
103    logout [
104	<category: 'accessing'>
105	self clientPI smtpQuit
106    ]
107
108    sendMailStream: aStream sender: sender recipients: recipients [
109	<category: 'accessing'>
110	self connectIfClosed.
111	self clientPI smtpHello: self getHostname.
112	(self clientPI isESMTP and: [self username isNil]) ifFalse: [
113            self clientPI esmtpAuthLogin: self username.
114            self password isNil ifFalse: [
115		self clientPI esmtpPassword: self password ]].
116	self clientPI smtpMail: sender.
117	recipients do: [:addr | self clientPI smtpRecipient: addr].
118	self clientPI smtpData: [self clientPI sendMessageWithPeriod: aStream]
119    ]
120
121    sendMessage: aMessage [
122	<category: 'accessing'>
123	| sender recipients |
124	aMessage inspect.
125	(aMessage sender isNil or: [(sender := aMessage sender addresses) isEmpty])
126	    ifTrue: [^self error: 'No sender'].
127	sender size > 1 ifTrue: [^self error: 'Invalid sender'].
128	sender := sender first.
129	recipients := aMessage recipients.
130	^self
131	    sendMessage: aMessage
132	    sender: sender
133	    recipients: recipients
134    ]
135
136    sendMessage: aMessage sender: sender recipients: recipients [
137	<category: 'accessing'>
138	self connectIfClosed.
139	self clientPI smtpHello: self getHostname.
140	(self clientPI isESMTP and: [self username isNil]) ifFalse: [
141            self clientPI esmtpAuthLogin: self username.
142            self password isNil ifFalse: [
143		self clientPI esmtpPassword: self password ]].
144	self clientPI smtpMail: sender.
145	recipients do: [:addr | self clientPI smtpRecipient: addr].
146	self clientPI smtpData: [aMessage printMessageOnClient: self clientPI]
147    ]
148
149    getHostname [
150	<category: 'private'>
151	^IPAddress localHostName
152    ]
153
154    protocolInterpreter [
155	<category: 'private'>
156	^SMTPProtocolInterpreter
157    ]
158]
159
160]
161
162
163
164Namespace current: NetClients.SMTP [
165
166NetProtocolInterpreter subclass: SMTPProtocolInterpreter [
167
168    <import: MIME>
169    <comment: '
170Copyright (c) Kazuki Yasumatsu, 1995. All rights reserved.
171'>
172    <category: 'NetClients-SMTP'>
173
174    | esmtp |
175
176    checkResponse: response ifError: errorBlock [
177	<category: 'private'>
178	| status |
179	status := response status.
180
181	"Positive Completion reply"
182	status = 211
183	    ifTrue:
184		["System status, or system help reply"
185
186		^self].
187	status = 214
188	    ifTrue:
189		["Help message"
190
191		^self].
192	status = 220
193	    ifTrue:
194		["Service ready"
195
196		^self].
197	status = 221
198	    ifTrue:
199		["Service closing channel"
200
201		^self].
202        status = 235
203            ifTrue:
204                ["Authentication successful"
205
206                ^self].
207	status = 250
208	    ifTrue:
209		["Requested mail action okay"
210
211		^self].
212	status = 251
213	    ifTrue:
214		["User not local; will forward"
215
216		^self].
217
218	"Positive Intermediate reply"
219        status = 334
220            ifTrue:
221                ["Authentication password"
222
223                ^self].
224	status = 354
225	    ifTrue:
226		["Start mail input"
227
228		^self].
229
230	"Transient Negative Completion reply"
231	status = 421
232	    ifTrue:
233		["Service not available"
234
235		^errorBlock value].
236	status = 450
237	    ifTrue:
238		["Requested mail action not taken"
239
240		^errorBlock value].
241	status = 451
242	    ifTrue:
243		["Requested action aborted"
244
245		^errorBlock value].
246	status = 452
247	    ifTrue:
248		["Requested action not taken"
249
250		^errorBlock value].
251
252	"Permanent Negative Completion reply"
253	status = 500
254	    ifTrue:
255		["Syntax error"
256
257		^errorBlock value].
258	status = 501
259	    ifTrue:
260		["Syntax error in parameters"
261
262		^errorBlock value].
263	status = 502
264	    ifTrue:
265		["Command not implemented"
266
267		^errorBlock value].
268	status = 503
269	    ifTrue:
270		["Bad sequence of commands"
271
272		^errorBlock value].
273	status = 504
274	    ifTrue:
275		["Command parameter not implemented"
276
277		^errorBlock value].
278	status = 550
279	    ifTrue:
280		["Requested action not taken"
281
282		^errorBlock value].
283	status = 551
284	    ifTrue:
285		["User not local; please try"
286
287		^errorBlock value].
288	status = 552
289	    ifTrue:
290		["Requested mail action aborted"
291
292		^errorBlock value].
293	status = 553
294	    ifTrue:
295		["Requested action not taken"
296
297		^errorBlock value].
298	status = 554
299	    ifTrue:
300		["Transaction failed"
301
302		^errorBlock value].
303
304	"Unknown status"
305	^errorBlock value
306    ]
307
308    noSuchRecipientNotify: errorString [
309	<category: 'private'>
310	^SMTPNoSuchRecipientError signal: errorString
311    ]
312
313    connect [
314	<category: 'smtp protocol'>
315	| response |
316	super connect.
317	response := self getResponse.
318	esmtp := response statusMessage ~ 'ESMTP'.
319	self checkResponse: response
320    ]
321
322    isESMTP [
323	<category: 'accssing'>
324	^esmtp
325    ]
326
327    esmtpAuthLogin: user [
328        <category: 'esmtp protocol'>
329        self
330            nextPutAll: 'AUTH LOGIN ', (self class base64Encode: user);
331            nl.
332        self checkResponse.
333    ]
334
335    esmtpPassword: password [
336        <category: 'esmtp protocol'>
337        self
338            nextPutAll: (self class base64Encode: password);
339            nl.
340        self checkResponse
341    ]
342
343    smtpData: streamBlock [
344	<category: 'smtp protocol'>
345	self
346	    nextPutAll: 'DATA';
347	    nl.
348	self checkResponse.
349	streamBlock value.
350	self checkResponse
351    ]
352
353    smtpExpand: aString [
354	<category: 'smtp protocol'>
355	self
356	    nextPutAll: 'EXPN ' , aString;
357	    nl.
358	self checkResponse
359    ]
360
361    smtpHello: domain [
362	<category: 'smtp protocol'>
363	self
364	    nextPutAll: ('%<EHLO|HELO>1 %2' % {esmtp. domain});
365	    nl.
366	self checkResponse
367    ]
368
369    smtpHelp [
370	<category: 'smtp protocol'>
371	self
372	    nextPutAll: 'HELP';
373	    nl.
374	self checkResponse
375    ]
376
377    smtpHelp: aString [
378	<category: 'smtp protocol'>
379	self
380	    nextPutAll: 'HELP ' , aString;
381	    nl.
382	self checkResponse
383    ]
384
385    smtpMail: reversePath [
386	<category: 'smtp protocol'>
387	self
388	    nextPutAll: 'MAIL FROM: <' , reversePath displayString , '>';
389	    nl.
390	self checkResponse
391    ]
392
393    smtpNoop [
394	<category: 'smtp protocol'>
395	self
396	    nextPutAll: 'NOOP';
397	    nl.
398	self checkResponse
399    ]
400
401    smtpQuit [
402	<category: 'smtp protocol'>
403	self
404	    nextPutAll: 'QUIT';
405	    nl.
406	self checkResponse
407    ]
408
409    smtpRecipient: forwardPath [
410	<category: 'smtp protocol'>
411	| response |
412	self
413	    nextPutAll: 'RCPT TO: <' , forwardPath displayString , '>';
414	    nl.
415	response := self getResponse.
416	self checkResponse: response
417	    ifError:
418		[| status |
419		status := response status.
420		(status = 550 or:
421			["Requested action not taken"
422
423			status = 551])
424		    ifTrue:
425			["User not local; please try"
426
427			self noSuchRecipientNotify: forwardPath]
428		    ifFalse: [self errorResponse: response]]
429    ]
430
431    smtpReset [
432	<category: 'smtp protocol'>
433	self
434	    nextPutAll: 'RSET';
435	    nl.
436	self checkResponse
437    ]
438
439    smtpSend: reversePath [
440	<category: 'smtp protocol'>
441	self
442	    nextPutAll: 'SEND FROM: <' , reversePath displayString , '>';
443	    nl.
444	self checkResponse
445    ]
446
447    smtpSendAndMail: reversePath [
448	<category: 'smtp protocol'>
449	self
450	    nextPutAll: 'SAML FROM: <' , reversePath displayString , '>';
451	    nl.
452	self checkResponse
453    ]
454
455    smtpSendOrMail: reversePath [
456	<category: 'smtp protocol'>
457	self
458	    nextPutAll: 'SOML FROM: <' , reversePath displayString , '>';
459	    nl.
460	self checkResponse
461    ]
462
463    smtpTurn [
464	<category: 'smtp protocol'>
465	self
466	    nextPutAll: 'TURN';
467	    nl.
468	self checkResponse
469    ]
470
471    smtpVerify: aString [
472	<category: 'smtp protocol'>
473	self
474	    nextPutAll: 'VRFY ' , aString;
475	    nl.
476	self checkResponse
477    ]
478]
479
480]
481
482
483
484Namespace current: NetClients.SMTP [
485
486NetClientError subclass: SMTPNoSuchRecipientError [
487
488    <comment: nil>
489    <category: 'NetClients-SMTP'>
490]
491
492]
493
494