[ENH] Celeste receives attachments

Daniel Vainsencher danielv at netvision.net.il
Wed Apr 26 23:19:08 UTC 2000


Squeakers-
for your enjoyment, comments and testing ;-)
(Stefan, please don't move this to the update stream until we shake it down a 
little).

>From the changeset prefix:

"First attack at recieving attachments in Celeste.
The parts... item is added to the menu for the message list pane, when th=
e selected message has multiple parts.
Yet todo -
* give better feedback to user
* handle recursed attachments
* display appropriate parts inline
* help sending attachments
* Merge with other MIME stuff in Squeak, clean up"

Bert said-
>I had displaying/sending iso8859-1 messages working, also in the headers,
This isn't in my priorities, but I could try to integrate it if you send it to me.

>LimitingLineStreamWrapper
Yes, it's a wonderful thing ;-)

Guys, anybody feel like doing the encoding side of QuotedPrintable? (base64 is basically enough, but QuotedPrintable is, well, printable...)

Daniel
-------------- next part --------------
'From Squeak2.8alpha of 12 February 2000 [latest update: #2040] on 27 April 2000 at 1:58:06 am'!
"Change Set:		Celeste3
Date:			27 April 2000
Author:			Daniel Vainsencher

First attack at recieving attachments in Celeste.
The parts... item is added to the menu for the message list pane, when the selected message has multiple parts.
Yet todo -
* give better feedback to user
* handle recursed attachments
* display appropriate parts inline
* help sending attachments
* Merge with other MIME stuff in Squeak, clean up"!

Object subclass: #MIMEPart
	instanceVariableNames: 'text fields content '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Network-Mail Reader'!

!Celeste methodsFor: 'table of contents pane' stamp: 'dvf 4/27/2000 01:52'!
partsMenu
	| menu currMessage part |
	menu _ CustomMenu new.
	currMessage _ self currentMessage.
	currMessage body parts do: [:e | menu add: 'save ' , e printString action: e].
	part _ menu startUp.
	part ifNotNil: [part save] ! !

!Celeste methodsFor: 'table of contents pane' stamp: 'dvf 4/27/2000 00:14'!
saveMessage
	"save the currently selected message to a file"
	| fileName file |
	currentMsgID ifNil: [^ self].
	fileName _ FillInTheBlank request: 'file to save in'.
	fileName isEmpty ifTrue: [^ self].
	file _ FileStream fileNamed: fileName.
	file nextPutAll: (self currentMessage) text.
	file close! !

!Celeste methodsFor: 'table of contents pane' stamp: 'dvf 4/27/2000 00:14'!
tocMenu: aMenu 
	"Answer the menu for the table of contents pane."
	| labels lineSeparations selections lines |
	currentCategory ifNil: [^ nil].
	currentMsgID ifNil: [^ aMenu
			labels: 'compose\file all\move all\remove all\delete all\search' withCRs
			lines: #(1 5 )
			selections: #(#compose #fileAll #moveAll #removeAll #deleteAll #search )]
		ifNotNil: 
			[labels _ 'delete\compose\reply\forward\'.
			lineSeparations _ #(1 3 ).
			selections _ #(#deleteMessage #compose #reply #forward ).
			(self currentMessage) body isMultipart
				ifTrue: 
					[labels _ labels , 'parts...\'.
					selections _ selections , #(#partsMenu )].
			lastCategory isEmpty
				ifFalse: 
					[labels _ labels , 'file -> ' , lastCategory , '\move -> ' , lastCategory , '\'.
					lineSeparations _ lineSeparations , #(2 ).
					selections _ selections , #(#fileAgain #moveAgain )].
			labels _ labels , 'file\move\remove\file all\move all\remove all\delete all\other categories\search\'.
			lineSeparations _ lineSeparations , #(3 4 2 ).
			selections _ selections , #(#fileMessage #moveMessage #removeMessage #fileAll #moveAll #removeAll #deleteAll #otherCategories #search ).
			labels _ labels , 'save message\'.
			lineSeparations _ lineSeparations , #().
			selections _ selections , #(#saveMessage ).
			"convert lineSeperations into absolute line positions"
			lines _ lineSeparations copy.
			(2 to: lines size)
				do: [:i | lines at: i put: (lines at: i)
							+ (lines at: i - 1)].
			^ aMenu
				labels: labels withCRs
				lines: lines
				selections: selections]! !

!Celeste methodsFor: 'message text pane' stamp: 'dvf 4/27/2000 00:14'!
formatedMessageText
	"Answer a string that is my formatted mail message."
	| message header body bodyText |
	currentMsgID isNil ifTrue: [^ ''].
	message _ self currentMessage.
	header _ message cleanedHeader.
	body _ message body.
	body contentType = 'text/html'
		ifTrue: [bodyText _ (HtmlParser parse: (ReadStream on: body content)) formattedText]
		ifFalse: [bodyText _ body content].
	^ header asText , String cr , bodyText! !

!Celeste methodsFor: 'other' stamp: 'dvf 4/27/2000 00:12'!
currentMessage
	^mailDB getMessage: currentMsgID! !


!MIMEDocument methodsFor: 'as yet unclassified' stamp: 'dvf 4/25/2000 23:39'!
isMultipart
	^self mainType = 'multipart'! !

!MIMEDocument methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 18:23'!
parts
	| parseStream currLine separator msgStream messages |
	self isMultipart ifFalse: [^ #()].
	parseStream _ ReadStream on: self content.
	currLine _ ''.
	['--*' match: currLine]
		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].
	^ messages collect: [:e | MIMEPart on: e]! !


!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 17:58'!
content
	content ifNil: [self parse].
	^ content! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/27/2000 01:45'!
decoderClass
	| encoding |
	encoding _ self fields at: 'content-transfer-encoding' ifAbsent: [^ nil].
	encoding asLowercase = 'base64' ifTrue: [^ Base64MimeConverter].
	encoding asLowercase = 'quoted-printable' ifTrue: [^ QuotedPrintableMimeConverter].
	^ nil! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/27/2000 01:04'!
excerpt
	^ self content withSeparatorsCompacted truncateWithElipsisTo: 30! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 17:57'!
fields
	fields ifNil: [self parse].
	^ fields! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 17:52'!
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."
	| 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; skip: -1.
					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]! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 18:33'!
isAttachment
	| field |
	field _ self fields at: 'content-disposition' ifAbsent: [^false].
	^'*attachment*' match: field! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 23:48'!
isMultipart
	^ self mainType = 'multipart'! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/27/2000 00:16'!
mainType
	| type |
	type _ self fields at: 'content-type' ifAbsent: ['application/octet-stream'].
	^ (type findTokens: '/') first! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/27/2000 00:54'!
name
	| type nameField disposition |
	type _ self fields at: 'content-type' ifAbsent: [].
	(type notNil and: [(nameField _ type findTokens: ';' includes: 'name') notNil])
		ifTrue: [^ (nameField findTokens: '"') last].
	disposition _ self fields at: 'content-disposition' ifAbsent: [].
	(disposition notNil and: [(nameField _ disposition findTokens: ';' includes: 'name') notNil])
		ifTrue: [^ (nameField findTokens: '"') last].
	^ nil! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 19:54'!
parse
	| parseStream |
	fields _ Dictionary new.
	parseStream _ ReadStream on: self text.
	self fieldsFrom: parseStream do: [:key :value | fields at: key put: value].
	content _ parseStream upToEnd! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 23:49'!
parts
	| parseStream currLine separator msgStream messages |
	self isMultipart ifFalse: [^ #()].
	parseStream _ ReadStream on: self content.
	currLine _ ''.
	['--*' match: currLine]
		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].
	^ messages collect: [:e | MIMEPart on: e]! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/27/2000 01:05'!
printOn: aStream 
	"For text parts with no filename show: 'text/plain: first line of text...'    
	for attachments/filenamed parts show: 'attachment: filename.ext'"
	| name |
	aStream nextPutAll: ((name _ self name) ifNil: ['Text: ' , self excerpt]
			ifNotNil: ['File: ' , name])! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 17:52'!
reportField: aString to: aBlock 
	"Evaluate the given block with the field name a value in the given 
	field. Do nothing if the field has an empty value part."
	| s fieldName fieldValue |
	s _ ReadStream on: aString.
	fieldName _ (s upTo: $:) asLowercase.
	s skipSeparators.
	s atEnd
		ifFalse: 
			["field is not empty"
			fieldValue _ s upToEnd.
			aBlock value: fieldName value: fieldValue]! !

!MIMEPart methodsFor: 'as yet unclassified' stamp: 'dvf 4/27/2000 01:50'!
save
	| fileName decoder file decoderClass |
	(fileName _ self name) ifNil: [fileName _ FillInTheBlank request: 'File name for save?' initialAnswer: 'attachment' , Utilities dateTimeSuffix].
	fileName ifNil: [^ nil].
	file _ FileStream newFileNamed: fileName.
	(decoderClass _ self decoderClass) ifNil: ["decoder not needed or unknown"
		file nextPutAll: self content]
		ifNotNil: 
			[decoder _ decoderClass new.
			decoder dataStream: file;
			 mimeStream: (ReadStream on: self content);
			 mimeDecode]. 
	file close! !

!MIMEPart methodsFor: 'accessing' stamp: 'dvf 4/26/2000 17:53'!
text
	^text! !

!MIMEPart methodsFor: 'accessing' stamp: 'dvf 4/26/2000 17:52'!
text: anObject
	text _ anObject! !


!MIMEPart class methodsFor: 'as yet unclassified' stamp: 'dvf 4/26/2000 17:38'!
on: aString
	^self new text: aString! !

MIMEPart removeSelector: #decoder!


More information about the Squeak-dev mailing list