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