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