"Change Set: mailMsg-ls Date: 10 February 2001 Author: Lex Spoon Major MailMessage cleanup: 1. Multipart messages are formatted with the final '--' 2. Headers don't get lowercased as often. 3. MailMessage and MIMEPart are integrated -- a part of a multipart message *is* itself a message. 4. The caching for certain headers like Subject and From is removed, because the fields ivar caches *all* headers nowadays, and because those headers don't make sense for message parts. 5. Base64 encoding breaks its output into reasonably short lines. 6. Line breaking for regular messages is fixed up, so that headers aren't reformatted and so that non-text messages are completely left alone. Somewhere along the way, attachment filenames started working again."! Model subclass: #CelesteComposition instanceVariableNames: 'celeste messageText textEditor attachmentSeparator morphicWindow mvcWindow ' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'! !MIMEPart commentStamp: 'ls 2/10/2001 13:50' prior: 0! Not currently in use. This once held a part of a miltipart MailMessage, but now those parts are themselves full MailMessages.! Object subclass: #MailMessage instanceVariableNames: 'time from to cc subject text body fields parts separator ' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'! !MailMessage commentStamp: 'ls 2/10/2001 12:29' 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 MIMEHeaderValue's parts - if I am a multipart message, then this is a cache of my parts! !Base64MimeConverter methodsFor: 'conversion' stamp: 'ls 2/10/2001 13:26'! mimeEncode "Convert from data to 6 bit characters." | phase1 phase2 raw nib lineLength | phase1 _ phase2 _ false. lineLength := 0. [dataStream atEnd] whileFalse: [ lineLength >= 70 ifTrue: [ mimeStream cr. lineLength := 0. ]. data _ raw _ dataStream next asInteger. nib _ (data bitAnd: 16rFC) bitShift: -2. mimeStream nextPut: (ToCharTable at: nib+1). (raw _ dataStream next) ifNil: [raw _ 0. phase1 _ true]. data _ ((data bitAnd: 3) bitShift: 8) + raw asInteger. nib _ (data bitAnd: 16r3F0) bitShift: -4. mimeStream nextPut: (ToCharTable at: nib+1). (raw _ dataStream next) ifNil: [raw _ 0. phase2 _ true]. data _ ((data bitAnd: 16rF) bitShift: 8) + (raw asInteger). nib _ (data bitAnd: 16rFC0) bitShift: -6. mimeStream nextPut: (ToCharTable at: nib+1). nib _ (data bitAnd: 16r3F). mimeStream nextPut: (ToCharTable at: nib+1). lineLength := lineLength + 4.]. phase1 ifTrue: [mimeStream skip: -2; nextPut: $=; nextPut: $=. ^ mimeStream]. phase2 ifTrue: [mimeStream skip: -1; nextPut: $=. ^ mimeStream]. ! ! !CelesteComposition methodsFor: 'private' stamp: 'ls 2/10/2001 13:57'! breakLines: aString atWidth: width "break lines in the given string into shorter lines" | result start end atAttachment | result _ WriteStream on: (String new: (aString size * 50 // 49)). atAttachment _ false. aString asString linesDo: [ :line | (line beginsWith: '====') ifTrue: [ atAttachment _ true ]. atAttachment ifTrue: [ "at or after an attachment line; no more wrapping for the rest of the message" result nextPutAll: line. result cr ] ifFalse: [ (line beginsWith: '>') ifTrue: [ "it's quoted text; don't wrap it" result nextPutAll: line. result cr. ] ifFalse: [ "regular old line. Wrap it to multiple lines" start _ 1. "output one shorter line each time through this loop" [ start + width <= line size ] whileTrue: [ "find the end of the line" end _ start + width - 1. [end >= start and: [ (line at: (end+1)) isSeparator not ]] whileTrue: [ end _ end - 1 ]. end < start ifTrue: [ "a word spans the entire width!!" end _ start + width - 1 ]. "copy the line to the output" result nextPutAll: (line copyFrom: start to: end). result cr. "get ready for next iteration" start _ end+1. (line at: start) isSeparator ifTrue: [ start _ start + 1 ]. ]. "write out the final part of the line" result nextPutAll: (line copyFrom: start to: line size). result cr. ]. ]. ]. ^result contents! ! !CelesteComposition methodsFor: 'private' stamp: 'ls 2/10/2001 14:08'! breakLinesInMessage: message "reformat long lines in the specified message into shorter ones" message body mainType = 'text' ifTrue: [ "it's a single-part text message. reformat the text" | newBodyText | newBodyText := self breakLines: message bodyText atWidth: 72. message body: (MIMEDocument contentType: message body contentType content: newBodyText). ^self ]. message body isMultipart ifTrue: [ "multipart message; process the top-level parts. HACK: the parts are modified in place" message parts do: [ :part | part body mainType = 'text' ifTrue: [ | newBodyText | newBodyText := self breakLines: part bodyText atWidth: 72. part body: (MIMEDocument contentType: part body contentType content: newBodyText) ] ]. message regenerateBodyFromParts. ].! ! !CelesteComposition methodsFor: 'access' stamp: 'ls 2/10/2001 14:07'! submit | message | "submit the message" textEditor ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. message := MailMessage from: messageText asString. self breakLinesInMessage: message. celeste queueMessageWithText: message text. morphicWindow ifNotNil: [morphicWindow delete]. mvcWindow ifNotNil: [mvcWindow controller close]! ! !CelesteComposition methodsFor: 'interface' stamp: 'ls 2/10/2001 13:29'! addAttachment | file fileResult fileName | textEditor ifNotNil: [self hasUnacceptedEdits ifTrue: [textEditor accept]]. (fileResult _ StandardFileMenu oldFile) ifNotNil: [fileName _ fileResult directory fullNameFor: fileResult name. file _ FileStream readOnlyFileNamed: fileName. file ifNotNil: [file binary. self messageText: ((MailMessage from: self messageText asString) addAttachmentFrom: file withName: fileResult name; text)]] ! ! !ChangeSet methodsFor: 'fileIn/Out' stamp: 'ls 2/10/2001 16:35'! mailOut "File out the receiver, to a file whose name is a function of the change-set name and either of the date & time or chosen to have a unique numeric tag, depending on the preference 'sequentialChangeSetRevertableFileNames'." | subjectPrefix slips message compressBuffer compressStream data compressedStream compressTarget | (Smalltalk includesKey: #Celeste) ifFalse: [^ self notify: 'no mail reader present']. subjectPrefix _ self chooseSubjectPrefixForEmail. self checkForConversionMethods. Cursor write showWhile: [ "prepare the message" message := MailMessage empty. message setField: 'from' toString: Celeste userName. message setField: 'to' toString: 'squeak@cs.uiuc.edu'. message setField: 'subject' toString: (subjectPrefix, name). message body: (MIMEDocument contentType: 'text/plain' content: (String streamContents: [ :str | str nextPutAll: 'from preamble:'; cr; cr. self fileOutPreambleOn: str ])). "Prepare the gzipped data" data _ data _ WriteStream on: String new. data header. self fileOutPreambleOn: data. self fileOutOn: data. self fileOutPostscriptOn: data. data trailer. data _ ReadStream on: data contents. compressBuffer _ ByteArray new: 1000. compressStream _ GZipWriteStream on: (compressTarget _ WriteStream on: (ByteArray new: 1000)). [data atEnd] whileFalse: [compressStream nextPutAll: (data nextInto: compressBuffer)]. compressStream close. compressedStream _ ReadStream on: compressTarget contents asString. message addAttachmentFrom: compressedStream withName: (name, '.cs.gz'). CelesteComposition openForCeleste: Celeste current initialText: message text. ]. Preferences suppressCheckForSlips ifTrue: [^ self]. slips _ self checkForSlips. (slips size > 0 and: [self confirm: 'Methods in this fileOut have halts or references to the Transcript or other ''slips'' in them. Would you like to browse them?']) ifTrue: [Smalltalk browseMessageList: slips name: 'Possible slips in ' , name]! ! !MIMEHeaderValue methodsFor: 'printing' stamp: 'ls 2/10/2001 12:37'! printOn: aStream super printOn: aStream. aStream nextPutAll: ': '. aStream nextPutAll: self asHeaderValue! ! !MIMEHeaderValue methodsFor: 'accessing' stamp: 'ls 2/10/2001 13:06'! parameterAt: aParameter put: value parameters at: aParameter put: value! ! !MIMEHeaderValue class methodsFor: 'instance creation' stamp: 'ls 2/10/2001 12:25'! fromString: aString | parts newValue parms separatorPos parmName parmValue | parts _ ReadStream on: (aString findTokens: ';'). newValue _ self new mainValue: parts next. parms _ Dictionary new. parts do: [:e | separatorPos _ e findAnySubStr: '=' startingAt: 1. separatorPos <= e size ifTrue: [parmName _ (e copyFrom: 1 to: separatorPos - 1) withBlanksTrimmed asLowercase. parmValue _ (e copyFrom: separatorPos + 1 to: e size) withBlanksTrimmed withoutQuoting. parms at: parmName put: parmValue]]. newValue parameters: parms. ^ newValue! ! !MailMessage methodsFor: 'initialize-release' stamp: 'ls 2/10/2001 12:48'! body: newBody "change the body" body := newBody. text := nil.! ! !MailMessage methodsFor: 'initialize-release' stamp: 'ls 2/10/2001 13:18'! 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. self fieldsFrom: parseStream do: [:fName :fValue | (fName asLowercase) = 'content-type' ifTrue: [contentType _ (fValue copyUpTo: $;) asLowercase]. (fName asLowercase) = 'content-transfer-encoding' ifTrue: [contentTransferEncoding _ fValue asLowercase]. fields at: (fName asLowercase) put: (MIMEHeaderValue fromString: fValue)]. 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 2/10/2001 12:15'! initialize "initialize as an empty message" text _ String cr. fields := Dictionary new. body _ MIMEDocument contentType: 'text/plain' content: String cr! ! !MailMessage methodsFor: 'initialize-release' stamp: 'ls 2/10/2001 13:35'! setField: fieldName to: aFieldValue fields at: fieldName asLowercase put: aFieldValue. text := nil.! ! !MailMessage methodsFor: 'initialize-release' stamp: 'ls 2/10/2001 13:10'! setField: fieldName toString: fieldValue ^self setField: fieldName to: (MIMEHeaderValue fromString: fieldValue)! ! !MailMessage methodsFor: 'access' stamp: 'ls 2/10/2001 15:49'! cc ^(fields at: 'cc' ifAbsent: [ ^'' ]) mainValue! ! !MailMessage methodsFor: 'access' stamp: 'ls 2/10/2001 12:19'! date "Answer a date string for this message." ^(Date fromSeconds: self time + (Date newDay: 1 year: 1980) asSeconds) printFormat: #(2 1 3 47 1 2)! ! !MailMessage methodsFor: 'access' stamp: 'ls 2/10/2001 14:02'! from ^(fields at: 'from' ifAbsent: [ ^'' ]) mainValue! ! !MailMessage methodsFor: 'access' stamp: 'ls 2/10/2001 14:03'! subject ^(fields at: 'subject' ifAbsent: [ ^'' ]) mainValue! ! !MailMessage methodsFor: 'access' stamp: 'ls 2/10/2001 12:49'! text "the full, unprocessed text of the message" text ifNil: [ self regenerateText ]. ^text! ! !MailMessage methodsFor: 'access' stamp: 'ls 2/10/2001 14:02'! time | dateField | dateField := (fields at: 'date' ifAbsent: [ ^0 ]) mainValue. ^self timeFrom: dateField! ! !MailMessage methodsFor: 'access' stamp: 'ls 2/10/2001 14:02'! to ^(fields at: 'to' ifAbsent: [ ^'' ]) mainValue! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'ls 2/10/2001 13:54'! regenerateBodyFromParts "regenerate the message body from the multiple parts" | bodyText | bodyText := String streamContents: [ :str | str cr. parts do: [ :part | str nextPutAll: '--'; nextPutAll: self attachmentSeparator; cr; nextPutAll: part text ]. str cr; nextPutAll: '--'; nextPutAll: self attachmentSeparator; nextPutAll: '--'; cr ]. body := MIMEDocument contentType: 'multipart/mixed' content: bodyText. text := nil. "text needs to be reformatted"! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'ls 2/10/2001 13:20'! regenerateText "regenerate the full text from the body and headers" | encodedBodyText | text := String streamContents: [ :str | "first put the header" fields keysAndValuesDo: [ :fieldName :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: 'ls 2/10/2001 13:24'! addAttachmentFrom: aStream withName: aName "add an attachment, encoding with base64. aName is the option filename to encode" | newPart | self makeMultipart. self parts. "make sure parts have been parsed" "create the attachment as a MailMessage" newPart := MailMessage empty. newPart setField: 'content-type' toString: 'application/octet-stream'. newPart setField: 'content-transfer-encoding' toString: 'base64'. aName ifNotNil: [ | dispositionField | dispositionField := MIMEHeaderValue fromString: 'attachment'. dispositionField parameterAt: 'filename' put: aName. newPart setField: 'content-disposition' to: dispositionField ]. newPart body: (MIMEDocument contentType: 'application/octet-stream' content: aStream upToEnd). "regenerate our text" parts := parts copyWith: newPart. self regenerateBodyFromParts. text := nil.! ! !MailMessage methodsFor: 'multipart' stamp: 'ls 2/10/2001 13:07'! attachmentSeparator ^(self fields at: 'content-type') parameters at: 'boundary' ! ! !MailMessage methodsFor: 'multipart' stamp: 'ls 2/10/2001 13:07'! 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. fields at: 'content-type' ifPresent: [ :contentTypeField | parts setField: 'content-type' to: contentTypeField ]. parts := Array with: part. "fix up our header" multipartHeader := MIMEHeaderValue fromString: 'multipart/mixed'. multipartHeader parameterAt: 'boundary' put: self class generateSeparator . fields at: 'content-type' put: multipartHeader. fields at: 'mime-version' put: (MIMEHeaderValue fromString: '1.0'). fields removeKey: 'content-transfer-encoding' ifAbsent: []. "regenerate everything" self regenerateBodyFromParts. text := nil.! ! !MailMessage methodsFor: 'multipart' stamp: 'ls 2/10/2001 13:43'! parseParts "private -- parse the parts of the message and put them in the parts ivar. If this is not a multipart message, put #() into the ivar" | parseStream currLine msgStream messages separator | self body isMultipart ifFalse: [^ parts _ #()]. separator := '--', self attachmentSeparator. parseStream _ ReadStream on: self bodyText. currLine _ ''. [currLine = separator] whileFalse: [currLine _ parseStream nextLine]. separator _ currLine copy. msgStream _ LimitingLineStreamWrapper on: parseStream delimiter: separator. messages _ OrderedCollection new. [parseStream atEnd] whileFalse: [messages add: msgStream upToEnd. msgStream skipThisLine]. parts _ messages collect: [:e | MailMessage from: e]! ! !MailMessage methodsFor: 'multipart' stamp: 'ls 2/10/2001 16:36'! save "save the part to a file" | fileName file | fileName _ self name ifNil: ['attachment' , Utilities dateTimeSuffix]. (fileName includes: $.) ifFalse: [ self body isJpeg ifTrue: [fileName _ fileName , '.jpg']. self body isGif ifTrue: [fileName _ fileName, '.gif']. ]. fileName _ FillInTheBlank request: 'File name for save?' initialAnswer: fileName. fileName isEmpty ifTrue: [^ nil]. file _ FileStream newFileNamed: fileName. file nextPutAll: self bodyText. file close! ! !MailMessage methodsFor: 'fields' stamp: 'ls 2/10/2001 13:47'! rewriteFields: aBlock append: appendBlock "Rewrite header fields. The body is not modified. Each field's key and value is reported to aBlock. The block's return value is the replacement for the entire header line. Nil means don't change the line, empty means delete it. After all fields are processed, evaluate appendBlock and append the result to the header." | old new result appendString | self halt: 'this method is out of date. it needs to update body, at the very least. do we really need this now that we have setField:to: and setField:toString: ?!!'. old _ ReadStream on: text. new _ WriteStream on: (String new: text size). self fieldsFrom: old do: [ :fName :fValue | result _ aBlock value: fName value: fValue. result ifNil: [new nextPutAll: fName, ': ', fValue; cr] ifNotNil: [result isEmpty ifFalse: [new nextPutAll: result. result last = Character cr ifFalse: [new cr]]]]. appendString _ appendBlock value. appendString isEmptyOrNil ifFalse: [new nextPutAll: appendString. appendString last = Character cr ifFalse: [new cr]]. new cr. "End of header" text _ new contents, old upToEnd. ! ! !MailMessage class methodsFor: 'instance creation' stamp: 'ls 2/10/2001 12:30'! empty "return a message with no text and no header" ^super new initialize! ! MailMessage removeSelector: #asMultipartText! MailMessage removeSelector: #asTextEncodingNewPart:named:! MailMessage removeSelector: #cacheFieldsFrom:andDo:! MailMessage removeSelector: #cachedFields! MailMessage removeSelector: #content! MailMessage removeSelector: #contentType! MailMessage removeSelector: #contentType:! MailMessage removeSelector: #eudoraOutboxText! MailMessage removeSelector: #makeMultipa! MailMessage removeSelector: #replaceFields:! MailMessage removeSelector: #setField:toValue:! Object subclass: #MailMessage instanceVariableNames: 'text body fields parts ' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'! !MIMEHeaderValue class reorganize! ('instance creation' fromString:) ! CelesteComposition removeSelector: #hasAttachments! CelesteComposition removeSelector: #transformToMultipart! Model subclass: #CelesteComposition instanceVariableNames: 'celeste messageText textEditor morphicWindow mvcWindow ' classVariableNames: '' poolDictionaries: '' category: 'Network-Mail Reader'!