'From Squeak3.1alpha of 20 February 2001 [latest update: #3848] on 9 April 2001 at 2:10:46 pm'! "Change Set: CelesteCleanup Date: 9 April 2001 Author: Mike Rutenberg & Lex Spoon (1) Removed many unneeded methods, and two unused instance variables in class Celeste (2) Substantial (3+ x faster) speedup in compact and salvaging mail files (3) Adds drag and drop of messages into categories (4) Checks that email addresses have a valid form before you finish writing the message (5) Fix several walkback or infinite loop problems when handling MIME messages (6) (Lex Spoon) Fixes to again support multiple To: and CC: fields (7) Addes a simple test framework to allow testing of changes using all accumulated messages (8) Tweaks and numerous small bug fixes to improve robustness "! Model subclass: #Celeste instanceVariableNames: 'mailDB currentCategory currentMessages currentMsgID lastCategory subjectFilter fromFilter participantFilter dateFilter customFilterBlock formatMessages lastCategoryList lastCategoryMenu messageTextView userPassword compiledCustomFilters status tocLists ' classVariableNames: 'CCList CustomFilters CustomFiltersCompiled DeleteInboxAfterFetching FormatWhenFetching MessageCountLimit PopServer PopUserName SmtpServer SuppressWorthlessHeaderFields TimeZone UserName ' poolDictionaries: '' category: 'Network-Mail Reader'! Model subclass: #MailDB instanceVariableNames: 'rootFilename messageFile indexFile categoriesFile lastIssuedMsgID canRenumberMsgIDs ' classVariableNames: 'LastID ' poolDictionaries: '' category: 'Network-Mail Reader'! !MailDB commentStamp: 'mdr 4/9/2001 12:14' prior: 0! I am the in-memory representation of a Celeste mail database. A mail database named "current" consists of three files: current.messages -- an append-only file containing the full content of all messages current.index -- an index of all messages in the messages file that maps unique message ID's to index entries containing some header information and the offset of the full message in the .messages file current.categories -- maps category names to collections of message ID's Each open mail database has a MailDB object that manages these three files. Operations such as fetching a message given its unique ID and finding out which messages are in which category are supported by the MailDB object. It also supports incorporating new messages (reading mail), message editing and deletions, and message file compaction and recovery. canRenumberMsgIDs is used only during compacting the message file. It controls whether renumbering can happen for messages which have duplicate (and therefore not unique) messageIDs. It is an instance variable so that it can control behaviour in subsequent compactions. Please do not use it for other behaviour. lastIssuedMsgID contains the most recently issued message ID. It is mostly private to nextUnusedID, though it is also cleared in the compact routine. Otherwise, please do not read or write it.! !CategoriesFile commentStamp: '' prior: 0! I represent the organization of the mail database into set of message lists called "categories". Each category contains a collection of message ID's. The same message may be cross-filed quite cheaply by storing it's ID in multiple categories. The categories information is kept in a binary file on the disk. It is read into memory in its entirety when the mail database is opened. To make changes persist, the categories information must be saved out to disk. This should be done after fetching new mail and when the mail database is closed. It could also be done periodically by some sort of background process. Note that the categories file, unlike the index file, cannot be re-created from the messages file. ! !IndexFile commentStamp: '' prior: 0! I represent an index for the messages in a mail database. I acts like a dictionary that maps unique message ID's to IndexFileEntry objects. The index file is read into memory in its entirety and kept there for the duration of a mail reading session. It should be stored back to disk at the end of the session, or after a major change, such as fetching new mail. If necessary, it can be completely recreated by scanning the messages file!!! !MailMessage commentStamp: '' prior: 0! I represent an Internet mail or news message. text - the raw text of my message body - the body of my message, as a MIMEDocument fields - a dictionary mapping lowercased field names into collections of MIMEHeaderValue's parts - if I am a multipart message, then this is a cache of my parts! !MailNotifier commentStamp: '' prior: 0! This is a basic example of connecting to a mail server, using POP3, to check how many messages are waiting. It does everything at one time, which may make it too slow to use as is.! !POPSocket commentStamp: '' prior: 0! This class implements POP3 (Post Office Protocol 3) as specified in RFC 1939. (see http://www.ietf.org/rfc.html) You can use it to download email from the mail server to your personal mail program. To see an example of it's use, see POPSocket class>>example.! !Celeste methodsFor: 'drag and drop' stamp: 'mdr 4/8/2001 21:23'! acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph "Accept messageIDs from the tocEntryList. Move the indicated message to the destination category." | srcType moveID destCategory savedCurrentMsgID | srcType _ transferMorph dragTransferType. srcType == #tocEntryList ifFalse: [^false]. "Get the message ID and the destination category" moveID _ transferMorph passenger. destCategory _ dstListMorph potentialDropMorph contents. [moveID isKindOf: Integer] assert. [self categoryList includes: destCategory] assert. "Don't do anything if the message was dropped into some particular categories" (destCategory = currentCategory) ifTrue: [^false]. "the current category" (destCategory = '.all.') ifTrue: [^false]. "the computed category .all." "Quickly remove the message from those displayed using removeMessage. We have to fiddle with currentMsgID to allow case the dragged message was not the one displayed" savedCurrentMsgID _ currentMsgID. mailDB file: moveID inCategory: destCategory. currentMsgID _ moveID. self removeMessage. currentMsgID _ savedCurrentMsgID. ^true! ! !Celeste methodsFor: 'drag and drop' stamp: 'mdr 4/8/2001 20:44'! dragPassengerFor: item inMorph: dragSource "Create a information string representing the message to drag (and display while dragging)" (dragSource isKindOf: PluggableListMorph) ifFalse: [^item]. dragSource getListSelector == #tocEntryList ifTrue: [^self msgIDFromTOCEntry: item contents]. "Give them nil if they try to drag a category for instance" ^nil! ! !Celeste methodsFor: 'drag and drop' stamp: 'mdr 4/8/2001 20:58'! dragTransferTypeForMorph: dragSource ^(dragSource isKindOf: PluggableListMorph) ifTrue: [dragSource getListSelector]! ! !Celeste methodsFor: 'drag and drop' stamp: 'mdr 4/8/2001 20:55'! wantsDroppedMorph: transferMorph event: anEvent inMorph: destinationLM "We are only interested in TransferMorphs as wrappers for informations. If their content is really interesting for us, will determined later in >>acceptDroppingMorph:event:." | srcType dstType | "only want drops on lists (not, for example, on pluggable texts)" (destinationLM isKindOf: PluggableListMorph) ifFalse: [^ false]. srcType _ transferMorph dragTransferType. dstType _ destinationLM getListSelector. (srcType = #tocEntryList) ifFalse: [^false]. "Only messages from TOC" (dstType = #categoryList) ifFalse: [^false]. "Only drop into category list" ^true! ! !Celeste methodsFor: 'categories pane' stamp: 'mdr 3/23/2001 15:23'! compact "Salvage and Compact the messages file." | stats | Transcript cr; show: 'Compacting message file...'. Cursor execute showWhile: [stats _ mailDB compact]. Transcript show: 'Done.'; cr. Transcript show: 'Recovered ', (stats at: 1) printString, ' message', (((stats at: 1) = 1) ifTrue: [', '] ifFalse: ['s, ']), (stats at: 2) printString, ' bytes. ', (stats at: 3) printString, ' active messages remain.'; cr. self setCategory: self category. "Flush all the displayed state"! ! !Celeste methodsFor: 'categories pane' stamp: 'mdr 3/20/2001 18:29'! fetchMail "Append messages from the user's mailbox to this mail database." | server password msgCount | server _ self class popServer. password _ self popPassword. password ifNil: [^ self]. self requiredCategory: 'new'. msgCount _ mailDB fetchMailFromPOP: server userName: self class popUserName password: password doFormatting: FormatWhenFetching deleteFromServer: DeleteInboxAfterFetching. msgCount < 0 ifTrue: [self inform: 'could not connect to the mail server'] ifFalse: [self inform: msgCount printString, ' messages fetched']. msgCount <= 0 ifTrue: [^ self]. self setCategory: 'new'. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'mdr 4/8/2001 20:18'! msgIDFromTOCEntry: newTOCentry "Given an entry index number from the TOC pane, find the corresponding msgID" ^currentMessages at: ((self tocLists at: 1) indexOf: newTOCentry ifAbsent: [^nil]) ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'mdr 4/8/2001 22:57'! removeAll "Remove all presently listed messages from the current category." mailDB removeAll: currentMessages fromCategory: currentCategory. currentMsgID _ nil. "Regenerate the (possibly empty) TOC for this category" self setCategory: currentCategory. ! ! !Celeste methodsFor: 'table of contents pane' stamp: 'mdr 4/8/2001 20:31'! setTOCEntry: newTOCentry "Change the currently selected message. This is done by finding the message ID corresponding to the selected table of contents entry." currentMsgID _ self msgIDFromTOCEntry: newTOCentry. self changed: #tocEntry. Cursor read showWhile: [self changed: #messageText]! ! !Celeste methodsFor: 'filtering' stamp: 'mdr 3/21/2001 15:24'! fromFilterOn: aSwitch "Show only those messages from the same person as the currently selected message. The user is given a chance to edit the pattern string used to match 'From:' fields." fromFilter _ (currentMsgID isNil) ifTrue: [''] ifFalse: [(mailDB getTOCentry: currentMsgID) from]. fromFilter _ FillInTheBlank request: '''From:'' filter pattern?' initialAnswer: fromFilter. fromFilter = '' ifTrue: [aSwitch turnOff. ^self]. "User cancelled, so turn off the switch" fromFilter _ fromFilter withBlanksTrimmed. self updateTOC.! ! !Celeste methodsFor: 'filtering' stamp: 'mdr 3/15/2001 15:49'! isSubjectFilterOn "whether there is a subject filter in effect" ^ subjectFilter isEmptyOrNil not! ! !Celeste methodsFor: 'filtering' stamp: 'mdr 3/21/2001 15:02'! normalizedSubject: srcString "Turn the raw subject line into a decent possible subject filter" | res | res _ srcString. "Remove leading Re:s" [res asLowercase beginsWith: 're:'] whileTrue: [res _ (res copyFrom: 4 to: res size) withBlanksTrimmed]. ^ res! ! !Celeste methodsFor: 'filtering' stamp: 'mdr 3/15/2001 16:45'! subjectFilterOn "Show only those messages whose subject matches the currently selected message. The user is given a chance to edit the pattern string used to match 'Subject:' fields." subjectFilter _ currentMsgID isNil ifTrue: [''] ifFalse: [(mailDB getTOCentry: currentMsgID) subject]. subjectFilter _ self normalizedSubject: subjectFilter. subjectFilter _ FillInTheBlank request: '''Subject:'' filter pattern?' initialAnswer: subjectFilter. self updateTOC. self changed: #isSubjectFilterOn! ! !Celeste methodsFor: 'other' stamp: 'mdr 3/15/2001 14:40'! changeMaxMessageCount | countString count | countString _ FillInTheBlank request: 'Maximum number of messages displayed?' initialAnswer: self class messageCountLimit printString. countString isEmpty ifTrue: [^ self]. count _ countString asInteger max: 1. self class messageCountLimit: count. self setCategory: currentCategory! ! !Celeste methodsFor: 'sending mail' stamp: 'mdr 3/20/2001 18:24'! popPassword "Answer the password to use when retrieving mail via POP3. The password is stored in an instance variable, which disappears when you close the Celeste window." userPassword ifNotNil: [^ userPassword]. userPassword _ FillInTheBlank requestPassword: 'POP password'. userPassword isEmpty ifTrue: [userPassword _ nil]. ^ userPassword ! ! !Celeste methodsFor: 'sending mail' stamp: 'mdr 3/19/2001 10:39'! queueMessageWithText: aStringOrText "Queue a message to be sent later. The message is added to the database and filed in the '.tosend.' category." | messageText id msg | messageText _ 'X-Mailer: ' , Celeste versionString , String cr , 'Date: ' , MailMessage dateStampNow , ' ' , self timeZoneString , ' ' , String cr. messageText _ messageText , aStringOrText asString. msg _ MailMessage from: messageText. "Check now that the addresses are well formed email addresses. This prevents runtime errors when actually transmitting the mail" [MailAddressParser addressesIn: msg from] ifError: [ :err :rcvr | self inform: 'From: in message header', String cr, err. ^nil]. [MailAddressParser addressesIn: msg to] ifError: [ :err :rcvr | self inform: 'To: in message header', String cr, err. ^nil]. [MailAddressParser addressesIn: msg cc] ifError: [:err :rcvr | self inform: 'CC: in message header', String cr, err. ^nil]. "queue the message" self requiredCategory: '.tosend.'. id _ mailDB addNewMessage: msg. mailDB file: id inCategory: '.tosend.'. self category = '.tosend.' ifTrue: [self updateTOC]. self changed: #outBoxStatus. ^ id! ! !Celeste class methodsFor: 'class initialization' stamp: 'mdr 3/15/2001 14:36'! initialize "Celeste initialize" "user preferences" CCList _ nil. DeleteInboxAfterFetching _ false. PopServer _ nil. PopUserName _ nil. SmtpServer _ nil. SuppressWorthlessHeaderFields _ true. UserName _ nil. "options with no UI; just set their values directly" FormatWhenFetching _ false. "dictionary of custom filters" CustomFilters _ Dictionary new. MessageCountLimit _ 200. "Add global preferences" Preferences addPreferenceForOptionalCelesteStatusPane. Preferences addPreferenceForCelesteShowingAttachmentsFlag. ! ! !Celeste class methodsFor: 'instance creation' stamp: 'mdr 3/21/2001 17:33'! current "Answer the currently active Celeste (assuming that there's only one Celeste open at a given time) or open a new one." Smalltalk garbageCollect. ^Celeste allInstances detect: [:e | e isActive] ifNone: [self open]. ! ! !Celeste class methodsFor: 'build-common' stamp: 'mdr 3/15/2001 14:46'! defaultWindowTitle ^ 'Celeste email browser'! ! !Celeste class methodsFor: 'build-morphic' stamp: 'mdr 4/6/2001 21:25'! buildMorphicCategoryListFor: model ^(PluggableListMorphByItem on: model list: #categoryList selected: #category changeSelected: #setCategory: menu: #categoryMenu: keystroke: #categoriesKeystroke:) enableDragNDrop: true.! ! !Celeste class methodsFor: 'build-morphic' stamp: 'mdr 4/6/2001 12:36'! buildMorphicTocEntryListFor: model ^ (PluggableMultiColumnListMorphByItem on: model list: #tocEntryList selected: #tocEntry changeSelected: #setTOCEntry: menu: #tocMenu: keystroke: #tocKeystroke: ) enableDragNDrop: true.! ! !Celeste class methodsFor: 'accessing' stamp: 'mdr 3/15/2001 15:41'! messageCountLimit ^ MessageCountLimit! ! !CelesteComposition methodsFor: 'access' stamp: 'mdr 3/21/2001 17:28'! submit | message msgID | "submit the message" textEditor ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. message := MailMessage from: messageText asString. self breakLinesInMessage: message. msgID _ (celeste isActive ifTrue: [celeste] ifFalse: [Celeste current]) queueMessageWithText: message text. msgID ifNil: [^self]. "There was an error, so do not close" morphicWindow ifNotNil: [morphicWindow delete]. mvcWindow ifNotNil: [mvcWindow controller close]! ! !FancyCelesteComposition methodsFor: 'as yet unclassified' stamp: 'mdr 3/15/2001 14:21'! submit: sendNow | newMessageNumber personalCeleste windows | personalCeleste _ false. celeste ifNil: [ personalCeleste _ true. celeste _ Celeste open. ]. newMessageNumber _ celeste queueMessageWithText: ( self breakLines: self completeTheMessage atWidth: 999 ). sendNow ifTrue: [celeste sendMail: {newMessageNumber}]. personalCeleste ifTrue: [ windows _ SystemWindow windowsIn: self currentWorld satisfying: [ :each | each model == celeste]. celeste close. windows do: [ :each | each delete]. ]. self forgetIt. ! ! !IndexFileEntry methodsFor: 'testing' stamp: 'mdr 4/8/2001 21:33'! selfTestEquals: anIndexFileEntry "For testing and debugging purposes only, test whether the two entries are equivalent" #(messageFile msgID location from) do: [ :sel | [(self perform: sel) = (anIndexFileEntry perform: sel)] value ifFalse: [ Transcript cr. Transcript show: msgID printString, ' ', sel printString, ': ', (self perform: sel); cr. Transcript show: msgID printString, 'n', sel printString, ': ', (anIndexFileEntry perform: sel); cr. ]]. #(cc to subject) do: [ :sel | [(self perform: sel) withBlanksCondensed = (anIndexFileEntry perform: sel) withBlanksCondensed] value ifFalse: [ Transcript cr. Transcript show: msgID printString, ' ', sel printString, ': ', (self perform: sel); cr. Transcript show: msgID printString, 'n', sel printString, ': ', (anIndexFileEntry perform: sel); cr. ]]. "It could be that these are not absolutely identical, though they should be close" #(date time) do: [ :sel | (self perform: sel) = (anIndexFileEntry perform: sel) ifFalse: ["Transcript cr; show: msgID printString, ' ', sel printString, ':', (self perform: sel); cr"]]. [(self textLength - anIndexFileEntry textLength) abs <= 1] assert. ! ! !MailDB methodsFor: 'initialize-release' stamp: 'mdr 3/20/2001 19:16'! close "Close up the database in preparation for closing celeste" self saveDB. indexFile ifNotNil: [indexFile save]. messageFile ifNotNil: [messageFile close]. rootFilename _ nil. messageFile _ indexFile _ categoriesFile _ nil.! ! !MailDB methodsFor: 'open-create-save' stamp: 'mdr 3/22/2001 20:56'! dbStatus "See if my database exists. Since the database has several components, the answer is one of: #exists all files exist, and were created in the right order #partialDatabase only some of the files exist #doesNotExist none of the files exist" | dir localName messageFileExists indexFileExists categoriesFileExists messageFileTime categoriesFileTime | dir _ FileDirectory forFileName: rootFilename. localName _ FileDirectory localNameFor: rootFilename. messageFileExists _ dir includesKey: localName, '.messages'. indexFileExists _ dir includesKey: localName, '.index'. categoriesFileExists _ dir includesKey: localName, '.categories'. "Check if no parts of the database exist" (messageFileExists | indexFileExists | categoriesFileExists) ifFalse: [^ #doesNotExist]. "Check if the database was written in a normal sequence" (messageFileExists & indexFileExists & categoriesFileExists) ifTrue: [ messageFileTime _ (dir entryAt: localName, '.messages') modificationTime. categoriesFileTime _ (dir entryAt: localName, '.categories') modificationTime. "Unfortunately the strongest thing we can say is that the message file should be the oldest file on disk, and the categories file the newest" (messageFileTime <= categoriesFileTime) ifTrue: [^ #exists]. ]. ^ #partialDatabase ! ! !MailDB methodsFor: 'open-create-save' stamp: 'mdr 3/21/2001 17:10'! recoverDB "Open a mail database with the given root file name." (self confirm: 'The mail database named: ', rootFilename, ' appears to be damaged. Shall I fix it? (This might take some time)') ifFalse: [self release. ^nil]. self openDB. Cursor execute showWhile: [self compact].! ! !MailDB methodsFor: 'open-create-save' stamp: 'mdr 3/23/2001 13:59'! saveDB "Write all database files to disk." "Return quietly if the database is no longer in use" rootFilename isNil & messageFile isNil & indexFile isNil & categoriesFile isNil ifTrue: [^self]. Transcript show: 'Saving mail database ''' , (rootFilename ifNil: ['']) , '''...'. messageFile notNil ifTrue: [messageFile save]. "indexFile notNil ifTrue: [indexFile save]. Omitted because of incremental log file saving" categoriesFile notNil ifTrue: [categoriesFile save]. Transcript show: 'Done.'; cr! ! !MailDB methodsFor: 'fetch-import-export' stamp: 'mdr 3/22/2001 17:55'! fetchMessageCount: msgCount fromPOPConnection: popConnection doFormatting: doFormatting "Download the given number of messages from the given open POP3 connection. If doFormatting is true, messages will be formatted as they are received." | nextID msgText msg location | messageFile beginAppend. ('Downloading ', msgCount printString, ' messages...') displayProgressAt: Sensor mousePoint from: 0 to: msgCount during: [:progressBar | 1 to: msgCount do: [:messageNum | progressBar value: messageNum. popConnection isConnected ifFalse: [ popConnection destroy. "network error" messageFile endAppend. self saveDB. ^ self inform: 'Server connection unexpectedly closed.']. "get a message" msgText _ popConnection retrieveMessage: messageNum. nextID _ self nextUnusedID. "save that message" msg _ MailMessage from: msgText. doFormatting ifTrue: [msg format]. location _ messageFile basicAppend: msg text id: nextID. indexFile at: nextID put: (IndexFileEntry message: msg location: location messageFile: messageFile msgID: nextID). categoriesFile file: nextID inCategory: 'new'. ]]. messageFile endAppend. self saveDB. ! ! !MailDB methodsFor: 'fetch-import-export' stamp: 'mdr 3/22/2001 18:08'! fetchNewsFrom: inboxPathName doFormatting: doFormatting deleteInbox: deleteInbox "Append the messages from the given news inbox file to this mail database. Answer the number of messages fetched." | inbox nextID count msg location | "is there any news?" ((FileDirectory on: inboxPathName) includesKey: 'news') ifFalse: [^ 0]. inbox _ RNInboxFile openOn: inboxPathName, ':news'. count _ 0. messageFile beginAppend. inbox newsMessagesDo: [: newsgroup : msgText | msg _ MailMessage from: msgText. nextID _ self nextUnusedID. doFormatting ifTrue: [msg format]. location _ messageFile basicAppend: msg text id: nextID. indexFile at: nextID put: (IndexFileEntry message: msg location: location messageFile: messageFile msgID: nextID). categoriesFile file: nextID inCategory: newsgroup. categoriesFile file: nextID inCategory: 'new'. count _ count + 1]. messageFile endAppend. "snapshot the database and remove the inbox file" self saveDB. deleteInbox ifTrue: [inbox delete]. ^ count ! ! !MailDB methodsFor: 'fetch-import-export' stamp: 'mdr 3/22/2001 18:09'! importMailFrom: inboxFileName intoCategory: category "Append the messages from the given mail file to this mail database, and store them in the given category. Answer the number of messages imported." | inbox nextID count msg location | inbox _ MailInboxFile openOn: inboxFileName. count _ 0. messageFile beginAppend. inbox mailMessagesDo: [:msgText | msg _ MailMessage from: msgText. nextID _ self nextUnusedID. location _ messageFile basicAppend: msg text id: nextID. indexFile at: nextID put: (IndexFileEntry message: msg location: location messageFile: messageFile msgID: nextID). categoriesFile file: nextID inCategory: category. count _ count + 1]. messageFile endAppend. self saveDB. ^ count ! ! !MailDB methodsFor: 'housekeeping' stamp: 'mdr 4/9/2001 14:10'! copyUndeletedTo: newMsgFile indexFile: newIndexFile "Copy all the undeleted messages in my current message file into the new message file, recording their locations in the new index file. Also eliminates duplicate messageIDs. Answer an array containing with the number of messages and the number of bytes recovered, as well as the number of messages still remaining." | bufferLimit msgBuffer bufferSize deletedCount deletedBytes msgIDlist keptCount duplicateMsgCount | msgIDlist _ Set new: 10000. "Record of the msgIDs we have already processed" deletedCount _ deletedBytes _ 0. keptCount _ 0. duplicateMsgCount _ 0. "Note: To reduce disk seeks, messages are buffered and written in large batches. You may wish to tune the amount of buffering if you have a particular shortage or abundance of physical memory. bufferLimit is the approximate number of bytes of messages that will be accumulated before writing the buffered messages to disk." Smalltalk garbageCollect. msgBuffer _ OrderedCollection new: 1000. bufferLimit _ (Smalltalk primBytesLeft // 2) min: 2000000. bufferSize _ 0. newMsgFile beginAppend. messageFile messagesDo: [: deleted : msgID : msgText | (deleted) ifTrue: [deletedCount _ deletedCount + 1. deletedBytes _ deletedBytes + msgText size] ifFalse: [ (msgIDlist includes: msgID) ifTrue: [ "We have a duplicate msgID" "We only renumber if we have previously salvaged" "and thus know all of the existing message IDs" (canRenumberMsgIDs = true) ifTrue: [msgID _ self nextUnusedID] ifFalse: [duplicateMsgCount _ duplicateMsgCount + 1] ]. msgIDlist add: msgID. msgBuffer addLast: (Array with: msgID with: msgText). keptCount _ keptCount + 1. bufferSize _ bufferSize + msgText size. (bufferSize >= bufferLimit) ifTrue: [self appendMessages: msgBuffer messageFile: newMsgFile indexFile: newIndexFile. msgBuffer _ OrderedCollection new: 1000. bufferSize _ 0]]]. "flush remaining buffered messages" self appendMessages: msgBuffer messageFile: newMsgFile indexFile: newIndexFile. newMsgFile endAppend. (canRenumberMsgIDs = true) ifTrue: [ canRenumberMsgIDs _ nil. "We're now done with renumbering duplicate IDs" [duplicateMsgCount = 0] assert. ]. duplicateMsgCount > 0 ifTrue: [ canRenumberMsgIDs _ true. "Allow renumbering duplicate IDs next time around" lastIssuedMsgID _ nil. "Ensure it is later initialized by nextUnusedID" self inform: 'Warning: ', duplicateMsgCount printString, ' duplicate msgIDs were found.', String cr, 'Please use "salvage & compact" again to replace them with the correct unique IDs'. ]. "return statistics" ^Array with: deletedCount with: deletedBytes with: keptCount! ! !MailDB methodsFor: 'housekeeping' stamp: 'mdr 4/9/2001 13:05'! nextUnusedID "Answer the next unused message identifier number." "Each message needs to have a unique ID. Message ID's are a monotonically increasing integers roughly related to the time that they were requested. The last ID used is kept in lastIssuedMsgID, to guard against reuse (e.g. if the clock changes)." | id | (lastIssuedMsgID isNil) ifTrue: [ "find the largest msgID currently in this database" lastIssuedMsgID _ 0. indexFile keys do: [ :msgID | lastIssuedMsgID _ lastIssuedMsgID max: msgID]. ]. "message ID's are roughly the number of seconds since the beginning of 1980" id _ Date today asSeconds + Time now asSeconds - (Date newDay: 1 year: 1980) asSeconds. id _ id max: (lastIssuedMsgID + 1). "never go backwards!!" lastIssuedMsgID _ id. ^ id "MailDB someInstance nextUnusedID"! ! !MailDB methodsFor: 'testing' stamp: 'mdr 3/30/2001 15:38'! selfTest "This is purely for testing purposes. It checks out various things to make sure that everything is well formed and looks as it should" | msgIDlist delCount goodCount msg dupid msgTextFromID indexEntry testEntry | msgIDlist _ Set new: 10000. delCount _ goodCount _ 0. dupid _ 0. messageFile messagesDo: [ :deleted :msgID :msgBody | deleted ifTrue: [ delCount _ delCount + 1 ] ifFalse: [ goodCount _ goodCount + 1 ]. (msgIDlist includes: msgID) ifTrue: [dupid _ dupid + 1] ifFalse: [deleted ifFalse: [msgIDlist add: msgID]]. "Try creating a formated version of the message from it's raw text" msg _ MailMessage from: msgBody. msg selfTest. deleted ifFalse: [ "Check that this message is the same as what the index provides" msgTextFromID _ self getText: msgID. [msgTextFromID = msgBody] assert. "Check that the index entry is equivalent" indexEntry _ indexFile at: msgID. testEntry _ IndexFileEntry message: msg location: indexEntry location messageFile: messageFile msgID: msgID. indexEntry selfTestEquals: testEntry. ]]. Transcript cr; show: 'Dup:', dupid asString, ' del:', delCount asString, ' good:', goodCount asString; cr. "MailDB someInstance selfTest"! ! !MailDBFile methodsFor: 'file operations' stamp: 'mdr 3/20/2001 19:10'! save "Atomically save a representation of this object to its file. The old file is renamed to '.bak' before the new file is written. If the write operation fails, the old file may be restored by renaming it. If it succeeds, the .bak file is deleted." "create the file if it doesn't already exist" | f dir shortName | (StandardFileStream fileNamed: filename) close. "ensure it exists" shortName _ FileDirectory localNameFor: filename. dir _ FileDirectory forFileName: filename. dir rename: shortName toBe: shortName , '.bak'. Cursor write showWhile: [ f _ FileStream fileNamed: filename. self writeOn: f. f setToEnd; close ]. dir deleteFileNamed: shortName , '.bak' ifAbsent: []! ! !CategoriesFile methodsFor: 'categories access' stamp: 'mdr 3/31/2001 08:31'! file: messageID inCategory: categoryName "Add the given message ID to the given category. The target category must be a real category, not a pseudo-category." (categoryName = '.unclassified.') | (categoryName = '.all.') ifTrue: [^ self]. self addCategory: categoryName. (categories at: categoryName) add: messageID! ! !CategoriesFile methodsFor: 'categories access' stamp: 'mdr 3/17/2001 10:47'! renameCategory: oldName to: newName "Rename the given category." | oldEntry | "can't rename a special category or overwrite an existing one" (oldName = '.all.') | (oldName = '.unclassified.') | (self categories includes: newName) ifTrue: [^ self]. oldEntry _ categories removeKey: oldName ifAbsent: [PluggableSet integerSet]. categories at: newName put: oldEntry! ! !MailMessage methodsFor: 'initialize-release' stamp: 'mdr 3/20/2001 11:46'! from: aString "Parse aString to initialize myself." | parseStream contentType bodyText contentTransferEncoding | text _ aString withoutTrailingBlanks, String cr. parseStream _ ReadStream on: text. contentType _ 'text/plain'. contentTransferEncoding _ nil. fields := Dictionary new. "Extract information out of the header fields" self fieldsFrom: parseStream do: [:fName :fValue | "NB: fName is all lowercase" fName = 'content-type' ifTrue: [contentType _ (fValue copyUpTo: $;) asLowercase]. fName = 'content-transfer-encoding' ifTrue: [contentTransferEncoding _ fValue asLowercase]. (fields at: fName ifAbsentPut: [OrderedCollection new: 1]) add: (MIMEHeaderValue fromString: fValue)]. "Extract the body of the message" bodyText _ parseStream upToEnd. contentTransferEncoding = 'base64' ifTrue: [bodyText _ Base64MimeConverter mimeDecodeToChars: (ReadStream on: bodyText). bodyText _ bodyText contents]. contentTransferEncoding = 'quoted-printable' ifTrue: [bodyText _ bodyText decodeQuotedPrintable]. body _ MIMEDocument contentType: contentType content: bodyText! ! !MailMessage methodsFor: 'initialize-release' stamp: 'ls 3/18/2001 16:20'! setField: fieldName to: aFieldValue "set a field. If any field of the specified name exists, it will be overwritten" fields at: fieldName asLowercase put: (OrderedCollection with: aFieldValue). text := nil.! ! !MailMessage methodsFor: 'access' stamp: 'ls 3/18/2001 16:34'! cc ^self fieldsNamed: 'cc' separatedBy: ', '! ! !MailMessage methodsFor: 'access' stamp: 'ls 3/18/2001 16:27'! fields "return the internal fields structure. This is private and subject to change!!" ^ fields! ! !MailMessage methodsFor: 'access' stamp: 'mdr 3/21/2001 15:28'! from ^(self fieldNamed: 'from' ifAbsent: [ ^'' ]) mainValue! ! !MailMessage methodsFor: 'access' stamp: 'ls 3/18/2001 16:26'! name "return a default name for this part, if any was specified. If not, return nil" | type nameField disposition | "try in the content-type: header" type _ self fieldNamed: 'content-type' ifAbsent: [nil]. (type notNil and: [(nameField _ type parameters at: 'name' ifAbsent: [nil]) notNil]) ifTrue: [^ nameField]. "try in content-disposition:" disposition _ self fieldNamed: 'content-disposition' ifAbsent: [nil]. (disposition notNil and: [(nameField _ disposition parameters at: 'filename' ifAbsent: [nil]) notNil]) ifTrue: [^ nameField]. "give up" ^ nil! ! !MailMessage methodsFor: 'access' stamp: 'ls 3/18/2001 16:24'! subject ^(self fieldNamed: 'subject' ifAbsent: [ ^'' ]) mainValue! ! !MailMessage methodsFor: 'access' stamp: 'mdr 4/7/2001 17:48'! time | dateField | dateField := (self fieldNamed: 'date' ifAbsent: [ ^0 ]) mainValue. ^ [self timeFrom: dateField] ifError: [:err :rcvr | Date today asSeconds]. ! ! !MailMessage methodsFor: 'access' stamp: 'ls 3/18/2001 16:35'! to ^self fieldsNamed: 'to' separatedBy: ', '! ! !MailMessage methodsFor: 'parsing' stamp: 'mdr 3/15/2001 18:46'! fieldsFrom: aStream do: aBlock "Invoke the given block with each of the header fields from the given stream. The block arguments are the field name and value. The streams position is left right after the empty line separating header and body." | savedLine line s | savedLine _ MailDB readStringLineFrom: aStream. [aStream atEnd] whileFalse: [ line _ savedLine. (line isEmpty) ifTrue: [^self]. "quit when we hit a blank line" [savedLine _ MailDB readStringLineFrom: aStream. (savedLine size > 0) and: [savedLine first isSeparator]] whileTrue: [ "lines starting with white space are continuation lines" s _ ReadStream on: savedLine. s skipSeparators. line _ line, ' ', s upToEnd]. self reportField: line withBlanksTrimmed to: aBlock]. "process final header line of a body-less message" (savedLine isEmpty) ifFalse: [self reportField: savedLine withBlanksTrimmed to: aBlock]. ! ! !MailMessage methodsFor: 'parsing' stamp: 'mdr 4/7/2001 17:46'! timeFrom: aString "Parse the date and time (rfc822) and answer the result as the number of seconds since the start of 1980." | s t rawDelta delta | s _ ReadStream on: aString. "date part" t _ ((self readDateFrom: s) ifNil: [Date today]) asSeconds. [s atEnd or: [s peek isAlphaNumeric]] whileFalse: [s next]. "time part" s atEnd ifFalse: ["read time part (interpreted as local, regardless of sender's timezone)" (s peek isDigit) ifTrue: [t _ t + (Time readFrom: s) asSeconds]. ]. s skipSeparators. "Check for a numeric time zone offset" ('+-' includes: s peek) ifTrue: [s next. "Skip the +/-" rawDelta _ (s peek isDigit) ifTrue: [Integer readFrom: s] ifFalse: [0]. delta _ rawDelta // 100 * 60 + (rawDelta \\ 100). t _ t - (delta * 60)]. "We ignore text time zone offsets like EST, GMT, etc..." ^ t - (Date newDay: 1 year: 1980) asSeconds "MailMessage new timeFrom: 'Thu, 22 Jun 2000 14:17:47 -500'" "MailMessage new timeFrom: 'Thu, 22 Jun 2000 14:17:47 --500'" "MailMessage new timeFrom: 'on, 04 apr 2001 14:57:32'"! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'mdr 3/19/2001 09:56'! cleanedHeader "Reply with a cleaned up version email header. First show fields people would normally want to see (in a regular order for easy browsing), and then any other fields not explictly excluded" | new priorityFields omittedFields | new _ WriteStream on: (String new: text size). priorityFields _ #('Date' 'From' 'Subject' 'To' 'Cc'). omittedFields _ MailMessage omittedHeaderFields. "Show the priority fields first, in the order given in priorityFields" priorityFields do: [ :pField | "We don't check whether the priority field is in the omitted list!!" self headerFieldsNamed: pField do: [: fValue | new nextPutAll: pField, ': ', fValue; cr]]. "Show the rest of the fields, omitting the uninteresting ones and ones we have already shown" omittedFields _ omittedFields, priorityFields. self fieldsFrom: (ReadStream on: text) do: [: fName : fValue | ((fName beginsWith: 'x-') or: [omittedFields anySatisfy: [: omitted | fName sameAs: omitted]]) ifFalse: [new nextPutAll: fName, ': ', fValue; cr]]. ^new contents! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'ls 3/18/2001 16:27'! regenerateText "regenerate the full text from the body and headers" | encodedBodyText | text := String streamContents: [ :str | "first put the header" fields keysAndValuesDo: [ :fieldName :fieldValues | fieldValues do: [ :fieldValue | str nextPutAll: fieldName capitalized ; nextPutAll: ': '; nextPutAll: fieldValue asHeaderValue; cr ]. ]. "skip a line between header and body" str cr. "put the body, being sure to encode it according to the header" encodedBodyText := body content. self decoderClass ifNotNil: [ encodedBodyText := (self decoderClass mimeEncode: (ReadStream on: encodedBodyText)) upToEnd ]. str nextPutAll: encodedBodyText ].! ! !MailMessage methodsFor: 'multipart' stamp: 'mdr 3/22/2001 09:06'! attachmentSeparator ^(self fieldNamed: 'content-type' ifAbsent: [^nil]) parameters at: 'boundary' ifAbsent: [^nil]! ! !MailMessage methodsFor: 'multipart' stamp: 'ls 3/18/2001 16:26'! decoderClass | encoding | encoding _ self fieldNamed: 'content-transfer-encoding' ifAbsent: [^ nil]. encoding _ encoding mainValue. encoding asLowercase = 'base64' ifTrue: [^ Base64MimeConverter]. encoding asLowercase = 'quoted-printable' ifTrue: [^ QuotedPrintableMimeConverter]. ^ nil! ! !MailMessage methodsFor: 'multipart' stamp: 'mdr 3/22/2001 19:35'! makeMultipart "if I am not multipart already, then become a multipart message with one part" | part multipartHeader | body isMultipart ifTrue: [ ^self ]. "set up the new message part" part := MailMessage empty. part body: body. (self hasFieldNamed: 'content-type') ifTrue: [ part setField: 'content-type' to: (self fieldNamed: 'content-type' ifAbsent: ['']) ]. parts := Array with: part. "fix up our header" multipartHeader := MIMEHeaderValue fromString: 'multipart/mixed'. multipartHeader parameterAt: 'boundary' put: self class generateSeparator . self setField: 'content-type' to: multipartHeader. self setField: 'mime-version' to: (MIMEHeaderValue fromString: '1.0'). self removeFieldNamed: 'content-transfer-encoding'. "regenerate everything" self regenerateBodyFromParts. text := nil.! ! !MailMessage methodsFor: 'multipart' stamp: 'mdr 3/23/2001 13:30'! parseParts "private -- parse the parts of the message and store them into a collection" | parseStream msgStream messages separator | "If this is not multipart, store an empty collection" self body isMultipart ifFalse: [parts _ #(). ^self]. "If we can't find a valid separator, handle it as if the message is not multipart" separator := self attachmentSeparator. separator ifNil: [Transcript show: 'Ignoring bad attachment separater'; cr. parts _ #(). ^self]. separator := '--', separator withoutTrailingBlanks. parseStream _ ReadStream on: self bodyText. msgStream _ LimitingLineStreamWrapper on: parseStream delimiter: separator. msgStream limitingBlock: [:aLine | aLine withoutTrailingBlanks = separator or: "Match the separator" [aLine withoutTrailingBlanks = (separator, '--')]]. "or the final separator with --" "Throw away everything up to and including the first separator" msgStream upToEnd. msgStream skipThisLine. "Extract each of the multi-parts as strings" messages _ OrderedCollection new. [parseStream atEnd] whileFalse: [messages add: msgStream upToEnd. msgStream skipThisLine]. parts _ messages collect: [:e | MailMessage from: e]! ! !MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:32'! fieldNamed: aString ifAbsent: aBlock | matchingFields | "return the value of the field with the specified name. If there is more than one field, then return the first one" matchingFields := fields at: aString asLowercase ifAbsent: [ ^aBlock value ]. ^matchingFields first! ! !MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:21'! fieldsNamed: aString ifAbsent: aBlock "return a list of all fields with the given name" ^fields at: aString asLowercase ifAbsent: aBlock! ! !MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:36'! fieldsNamed: aString separatedBy: separationString "return all fields with the specified name, concatenated together with separationString between each element. Return an empty string if no fields with the specified name are present" | matchingFields | matchingFields := self fieldsNamed: aString ifAbsent: [ ^'' ]. ^String streamContents: [ :str | matchingFields do: [ :field | str nextPutAll: field mainValue ] separatedBy: [ str nextPutAll: separationString ]]. ! ! !MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:28'! hasFieldNamed: aString ^fields includesKey: aString asLowercase! ! !MailMessage methodsFor: 'fields' stamp: 'ls 3/18/2001 16:30'! removeFieldNamed: name "remove all fields with the specified name" fields removeKey: name ifAbsent: []! ! !MailMessage methodsFor: 'testing' stamp: 'mdr 3/30/2001 13:55'! selfTest "Check that this instance is well formed and makes sense" true ifTrue: [self formattedText]. [MailAddressParser addressesIn: self from] ifError: [ :err :rcvr | Transcript show: 'Error parsing From: ', err]. [MailAddressParser addressesIn: self to] ifError: [ :err :rcvr | Transcript show: 'Error parsing To: ', err]. [MailAddressParser addressesIn: self cc] ifError: [ :err :rcvr | Transcript show: 'Error parsing CC: ', err]. ! ! !MailMessage class methodsFor: 'preferences' stamp: 'mdr 3/19/2001 10:02'! omittedHeaderFields "Reply a list of fields to omit when displaying a nice simple message" "Note that heads of the form X-something: value are filtered programatically. This is done since we don't want any of them and it is impossible to predict them in advance." ^ #( 'comments' 'priority' 'disposition-notification-to' 'content-id' 'received' 'return-path' 'newsgroups' 'message-id' 'path' 'in-reply-to' 'sender' 'fonts' 'mime-version' 'status' 'content-type' 'content-transfer-encoding' 'errors-to' 'keywords' 'references' 'nntp-posting-host' 'lines' 'return-receipt-to' 'precedence' 'originator' 'distribution' 'content-disposition' 'importance' 'resent-to' 'resent-cc' 'resent-message-id' 'resent-date' 'resent-sender' 'resent-from' ) ! ! !MailMessage class methodsFor: 'testing' stamp: 'mdr 3/21/2001 15:59'! selfTest | msgText msg | msgText _ 'Date: Tue, 20 Feb 2001 13:52:53 +0300 From: mdr@scn.rg (Me Ru) Subject: RE: Windows 2000 on your laptop To: "Greg Y" cc: cc1@scn.org, cc1also@test.org To: to2@no.scn.org, to2also@op.org cc: cc2@scn.org Hmmm... Good. I will try to swap my German copy for something in English, and then do the deed. Oh, and expand my RAM to 128 first. Mike '. msg _ self new from: msgText. [msg text = msgText] assert. [msg subject = 'RE: Windows 2000 on your laptop'] assert. [msg from = 'mdr@scn.rg (Me Ru)'] assert. [msg date = '2/20/01'] assert. [msg time = 667133573] assert. "[msg name] assert." [msg to = '"Greg Y" , to2@no.scn.org, to2also@op.org'] assert. [msg cc = 'cc1@scn.org, cc1also@test.org, cc2@scn.org'] assert. "MailMessage selfTest" ! ! !MessageFile methodsFor: 'message operations' stamp: 'mdr 12/24/2000 18:32'! assertValidMessageAt: filePosition id: msgID "Verify that the given filePosition is, indeed, the start of a valid undeleted message with the given ID and raise an error if this assertion is false." | delimiter fileMsgID | "assume file is open" file position: filePosition. delimiter _ file next: 11. (delimiter = ('&&&&&start', String cr)) ifFalse: [^self reportInconsistency]. fileMsgID _ MailDB readIntegerLineFrom: file. (msgID = fileMsgID) ifFalse: [^self reportInconsistency]. ^true.! ! !MessageFile methodsFor: 'message operations'! basicAppend: messageText id: messageID "Append the given message text with the given message ID. Answer the new location of the message." "WARNING: This operation assumes: 1. the sender positioned the stream to the end of the file (using beginAppend), and 2. the sender will do an endAppend operation after all messages are appended to flush all file buffers to disk." | location | file setToEnd. location _ file position. file nextPutAll: '&&&&&start'. "message delimiter" file cr. messageID printOn: file. "message ID" file cr. file nextPutAll: messageText. ^location! ! !MessageFile methodsFor: 'message operations' stamp: 'mdr 12/24/2000 01:14'! deleteMessageAt: filePosition id: msgID "Mark as deleted the message with the given ID located at the given file position." self ensureFileIsOpen. (self assertValidMessageAt: filePosition id: msgID) ifFalse: [^false]. "Don't delete if it looks like we have a problem" file position: filePosition. file nextPutAll: '&&&&&XXXXX'. "delimiter for deleted messages" file flush.! ! !MessageFile methodsFor: 'message operations' stamp: 'mdr 3/23/2001 17:25'! scanToNextAndSigns: aStream "Scan the stream for 5 consecutive and-sign (&) characters. If they are found, position the stream at the start of the and-signs and answer true. Answer false if the end of the stream is reached" | chunk index blocksize target | target _ '&&&&&'. blocksize _ 4000. "Must be more than target size :-)" "Quickly skip over sections that do not have and-signs." index _ 0. [index = 0] whileTrue: [chunk _ aStream next: blocksize. chunk size = 0 ifTrue: [^false]. "end of file" index _ chunk findString: target. "Handle the yucky case where the target might be split between this block and the next. We back up a bit before continuing. We back up 4, since the whole target is clearly not there" (index = 0 and: [chunk size = blocksize]) ifTrue: [aStream skip: -4]. ]. "We found some &s, so position the stream to read it" aStream skip: (chunk size - index + 1) negated. [aStream peek = $&] assert. ^true ! ! !MessageFile methodsFor: 'scanning' stamp: 'mdr 3/16/2001 19:50'! scanToNextMessageIn: aStream "Scan to the start of the next message. Answer true if we find a message delimiter, false if we hit the end of the file first. The stream is left positioned at the start of the next message (at the message delimiter) or at the end of the stream." | delimiter | [self scanToNextAndSigns: aStream] whileTrue: [delimiter _ aStream next: 10. ((delimiter = '&&&&&start') or: [delimiter = '&&&&&XXXXX']) ifTrue: [aStream skip: -10. ^true] ifFalse: [aStream skip: -5] "Keep going - it was't a delimiter" ]. ^false "end of file"! ! !POPSocket methodsFor: 'low-level protocol' stamp: 'mdr 3/15/2001 19:08'! connectToPOP "connect to the POP server" | address response | Socket initializeNetwork. address _ NetNameResolver addressForName: serverName timeout: 15. address = nil ifTrue: [ self error: 'Could not find host address']. "connect the socket" self connectTo: address port: 110. (self waitForConnectionUntil: POPSocket standardDeadline) ifFalse: [ self close. self reportToObservers: 'failed to connect to server'. ^false ]. "get a hello message" self reportToObservers: (response _ self getResponse). (response beginsWith: '+') ifFalse: [ self disconnectFromPOP. ^false ]. "Try to do a secure authentication." (self trySecureAuthentication: response) ifTrue: [^true]. "If we can't, then fall back on a traditional password authentication" (self tryCleartextLogin) ifTrue: [^true]. "Neither authentication worked. Indicate an error and close up" self disconnectFromPOP. self error: 'unable to authenticate ourselves to the POP server'. ^false.! ! !POPSocket methodsFor: 'low-level protocol' stamp: 'mdr 2/23/2001 08:08'! deleteMessage: num "delete the numbered message" | response | self sendCommand: 'DELE ', num printString. self reportToObservers: (response _ self getResponse). (response beginsWith: '+') ifFalse: [ self disconnectFromPOP ]. ! ! !POPSocket methodsFor: 'low-level protocol' stamp: 'mdr 3/15/2001 17:04'! tryCleartextLogin "Authenticate ourselves to the POP server with cleartext username and password" | response | self sendCommand: 'USER ', userName. self reportToObservers: (response _ self getResponse). (response beginsWith: '+') ifFalse: [ ^false ]. self sendCommand: 'PASS ', password. self reportToObservers: (response _ self getResponse). (response beginsWith: '+') ifFalse: [ ^false ]. ^true! ! !POPSocket methodsFor: 'low-level protocol' stamp: 'mdr 2/23/2001 22:43'! trySecureAuthentication: aResponse "Attempt to authenticate ourselves to the server without sending the password as cleartext." "For secure authentication, we look for a timestamp in the initial response string we get from the server, and then try the APOP command as specified in RFC 1939. If the initial response from the server is +OK POP3 server ready <1896.697170952@dbc.mtview.ca.us> we extract the timestamp <1896.697170952@dbc.mtview.ca.us> then form a string of the form <1896.697170952@dbc.mtview.ca.us>USERPASSWORD and then send only the MD5 hash of that to the server. Thus the password never hits the wire" | timestamp hash response md5Class | (Smalltalk includesKey: #MD5) ifFalse: [^false]. "Stop here if there is no MD5 available" md5Class _ Smalltalk at: #MD5. "Look for a timestamp in the response we received from the server" timestamp _ aResponse findTokens: '<>' includes: '@'. timestamp isNil ifTrue: [^false]. hash _ (md5Class hashMessage: ('<', timestamp, '>', password)) hex asLowercase. hash _ hash copyFrom: 4 to: hash size. "NB: trim unwanted 16r from start" self sendCommand: 'APOP ', userName, ' ', hash. self reportToObservers: (response _ self getResponse). (response beginsWith: '+') ifFalse: [ ^false ]. ^true ! ! String removeSelector: #normalizedSubject! !POPSocket class reorganize! ('examples' example) ! POPSocket removeSelector: #deleteAllMessages! !MessageFile reorganize! ('file operations' close delete ensureFileIsOpen openOn: rename: save) ('message operations' append:id: assertValidMessageAt:id: basicAppend:id: beginAppend deleteMessageAt:id: endAppend getMessage:at:textLength: scanToNextAndSigns: update:at:id:) ('scanning' messagesDo: scanToNextMessageIn:) ! MailDB removeSelector: #consolidateDB! Model subclass: #MailDB instanceVariableNames: 'rootFilename messageFile indexFile categoriesFile canRenumberMsgIDs lastIssuedMsgID ' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'! Celeste class removeSelector: #addMVCMailSenderButtons:textView:! Celeste class removeSelector: #addMessageToInbox:! Celeste class removeSelector: #compileAllCustomFilters! Celeste initialize! Celeste class removeSelector: #initializeMessageCountLimit! Celeste class removeSelector: #maxMessageCountUpperBound! Celeste class removeSelector: #postLoadOperationsForEnhancements! Celeste class removeSelector: #postReadMeEnhancements! Celeste class removeSelector: #readMeEnhancementsString! !Celeste class reorganize! ('class initialization' initialize versionString) ('instance creation' current open openOn:) ('user preferences' ccList popServer popUserName setCCList setPopServer setPopUserName setSmtpServer setTimeZone setUserName smtpServer userName userTimeZone) ('sending' eudoraSeparator) ('options' includeStatusPane showAttachmentsFlag) ('common build' buildButtonFromSpec:forModel: buildButtonFromSpec:withBlock: buildButtonsFor: buildFromFilterButtonForModel: openOnDatabase: specificationFromList:at:) ('button specs' specForComposeButton specForCustomFilterButton specForCustomFilterMoveButton specForDeleteButton specForForwardButton specForMoveAgainButton specForParticipantFilterButton specForReplyButton specForSubjectFilterButton) ('build-common' defaultWindowTitle) ('build-mvc' addMVCViews:andButtons:to: buildTopMVCWindowTitled:model: buildViewsFor:) ('build-morphic' addLowerMorphicViews:andButtons:to:offset: addMorphicButtons:to:at:plus: addMorphicStatusPaneTo:from:at:plus: addMorphicTextPaneTo:from:at:plus: addMorphicViews:andButtons:to: buildMorphicCategoryListFor: buildMorphicMessageTextPaneFor: buildMorphicOutBoxStatusPaneFor: buildMorphicStatusPaneFor: buildMorphicTocEntryListFor: buildMorphicViewsFor: buildTopMorphicWindowTitled:model: morphicButtonRowFrom: morphicButtonsClass) ('accessing' messageCountLimit messageCountLimit:) ('filters' makeFilterFor:) ! Celeste removeSelector: #PROTOqueueMessageWithText:! Celeste removeSelector: #PROTOsendQueuedMail! Celeste removeSelector: #deleteMessagesAfterFetching! Celeste removeSelector: #keepMessagesOnServer! Celeste removeSelector: #maxMessageCount! Celeste removeSelector: #messageMenu! Celeste removeSelector: #selectMessage:! Celeste removeSelector: #subjectFilterOff! Celeste removeSelector: #subjectFilterOn:! Celeste removeSelector: #tocLists:! Model subclass: #Celeste instanceVariableNames: 'mailDB currentCategory currentMessages currentMsgID lastCategory subjectFilter fromFilter participantFilter dateFilter customFilterBlock lastCategoryList lastCategoryMenu messageTextView userPassword status tocLists ' classVariableNames: 'CCList CustomFilters CustomFiltersCompiled DeleteInboxAfterFetching FormatWhenFetching MessageCountLimit PopServer PopUserName SmtpServer SuppressWorthlessHeaderFields TimeZone UserName ' poolDictionaries: '' category: 'Network-Mail Reader'! !Celeste reorganize! ('open-close' close isActive openOnDatabase: windowIsClosing) ('drag and drop' acceptDroppingMorph:event:inMorph: dragPassengerFor:inMorph: dragTransferTypeForMorph: wantsDroppedMorph:event:inMorph:) ('categories pane' addCategory cacheTOC categoriesKeystroke: category categoryList categoryMenu: compact emptyTrash exportCategory exportCategoryUnix fetchMail findDuplicates importIntoCategory maxMessagesToDisplay messages:from: messagesOnServerString nextCategory previousCategory removeCategory renameCategory save setCCList setCategory: setPopServer setPopUserName setSmtpServer setUserName suppressingHeadersString toggleKeepMessagesOnServer toggleSuppressHeaders viewAllMessages) ('table of contents pane' autoFile autoMove deleteAll deleteMessage fileAgain fileAll fileMessage getCategoryNameIfNone: moveAgain moveAll moveMessage msgIDFromTOCEntry: nextMessage otherCategories partsMenu previousMessage removeAll removeMessage saveMessage search setTOCEntry: tocEntry tocEntryList tocKeystroke: tocMenu: updateTOC) ('filtering' chooseFilterFor:from: chooseFilterForCurrentMessage customFilterMove customFilterNamed: customFilterOff customFilterOn defineFilter deleteFilter editCategoryFilter editFilter editFilterNamed: editFilterNamed:filterExpr: filterNames filteredMessagesIn: filtersFor:from: fromFilterOff fromFilterOn: isCustomFilterOn isParticipantFilterOn isSubjectFilterOn makeFilterFor: normalizedSubject: participantFilterOn selectFilterFrom: subjectFilterOn) ('message text pane' compose doItContext doItReceiver format formatedMessageText forward message messageMenu:shifted: messageText messageText: messageTextView: reply) ('other' changeMaxMessageCount clearUserEditFlag currentMessage okToChange outBoxStatus perform:orSendTo: requiredCategory: status status:) ('sending mail' composeText forwardTextFor: openSender: popPassword preSendAuthentication queueMessageWithText: replyTextFor: sendMail: sendQueuedMail timeZoneString) ('initialize variables' initializeTocLists) ('accessing' tocLists) !