'From Squeak4.1 of 17 April 2010 [latest update: #9957] on 27 April 2017 at 2:06:09 pm'! !Bag methodsFor: '*network-Mail Reader-Spam' stamp: 'jecel 8/31/2016 15:04'! removeAllButMostProminent: numberToKeep | sorted | sorted _ self sortedCounts. ((sorted last: ((sorted size - numberToKeep) max: 0)) collect: [:a | a value]) do: [:e | self removeAllCopiesOf: e]. ! ! !ByteTextConverter methodsFor: 'private' stamp: 'jecel 11/17/2012 16:10'! encode: squeakEncodedCharCode "Answer the encoded byte code corresponding to squeakEncodedCharCode. Note that the squeakEncodedCharCode does not necessary span in the range 0...255." ^self class encodeTable at: squeakEncodedCharCode ifAbsent: ["self error: 'Cannot encode character of code ' , (squeakEncodedCharCode printStringRadix: 16)" 63]! ! !CelesteComposition methodsFor: 'interface' stamp: 'jecel 5/22/2010 01:43'! openInMorphic "open an interface for sending a mail message with the given initial text " | textMorph buttonsList sendButton attachmentButton | morphicWindow _ SystemWindow labelled: 'Mister Postman'. morphicWindow model: self. textEditor _ textMorph _ Celeste morphicTextEditorClass on: self text: #messageText accept: #messageText:. morphicWindow addMorph: textMorph frame: (0 @ 0.1 corner: 1 @ 1). buttonsList _ AlignmentMorph newRow. sendButton _ PluggableButtonMorph on: self getState: nil action: #submit. sendButton hResizing: #spaceFill; vResizing: #spaceFill; label: 'send message'; setBalloonText: 'add this to the queue of messages to be sent'; onColor: Color white offColor: Color white. buttonsList addMorphBack: sendButton. attachmentButton _ PluggableButtonMorph on: self getState: nil action: #addAttachment. attachmentButton hResizing: #spaceFill; vResizing: #spaceFill; label: 'add attachment'; setBalloonText: 'Send a file with the message'; onColor: Color white offColor: Color white. buttonsList addMorphBack: attachmentButton. morphicWindow addMorph: buttonsList frame: (0 @ 0 extent: 1 @ 0.1). morphicWindow openInWorld! ! !CompoundTextConverter methodsFor: 'private' stamp: 'jecel 11/30/2013 16:05'! nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForLeadingChar: leadingChar | charset | charset := EncodedCharSet charsetAt: leadingChar. Unicode == charset ifTrue: [charset := nil]. "Unicode does not implement the following message" charset ifNotNil: [ charset nextPutValue: ascii toStream: aStream withShiftSequenceIfNeededForTextConverterState: state. ] ifNil: [ "..." ]. ! ! !HierarchicalUrl methodsFor: 'parsing' stamp: 'jecel 11/27/2013 13:57'! privateInitializeFromText: aString | remainder ind specifiedSchemeName | remainder := aString. schemeName ifNil: [specifiedSchemeName := Url schemeNameForString: remainder. specifiedSchemeName ifNotNil: [schemeName := specifiedSchemeName. remainder := remainder copyFrom: schemeName size + 2 to: remainder size]. schemeName ifNil: ["assume HTTP" schemeName := 'http']]. "remove leading // if it's there" (remainder beginsWith: '//') ifTrue: [remainder := remainder copyFrom: 3 to: remainder size]. "get the query" ind := remainder indexOf: $?. ind > 0 ifTrue: [query := remainder copyFrom: ind + 1 to: remainder size. remainder := remainder copyFrom: 1 to: ind - 1]. "get the authority" ind := remainder indexOf: $/. ind > 0 ifTrue: [ind = 1 ifTrue: [authority := ''] ifFalse: [authority := remainder copyFrom: 1 to: ind - 1. remainder := remainder copyFrom: ind + 1 to: remainder size]] ifFalse: [authority := remainder. remainder := '']. "extract the username+password" (authority includes: $@) ifTrue: [username := authority copyUpTo: $@. authority := authority copyFrom: (authority indexOf: $@) + 1 to: authority size. (username includes: $:) ifTrue: [password := username copyFrom: (username indexOf: $:) + 1 to: username size. username := username copyUpTo: $:]]. "Extract the port" (authority includes: $:) ifTrue: [| lastColonIndex portString | lastColonIndex := authority findLast: [:c | c = $:]. portString := authority copyFrom: lastColonIndex + 1 to: authority size. (portString size > 0 and: [portString isAllDigits]) ifTrue: [port := Integer readFromString: portString. (port > 65535) ifTrue: [self error: 'Invalid port number']. authority := authority copyFrom: 1 to: lastColonIndex - 1] ifFalse:[self error: 'Invalid port number']]. "get the path" path := self privateParsePath: remainder relativeTo: #() .! ! !IndexFileEntry methodsFor: 'printing' stamp: 'jecel 5/20/2010 17:14'! computeTOCStringAsColumns "Answer a string for the table of contents." "IndexFileEntry allInstancesDo: [: e | e flushTOCCache]" | fromFieldSize array attachFlag | fromFieldSize := 18. attachFlag := Celeste showAttachmentsFlag ifTrue: [self getMessage body isMultipart] ifFalse: [false]. array := Array new: 5. array at: 1 put: self dateString. array at: 2 put: (self fromStringLimit: fromFieldSize). array at: 3 put: subject decodeMimeHeader. array at: 4 put: self textLength asStringWithCommas. array at: 5 put: attachFlag. ^ array! ! !IndexFileEntry methodsFor: 'printing' stamp: 'jecel 5/7/2012 13:32'! fromStringLimit: limit "Answer a cleaned up 'from' field for the table of contents." | editedFrom s ch i decodedFrom | editedFrom := WriteStream on: (String new: limit + 1). decodedFrom := [from decodeMimeHeader] on: Exception do: [:ex | ex return: '** bad header **']. s := ReadStream on: decodedFrom. s skipSeparators. ('"<' includes: s peek) ifTrue: [s next]. ((i := from indexOf: $() > 0) ifTrue: [s position: i]. [s atEnd] whileFalse: [ ch := s next. (('@<>)$"' includes: ch) or: [editedFrom position >= limit]) ifTrue: [^editedFrom contents] ifFalse: [editedFrom nextPut: ch]]. ^editedFrom contents ! ! !MIMEDocument methodsFor: '*Network-Mail Reader' stamp: 'jecel 5/20/2010 17:33'! parts "Return the parts of this message. There is a far more reliable implementation of parts in MailMessage, but for now we are continuing to use this implementation" | parseStream currLine separator msgStream messages | self isMultipart ifFalse: [^ #()]. parseStream := ReadStream on: self content. currLine := ''. ['--*' match: currLine] whileFalse: [currLine _ parseStream nextLine. currLine ifNil: [^ #()]]. separator := currLine copy. msgStream := LimitingLineStreamWrapper on: parseStream delimiter: separator. messages := OrderedCollection new. [parseStream atEnd] whileFalse: [messages add: msgStream upToEnd. msgStream skipThisLine]. ^ messages collect: [:e | MailMessage from: e] ! ! !MailAccount methodsFor: 'accessing' stamp: 'jecel 3/25/2014 07:08'! popUserName: x self clearPasswords. "be kind, if they include the host name here" popUserName _ x "copyUpTo: $@". ! ! !MailMessage methodsFor: 'initialize-release' stamp: 'jecel 5/21/2010 11:56'! from: aString "Parse aString to initialize myself." | parseStream contentType bodyText contentTransferEncoding charset | tokens := nil. text := aString withoutTrailingBlanks, String cr. parseStream _ ReadStream on: text. contentType _ 'text/plain'. contentTransferEncoding := nil. charset := 'latin-1'. 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. (fValue includesSubString: 'charset') ifTrue: [ charset := ((fValue copyAfter: $=) copyUpTo: $;) withoutQuoting withBlanksTrimmed asLowercase ] ]. fName = 'content-transfer-encoding' ifTrue: [contentTransferEncoding := fValue asLowercase]. (fields at: fName ifAbsentPut: [OrderedCollection new: 1]) add: (MIMEHeaderValue forField: fName 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 := QuotedPrintableMimeConverter mimeDecode: bodyText as: String]. (#('us-ascii' 'latin-1' 'iso-8859-1') includes: charset) ifFalse: [ (TextConverter defaultConverterClassForEncoding: charset) ifNotNilDo: [ :c | bodyText := [bodyText convertFromWithConverter: c new] on: Exception do: [' *** BAD ENCODING *** ']]]. body := MIMEDocument contentType: contentType content: bodyText! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'jecel 5/21/2010 12:17'! bodyTextFormatted "Answer a version of the text in my body suitable for display. This will parse multipart forms, decode HTML, and other such things" "check for multipart" self body isMultipart ifTrue: [ "check for alternative forms" self body isMultipartAlternative ifTrue: [ "it's multipart/alternative. search for a part that we can display, biasing towards nicer formats" #('multipart/mixed' 'text/html' 'text/plain') do: [ :format | self parts do: [ :part | part body contentType = format ifTrue: [ ^part bodyTextFormatted ] ] ]. "couldn't find a desirable part to display; just display the first part" self parts isEmpty ifTrue: [^'']. ^self parts first bodyTextFormatted ]. "not alternative parts. put something for each part" ^Text streamContents: [ :str | self parts do: [ :part | ((#('text' 'multipart') includes: part body mainType) or: [ part body contentType = 'message/rfc822']) ifTrue: [ "try to inline the message part" str nextPutAll: part bodyTextFormatted. ] ifFalse: [ |descript | str cr. descript := part name ifNil: [ 'attachment' ]. str nextPutAll: (Text string: '[', descript, ']' attribute: (TextMessageLink message: part)). ] ] ]. ]. "check for HTML" (self body contentType = 'text/html') ifTrue: [ Smalltalk globals at: #HtmlParser ifPresentAndInMemory: [ :htmlParser | ^(htmlParser parse: (ReadStream on: body content)) formattedText ] ]. "check for an embedded message" self body contentType = 'message/rfc822' ifTrue: [ ^(MailMessage from: self body content) formattedText ]. "nothing special--just return the text" ^body content isoToSqueak. ! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'jecel 5/21/2010 12:18'! formattedText "Answer a version of my text suitable for display. This cleans up the header, decodes HTML, and things like that" ^ (self cleanedHeader asText, String cr , self bodyTextFormatted) asForcedOctetStringText withSqueakLineEndings! ! !MailMessage class methodsFor: 'preferences' stamp: 'jecel 5/21/2010 22:33'! 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' 'delivered-to' 'user-agent' 'content-class' 'thread-topic' 'thread-index' 'list-help' 'list-post' 'list-subscribe' 'list-id' 'list-unsubscribe' 'list-archive' 'face' 'domainkey-signature' 'dkim-signature' ) ! ! !MailMessage class methodsFor: 'utilities' stamp: 'jecel 9/12/2011 14:24'! dateStamp: aDateAndTime "Return the given date and time formatted as a email Date: line" "The result conforms to RFC822 with a long year, e.g. 'Thu, 18 Feb 1999 20:38:51'" | d t | d := aDateAndTime asDate. t := aDateAndTime asTime. ^ (d weekday copyFrom: 1 to: 3), ', ', (d printFormat: #(1 2 3 $ 2 1 1)), ' ', "We are careful to avoid fractional seconds appearing in the result:" (Time fromSeconds: t asSeconds) print24! ! !MailMessage class methodsFor: 'utilities' stamp: 'jecel 9/12/2011 14:25'! dateStampNow "Return the current date and time formatted as a email Date: line" "The result conforms to RFC822 with a long year, e.g. 'Thu, 18 Feb 1999 20:38:51'" ^ self dateStamp: DateAndTime now! ! !RFC2047MimeConverter methodsFor: '*Network-Mail Reader' stamp: 'jecel 7/22/2013 15:03'! mimeDecode "Do conversion reading from mimeStream writing to dataStream. See String>>decodeMimeHeader" | c d | [mimeStream atEnd] whileFalse: [ c := mimeStream next. c = $= ifTrue: [ d _ (mimeStream next ifNil: [$0]) digitValue * 16 + (mimeStream next ifNil: [$0]) digitValue. d > 0 ifTrue: [c _ Character value: d]] ifFalse: [c = $_ ifTrue: [c := $ ]]. dataStream nextPut: c]. ^ dataStream! ! !SMTPClient methodsFor: 'private protocol' stamp: 'jecel 5/22/2010 02:42'! ensureConnection self isConnected ifTrue: [^self]. self stream ifNotNil: [self stream close]. self stream: (SocketStream openConnectionToHost: self host port: self port). self checkResponse. self initiateSession. self login! ! !SMTPClient methodsFor: '*network-Mail Reader' stamp: 'jecel 5/20/2010 17:36'! data: messageData "send the data of a message" "DATA " | cookedLine singleLF | singleLF := String with: Character lf. "inform the server we are sending the message data" self sendCommand: 'DATA'. self checkResponse. "process the data one line at a time" messageData linesDo: [ :messageLine | cookedLine := messageLine. (cookedLine beginsWith: singleLF) ifTrue: [cookedLine := cookedLine copyFrom: 2 to: cookedLine size]. (cookedLine endsWith: singleLF) ifTrue: [cookedLine := cookedLine copyFrom: 1 to: cookedLine size -1]. (cookedLine beginsWith: '.') ifTrue: [ "lines beginning with a dot must have the dot doubled" cookedLine := '.', cookedLine ]. self sendCommand: cookedLine ]. "inform the server the entire message text has arrived" self sendCommand: '.'. self checkResponse.! ! !SMTPClient class methodsFor: 'accessing' stamp: 'jecel 3/2/2016 18:43'! defaultPortNumber ^"25" 587 "for Locaweb"! ! !TextClassifier methodsFor: 'as yet unclassified' stamp: 'jecel 5/31/2010 11:53'! probabilityOf: msg beingIn: categoryName | sortedProbabilities p product prodInv pSpam yesSize noSize no yes | sortedProbabilities _ SortedCollection sortBlock: [:a :b | (a - 0.5) abs >= (b - 0.5) abs]. categorizer categoryNamed: categoryName andOppositeDo: [:yesTokens :noTokens | yesSize _ yesTokens size. noSize _ noTokens size. msg tokens do: [:t | no _ [(noTokens occurrencesOf: t) asFloat / noSize] on: ZeroDivide do: [:e | e return: 0.0]. yes _ [(yesTokens occurrencesOf: t) asFloat / yesSize] on: ZeroDivide do: [:e | e return: 0.0]. p _ (([yes / (yes + no)] on: ZeroDivide do: [:e | e return: 0.2]) max: 0.01) min: 0.99. sortedProbabilities add: p]. sortedProbabilities size > 15 ifTrue: [sortedProbabilities _ sortedProbabilities first: 15]. product _ sortedProbabilities inject: 1.0 into: [:i :n | i*n]. prodInv _ sortedProbabilities inject: 1.0 into: [:i :n | i * (1.0 - n)]. pSpam _ product / (product + prodInv). ]. ^ pSpam ! ! !MIMEDocument reorganize! ('accessing' content contentStream contentType contents mainType subType type) ('as yet unclassified' isMultipartAlternative) ('converting' withUrl:) ('printing' printOn:) ('testing' isGif isJpeg isMultipart isPng isPnm) ('*MorphicExtras-accessing' url) ('private' privateContent: privateMainType: privateSubType: privateUrl:) ('*Network-Mail Reader' parts) !