<> <> <> <> <> <> <<>> DIRECTORY BasicTime USING [GMT, nullGMT, Now, Period], BlackCherry, BlackCherryInternal, BlackCherrySidedoor, Convert USING [Error, RopeFromTimeRFC822, TimeFromRope], IO, MailBasics, MailBasicsFileTypes, MailMessage USING [ReadOneMessageX], MailParse USING [endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse, ParseError, ParseHandle], MailRetrieve USING [Accept, Failed, FailureReason, Handle, MailboxState, MBXState, NextMessage, NextServer, ServerName, ServerState, ServerType, StartMessage], MailUtils USING [Credentials, GetLoggedInUser, GetUserCredentials, LocalNameFromRName], Process USING [Detach], RedBlackTree, RefText, Rope, RuntimeError USING [BoundsFault], UserProfile USING [Boolean], VFonts USING [CharWidth, StringWidth]; BlackCherryMailImpl: CEDAR MONITOR IMPORTS BasicTime, BlackCherry, BlackCherryInternal, Convert, IO, MailMessage, MailParse, MailRetrieve, MailUtils, Process, RedBlackTree, Rope, RuntimeError, UserProfile, VFonts EXPORTS BlackCherryInternal, BlackCherrySidedoor ~ BEGIN OPEN BlackCherry, BlackCherryInternal, BlackCherrySidedoor; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; CantParse: SIGNAL ~ CODE; <> RetrieveState: TYPE ~ ATOM; <<{ OK, communicationFailure, noSuchServer, connectionRejected, badCredentials, didNotRespond, noMailboxes, noServers, unknownFailure, unknownError };>> <> blanks: ROPE ~ " "; -- lotsa blanks blankWidth: INT ~ VFonts.CharWidth[' ]; -- in default font <

> date: ROPE ~ "Date"; subject: ROPE ~ "Subject"; from: ROPE ~ "From"; sender: ROPE ~ "Sender"; to: ROPE ~ "To"; <> userRNameList: PUBLIC MailBasics.RNameList; simpleUserNameList: PUBLIC LIST OF ROPE; localRNameList: LIST OF ROPE; credentials: PUBLIC LIST OF MailUtils.Credentials; UpdateUser: PUBLIC ENTRY PROC[msiData: MsiData] ~ { UpdateUserInternal[msiData] }; UpdateUserInternal: INTERNAL PROC[msiData: MsiData] ~ { ENABLE BEGIN UNWIND => NULL; MailRetrieve.Failed => { Report[ "MailRetrieve.Failed. Why: %g, text: %g\n", [atom[why]], [rope[text]] ]; GOTO nogood; }; END; gvMail: BOOL ~ UserProfile.Boolean["BlackCherry.gvMail", TRUE]; xnsMail: BOOL ~ UserProfile.Boolean["BlackCherry.xnsMail", TRUE]; CloseRetrieveHandle[]; userRNameList Ź NIL; simpleUserNameList Ź localRNameList Ź NIL; credentials Ź MailUtils.GetUserCredentials[ SELECT TRUE FROM ( gvMail AND xnsMail ) => NIL, gvMail => $gv, xnsMail => $xns, ENDCASE => $xns]; MakeAndSetNewHandle[credentials, msiData]; FOR ucL: LIST OF MailUtils.Credentials Ź credentials, ucL.rest UNTIL ucL = NIL DO this: ROPE; userRNameList Ź CONS[ucL.first.rName, userRNameList]; simpleUserNameList Ź CONS[this Ź MailUtils.GetLoggedInUser[ucL.first.rName.ns], simpleUserNameList]; localRNameList Ź CONS[this Ź MailUtils.LocalNameFromRName[[ucL.first.rName.ns, this]], localRNameList]; ENDLOOP; EXITS nogood => {}; }; IsCurrentUser: PUBLIC PROC [ sender: ROPE ] RETURNS [ yes: BOOL Ź TRUE ] ~ { FOR rnL: MailBasics.RNameList Ź userRNameList, rnL.rest UNTIL rnL = NIL DO IF sender.Equal[rnL.first.name, FALSE] THEN RETURN; ENDLOOP; FOR rnL: LIST OF ROPE Ź localRNameList, rnL.rest UNTIL rnL = NIL DO IF sender.Equal[rnL.first, FALSE] THEN RETURN; ENDLOOP; FOR rnL: LIST OF ROPE Ź simpleUserNameList, rnL.rest UNTIL rnL = NIL DO IF sender.Equal[rnL.first, FALSE] THEN RETURN; ENDLOOP; RETURN[FALSE]; }; <> WriteMsgs: PUBLIC PROC [msInfo: MsgSetInfo, mailStrm: IO.STREAM] RETURNS [ numMsgs: INT Ź 0, newList, newLast: MsgHandle Ź NIL ] ~ { reader: IO.STREAM ~ msInfo.fileData.readStream; writer: IO.STREAM ~ mailStrm; segmentStart: INT ~ writer.GetLength[]; -- append to end of stream/log! writer.SetIndex[segmentStart]; FOR msgH: MsgHandle Ź msInfo.first, msgH.next WHILE ( msgH # NIL ) DO IF ( msgH.deleted ) THEN LOOP; BEGIN entryStart: INT ~ msgH.entryStart; entryLen: INT ~ msgH.entryLen; writeStart: INT ~ writer.GetLength[]; textLen: INT ~ msgH.textLen; headersPos: INT ~ writeStart + ( msgH.headersPos - msgH.entryStart ); formatPos: INT ~ headersPos + textLen; cell: MsgHandle ~ NEW[MsgHandleRec Ź [gvID: msgH.gvID, unRead: msgH.unRead, headersPos: headersPos, textLen: textLen, formatPos: formatPos, formatLen: msgH.formatLen, entryStart: writeStart, entryLen: entryLen, next: NIL] ]; <> reader.SetIndex[entryStart]; CopyBytes[to: writer, from: reader, num: entryLen]; writer.Flush[]; IF newLast = NIL THEN newList Ź cell ELSE newLast.next Ź cell; newLast Ź cell; IF ( numMsgs Ź numMsgs.SUCC ) MOD 10 = 0 THEN { IF numMsgs MOD 100 = 0 THEN Report["(%g) ", [integer[numMsgs]] ] ELSE Report["."]; }; END; ENDLOOP; writer.Flush[]; IF ( reader # writer ) THEN reader.Flush[]; }; WriteTOC: PUBLIC PROC [ reader, writer: STREAM, numMsgs, segmentStart: INT, msgH: MsgHandle, useFromFieldInTOC: BOOL] RETURNS [ last: MsgHandle Ź NIL ] ~ { posForEntry: INT ~ writer.GetLength[]; -- where the toc entries get written writer.SetIndex[posForEntry]; writer.PutF[relTocEntriesEntryTemplate, [integer[0]], [integer[numMsgs]] ]; FOR thisH: MsgHandle Ź msgH, thisH.next WHILE ( thisH # NIL ) DO mostOfToc: ROPE; reader.SetIndex[thisH.headersPos]; mostOfToc Ź TOCFromStream[reader, thisH.textLen, useFromFieldInTOC].toc; thisH.toc Ź Rope.Concat[" ", mostOfToc]; writer.Flush[]; writer.SetIndex[writer.GetLength[]]; -- set at end for sure thisH.charPos Ź writer.GetIndex[]; IF thisH.unRead THEN writer.PutRope[" ? "] ELSE writer.PutRope[" "]; writer.PutRope[mostOfToc]; writer.PutFL["\r%g %g %g %g\r", LIST[[integer[thisH.headersPos-segmentStart]], [integer[thisH.textLen]], [integer[IF thisH.formatPos = 0 THEN 0 ELSE thisH.formatPos-segmentStart]], [integer[thisH.formatLen]] ]]; writer.PutF["%g %g\r", [integer[thisH.entryStart-segmentStart]], [integer[thisH.entryLen]] ]; last Ź thisH; ENDLOOP; { now: INT ~ writer.GetLength[]; entryLen: INT ~ now-posForEntry; writer.SetIndex[posForEntry]; writer.PutF[relTocEntriesEntryTemplate, [integer[entryLen]], [integer[numMsgs]] ]; }; writer.Flush[]; IF ( reader # writer ) THEN reader.Flush[]; }; <> <> relTocPointerEntryTemplate: PUBLIC ROPE Ź "*entry*%10g\rRelTOCPointer %10g\r"; <> relTocEntriesEntryTemplate: PUBLIC ROPE Ź "*entry*%10g\rRelTOCEntries %5g\r"; headerEntryTemplate: PUBLIC ROPE Ź "*entry* %10g\r"; createMsgTemplate: PUBLIC ROPE Ź "CreateMsg\r%g\r%10g %10g\r"; <> RelTOCPointerRope: ROPE = "RelTOCPointer"; TOCPointerRope: ROPE = "TOCPointer"; RelTOCEntriesRope: ROPE = "RelTOCEntries"; TOCEntriesRope: ROPE = "TOCEntries"; IsEntryFound: PROC [line: ROPE, start: INT] RETURNS [ok: BOOL] ~ { IF ( ok Ź ( line.Find["*entry*", 0] = 0 ) ) THEN RETURN; BadEntryReport[line, "*entry*", start]; }; BadEntryReport: PROC[line, which: ROPE, where: INT] = { Report["***\n Found %g instead of %g at file pos %g - some messages may not be available\n", [rope[line]], [rope[which]], [integer[where]] ]; }; IsIdentFound: PROC [ident, which: ROPE, start: INT, failOK: BOOL Ź FALSE] RETURNS [ok: BOOL] ~ { IF ( ok Ź ( ident.Equal[which] ) ) THEN RETURN; IF NOT failOK THEN BadEntryReport[ident, which, start]; }; ReadBWFile: PUBLIC PROC [msInfo: MsgSetInfo] RETURNS [numUndel, totalMsgs: INT Ź 0, ok: BOOL Ź FALSE] ~ { fileName: ROPE ~ msInfo.fileName; stream: IO.STREAM ~ msInfo.fileData.readStream; -- can only read from a readStream streamLen: INT ~ stream.GetLength[]; thisRead: INT; BEGIN ENABLE BEGIN IO.EndOfStream => { Report["\n *** IO.EndOfStream reading mailLog, file index at %g - some messages may not be available\n", [integer[stream.GetIndex[]]] ]; GOTO notgood; }; UNWIND => { Report["\n *** UNWIND reading mailLog, file index at %g - some messages may not be available\n", [integer[stream.GetIndex[]]] ]; GOTO notgood; }; END; DO first: MsgHandle Ź NIL; current: MsgHandle Ź NIL; start: INT ~ stream.GetIndex[]; isRelToc, isRelEntries: BOOL Ź TRUE; IF ( start = streamLen ) THEN RETURN[numUndel, totalMsgs, TRUE]; { entryRope: ROPE ~ stream.GetLineRope[]; IF ( NOT IsEntryFound[entryRope, start] ) THEN RETURN; }; { identRope: ROPE ~ stream.GetTokenRope[].token; startPos: INT ~ stream.GetIndex[]; IF ( NOT IsIdentFound[identRope, RelTOCPointerRope, startPos, TRUE] ) THEN { IF NOT IsIdentFound[identRope, TOCPointerRope, startPos] THEN RETURN; isRelToc Ź FALSE; -- not relative tocPointer }; [] Ź stream.GetChar[]; }; { tocStart: INT Ź stream.GetInt[]; -- int is position for TOCEntries entry IF isRelToc THEN tocStart Ź tocStart + start; IF ( tocStart >= streamLen ) OR ( tocStart < start ) THEN { Report["\n *** Bad TOCEntries pointer (%g) in entry at pos %g - some messages may not be available\n", [integer[tocStart]], [integer[start]] ]; RETURN; }; stream.SetIndex[tocStart]; }; { entryRope: ROPE ~ stream.GetLineRope[]; IF ( NOT IsEntryFound[entryRope, start] ) THEN RETURN; }; { identRope: ROPE ~ stream.GetTokenRope[].token; startPos: INT ~ stream.GetIndex[]; IF ( NOT IsIdentFound[identRope, RelTOCEntriesRope, startPos, TRUE] ) THEN { IF ( NOT IsIdentFound[identRope, TOCEntriesRope, startPos] ) THEN RETURN; isRelEntries Ź FALSE; }; [] Ź stream.GetChar[]; }; thisRead Ź stream.GetInt[]; [] Ź stream.GetChar[]; totalMsgs Ź totalMsgs + thisRead; FOR i: INT IN [0..thisRead) DO weAreHere: INT; this: MsgHandle ~ NEW[MsgHandleRec]; this.charPos Ź stream.GetIndex[]; -- where the del char goes this.deleted Ź stream.GetChar[] = '*; -- first char in loc line this.unRead Ź stream.GetChar[] = '?; -- second char in loc line this.toc Ź stream.GetLineRope[]; this.headersPos Ź stream.GetInt[]; this.textLen Ź stream.GetInt[]; this.formatPos Ź stream.GetInt[]; this.formatLen Ź stream.GetInt[]; this.entryStart Ź stream.GetInt[]; this.entryLen Ź stream.GetInt[]; [] Ź stream.GetChar[]; -- trailing CR IF isRelEntries THEN { this.headersPos Ź this.headersPos + start; IF this.formatPos # 0 THEN this.formatPos Ź this.formatPos + start; this.entryStart Ź this.entryStart + start; }; weAreHere Ź stream.GetIndex[]; -- GetMsgID will change the position this.gvID Ź GetMsgID[msInfo, this]; stream.SetIndex[weAreHere]; IF NOT this.deleted THEN numUndel Ź numUndel + 1; IF ( first = NIL ) THEN { current Ź first Ź this } ELSE { current.next Ź this; current Ź current.next }; ENDLOOP; IF customProcs#NIL AND customProcs.insertMsgs#NIL THEN customProcs.insertMsgs[msInfo, first] ELSE AppendMsgs[msInfo, first, current]; ENDLOOP; EXITS notgood => NULL; END; }; DoCopyOrExpunge: PUBLIC PROC [msInfo: MsgSetInfo, logName: ROPE, altFileData: BCFileData, sortem: BOOL] RETURNS[newList, newLast: MsgHandle Ź NIL]~ { msiData: MsiData ~ NARROW[msInfo.data]; numMsgs: INT; msgStream, mailStrm: IO.STREAM; segmentStart, tocStart, endMarker: INT; entryLen, delta: INT; msgStream Ź altFileData.readStream; mailStrm Ź altFileData.writeStream; BEGIN ENABLE IO.EndOfStream => { Report["\n***IO.EndOfStream during CopyOrExpunge - quitting\n" ]; mailStrm.Close[]; IF msgStream # mailStrm THEN msgStream.Close[]; GOTO exit }; segmentStart Ź mailStrm.GetLength[]; mailStrm.SetIndex[segmentStart]; mailStrm.PutF[relTocPointerEntryTemplate, [integer[0]], [integer[0]] ]; msgStream.Flush[]; -- need to flush read stream when write stream changes entryLen Ź mailStrm.GetIndex[] - segmentStart; IF sortem THEN SortByDate[msInfo, msiData.useFromFieldInTOC]; -- JKF [numMsgs, newList] Ź WriteMsgs[msInfo, mailStrm]; tocStart Ź mailStrm.GetLength[]; msgStream.Flush[]; newLast Ź WriteTOC[msgStream, mailStrm, numMsgs, segmentStart, newList, msiData.useFromFieldInTOC]; endMarker Ź mailStrm.GetLength[]; delta Ź endMarker - segmentStart; mailStrm.SetIndex[segmentStart]; mailStrm.PutF[relTocPointerEntryTemplate, [integer[entryLen]], [integer[tocStart-segmentStart]] ]; msgStream.Close[]; IF mailStrm # msgStream THEN mailStrm.Close[]; EXITS exit => RETURN END; Report["\n%g messages written to %g\n", [integer[numMsgs]], [rope[logName]] ]; }; DoAppendMsg: PUBLIC PROC[msInfo: MsgSetInfo, msgID, plainText, formatting: ROPE] = { writer: IO.STREAM ~ msInfo.fileData.writeStream; msiData: MsiData ~ NARROW[msInfo.data]; posForEntry: INT Ź writer.GetLength[]; entryLen, posForMsg, msgTemplatePos, headersPos, textLen, formatPos, formatLen: INT; initialCR: BOOL Ź FALSE; msgH, last: MsgHandle; writer.SetIndex[posForEntry]; writer.PutF[relTocPointerEntryTemplate, [integer[0]], [integer[0]] ]; entryLen Ź writer.GetIndex[] - posForEntry; posForMsg Ź writer.GetLength[]; writer.PutF1[headerEntryTemplate, [integer[0]] ]; msgTemplatePos Ź writer.GetIndex[]; writer.PutF[createMsgTemplate, [rope[msgID]], [integer[0]], [integer[0]] ]; headersPos Ź writer.GetIndex[]; IF ( formatting # NIL ) AND ( plainText.Length[] > 0 ) THEN { firstChar: CHAR ~ plainText.Fetch[0]; IF ( initialCR Ź ( firstChar = '\r )) THEN plainText Ź plainText.Substr[1]; }; textLen Ź plainText.Length[]; writer.PutRope[plainText]; IF formatting # NIL THEN { formatPos Ź writer.GetLength[]; formatLen Ź formatting.Length[]; } ELSE formatPos Ź formatLen Ź 0; writer.PutRope[formatting]; writer.PutChar['\r]; IF ( NOT initialCR ) AND ( formatting # NIL ) THEN { textLen Ź textLen - 1; headersPos Ź headersPos + 1; }; writer.SetIndex[msgTemplatePos]; writer.PutF[createMsgTemplate, [rope[msgID]], [integer[textLen]], [integer[formatLen]] ]; StrmFlush[writer, msiData]; msgH Ź NEW[MsgHandleRec Ź [gvID: msgID, headersPos: headersPos, textLen: textLen, formatPos: formatPos, formatLen: formatLen] ]; writer.SetIndex[posForMsg]; msgH.entryStart Ź posForMsg; msgH.entryLen Ź writer.GetLength[] - posForMsg; writer.PutF1[headerEntryTemplate, [integer[msgH.entryLen]] ]; msgH.unRead Ź FALSE; { now: INT ~ writer.GetLength[]; entryLen: INT ~ posForMsg-posForEntry; writer.SetIndex[posForEntry]; writer.PutF[relTocPointerEntryTemplate, [integer[entryLen]], [integer[now - posForEntry]] ]; last Ź WriteTOC[msInfo.fileData.readStream, msInfo.fileData.writeStream, 1, posForEntry, msgH, msiData.useFromFieldInTOC]; CloseAndOpen[msInfo]; }; IF customProcs#NIL AND customProcs.newMail#NIL THEN customProcs.newMail[msInfo, msgH]; IF customProcs#NIL AND customProcs.insertMsgs#NIL THEN customProcs.insertMsgs[msInfo, msgH] ELSE AppendMsgs[msInfo, msgH, last]; }; AppendMsgs: PUBLIC PROC [msInfo: MsgSetInfo, first: MsgHandle, last: MsgHandle] ~ { SELECT TRUE FROM ( first = NIL ) => { NULL }; -- no messages in this chunk ( msInfo.last = NIL ) => { -- splice onto front of msInfo msInfo.first Ź first; msInfo.last Ź last; }; ENDCASE => { -- splice onto tail of msInfo msInfo.last.next Ź first; msInfo.last Ź last; }; }; DateObj: TYPE = RECORD [ date: BasicTime.GMT, mh: MsgHandle]; SortByDate: PROC [msInfo: MsgSetInfo, useFromFieldInTOC: BOOL] = { EachNode: RedBlackTree.EachNode --PROC [data: UserData] RETURNS [stop: BOOL Ź FALSE]-- = { ro: REF DateObj Ź NARROW[data]; mh: MsgHandle Ź ro.mh; mh.next Ź NIL; IF first = NIL THEN first Ź mh ELSE last.next Ź mh; last Ź mh}; nullMsg: MsgHandleRec = [NIL, NIL, FALSE, TRUE, 0, 0, 0, 0, 0, 0, 0, NIL, NIL, NIL, NIL]; first: MsgHandle Ź NIL; last: MsgHandle Ź NIL; reader: STREAM Ź msInfo.fileData.readStream; table: RedBlackTree.Table Ź RedBlackTree.Create[GetKey, Compare]; FOR msgH: MsgHandle Ź msInfo.first, msgH.next WHILE ( msgH # NIL ) DO do: REF DateObj Ź NEW[DateObj Ź [BasicTime.nullGMT, msgH]]; reader.SetIndex[msgH.headersPos]; [, do.date] Ź TOCFromStream[reader, msgH.textLen, useFromFieldInTOC]; <> RedBlackTree.Insert[table, do, do ! RedBlackTree.DuplicateKey => { savednext: MsgHandle Ź msgH.next; <> msgH Ź nullMsg; msgH.next Ź savednext; CONTINUE}]; ENDLOOP; RedBlackTree.EnumerateIncreasing[table, EachNode]; msInfo.first Ź first; msInfo.last Ź last; RedBlackTree.DestroyTable[table]; }; GetKey: RedBlackTree.GetKey --PROC [data: UserData] RETURNS [Key]-- = { rr: REF DateObj Ź NARROW[data]; RETURN[rr] }; Compare: RedBlackTree.Compare --PROC [k: Key, data: UserData] RETURNS [Basics.Comparison]-- = { lo: REF DateObj Ź NARROW[data]; ro: REF DateObj Ź NARROW[k]; period: INT Ź BasicTime.Period[lo.date, ro.date]; SELECT TRUE FROM period < 0 => RETURN[less]; period > 0 => RETURN[greater]; ENDCASE => RETURN[equal] }; <> ReadAnyNewMail: PUBLIC ENTRY PROC [msInfo: MsgSetInfo] ~ { msiData: MsiData ~ NARROW[msInfo.data]; rh: MailRetrieve.Handle ~ GetRetrieveHandle[].mHandle; posForMsgs: INT; numMsgs: INT; msgH: MsgHandle; last: MsgHandle; IF rh = NIL THEN RETURN; IF userRNameList = NIL THEN { UpdateUserInternal[msiData]; IF userRNameList = NIL THEN { -- still NIL, tell user to login Report["\n*****You must login - no mail retrieved\n"]; RETURN }; }; Report["\n ~~~ Retrieving mail for %g @ %g\n", [rope[userRNameList.first.name]], [time[BasicTime.Now[]]] ]; DO -- for each server reader: IO.STREAM ~ msInfo.fileData.readStream; -- cf CloseAndOpen below writer: IO.STREAM ~ msInfo.fileData.writeStream; posForEntry: INT Ź writer.GetLength[]; noMore, retrieveOK: BOOL Ź FALSE; writer.SetIndex[posForEntry]; [numMsgs, msgH, posForMsgs, noMore, retrieveOK] Ź DoOneServer[msInfo, msiData, writer]; IF noMore THEN { TRUSTED { Process.Detach[FORK ForceStateOff[]] }; RETURN; } ELSE IF NOT retrieveOK THEN { IF ( writer.GetLength[] > posForEntry ) THEN SetFileLength[msInfo, posForEntry]; LOOP; }; <> IF numMsgs > 0 THEN { now: INT ~ writer.GetLength[]; entryLen: INT ~ posForMsgs-posForEntry; writer.SetIndex[posForEntry]; writer.PutF[relTocPointerEntryTemplate, [integer[entryLen]], [integer[now - posForEntry]] ]; }; last Ź WriteTOC[msInfo.fileData.readStream, msInfo.fileData.writeStream, numMsgs, posForEntry, msgH, msiData.useFromFieldInTOC]; CloseAndOpen[msInfo]; IF msiData.okToFlushMail THEN -- now we can flush the server MailRetrieve.Accept[rh ! MailRetrieve.Failed => { Report["\n Messages not flushed: why=%g, msg=%g\n", [atom[FailedWhyToAtom[why]]], [rope[text]] ]; CONTINUE }] ELSE Report["\n Messages not flushed - okToFlushMail is FALSE\n"]; IF customProcs#NIL AND customProcs.newMail#NIL THEN customProcs.newMail[msInfo, msgH]; IF customProcs#NIL AND customProcs.insertMsgs#NIL THEN customProcs.insertMsgs[msInfo, msgH] ELSE AppendMsgs[msInfo, msgH, last]; ENDLOOP; }; TOCFromStream: PROC [stream: STREAM, len: INT, useFromFieldInTOC: BOOL] RETURNS [toc: ROPE, mDate: BasicTime.GMT Ź BasicTime.nullGMT] ~ { mPos: INT Ź 0; NextChar: PROC RETURNS [ ch: CHAR ] ~ { IF ( mPos > len ) THEN ch Ź MailParse.endOfInput ELSE ch Ź stream.GetChar[ ! IO.EndOfStream => { mPos Ź len; ch Ź MailParse.endOfInput; CONTINUE } ]; mPos Ź mPos.SUCC; }; pH: MailParse.ParseHandle Ź MailParse.InitializeParse[]; mFrom, mTo, mSubject, mSender: ROPE; savedFrom, tocx, rDate: ROPE; ch: CHAR ~ stream.PeekChar[]; IF ( ch = '\n ) OR ( ch = '\r ) THEN { [] Ź stream.GetChar[]; mPos Ź 1 }; <> { ENABLE MailParse.ParseError => GOTO parseErrorExit; fieldName: ROPE Ź NIL; wantThisField, continue: BOOL Ź TRUE; DO fieldName Ź MailParse.GetFieldName[pH, NextChar]; SELECT TRUE FROM ( fieldName = NIL ) => { EXIT }; ( fieldName.Equal[date, FALSE] ) => { body: ROPE ~ MailParse.GetFieldBody[pH, NextChar]; mDate Ź Convert.TimeFromRope[body ! Convert.Error => CONTINUE ]; }; ( fieldName.Equal[subject, FALSE] ) => { mSubject Ź MailParse.GetFieldBody[pH, NextChar]; }; ( fieldName.Equal[sender, FALSE] ) => { savedFrom Ź mSender; mSender Ź MailParse.GetFieldBody[pH, NextChar]; }; ( fieldName.Equal[to, FALSE] ) => { mTo Ź MailParse.GetFieldBody[pH, NextChar]; }; ( fieldName.Equal[from, FALSE] ) => { body: ROPE = MailParse.GetFieldBody[pH, NextChar]; IF mSender = NIL THEN mSender Ź body ELSE savedFrom Ź body; }; ENDCASE => { [] Ź MailParse.GetFieldBody[pH, NextChar, TRUE]; }; ENDLOOP; MailParse.FinalizeParse[pH]; EXITS parseErrorExit => { MailParse.FinalizeParse[pH]}; }; IF ( mDate = BasicTime.nullGMT ) THEN mDate Ź BasicTime.Now[]; IF ( ( useFromFieldInTOC ) AND ( savedFrom # NIL ) ) THEN mSender Ź savedFrom; mFrom Ź IF ( IsCurrentUser[mSender] ) THEN Rope.Concat["To: ", mTo] ELSE mSender; rDate Ź Rope.Substr[Convert.RopeFromTimeRFC822[mDate, FALSE], 0, 9]; tocx Ź rDate.Cat[" ", mFrom]; tocx Ź SquashRopeIntoWidth[tocx, 165]; toc Ź tocx.Concat[mSubject]; }; DoOneServer: PROC [msInfo: MsgSetInfo, msiData: MsiData, stream: IO.STREAM] RETURNS [numMsgs: INT Ź 0, msgHandle: MsgHandle, posForMsgs: INT Ź 0, noMore: BOOL Ź TRUE, retrieveOK: BOOL Ź FALSE] ~ { ENABLE UNWIND => GOTO unwinding; rh: MailRetrieve.Handle Ź GetRetrieveHandle[].mHandle; lastMsgHandle: MsgHandle; serverKnown: BOOL Ź FALSE; IF userRNameList = NIL THEN { Report["\n*****You must login - no mail retrieved\n"]; RETURN }; stream.SetIndex[stream.GetLength[]]; SELECT MailRetrieve.MailboxState[rh] FROM badName => Report["\nSome mailbox reported badName - possibly no mailBox\n"]; badPwd => Report["\nSome mailbox reported badPwd\n"]; cantAuth => Report["\nSome server not found\n"]; ENDCASE => { NULL }; -- ok to try { -- do one server. state: RetrieveState; <<>> <> serverState: MailRetrieve.ServerState; -- The state of the server. serverName: MailBasics.RName; serverType: MailRetrieve.ServerType; thisMsgHandle, thisLastMsgHandle: MsgHandle; { ENABLE UNWIND => { DO [noMore, serverState, serverType] Ź MailRetrieve.NextServer[rh]; -- cycle thru servers IF ( NOT noMore ) THEN LOOP; ENDLOOP; }; [noMore, serverState] Ź MailRetrieve.NextServer[rh]; IF ( noMore ) THEN RETURN; -- Last server? Then done. serverKnown Ź TRUE; serverName Ź MailRetrieve.ServerName[rh]; Report["%g: ", [rope[serverName.name]] ]; SELECT serverState FROM unknown => { Report[" did not respond\n"] }; empty => { Report[" empty\n"] }; notEmpty => { curPos: INT Ź stream.GetLength[]; stream.PutF[relTocPointerEntryTemplate, [integer[0]], [integer[0]] ]; posForMsgs Ź stream.GetLength[]; [numMsgs, state, msgHandle, lastMsgHandle] Ź DrainServer[stream, rh, msiData]; IF ( numMsgs = -1 ) THEN { stream.SetLength[curPos]; StrmFlush[stream, msiData]; Report[" no messages (%g) retrieved?\n", [integer[numMsgs]] ] } ELSE { Report[" %g messages\n", [integer[numMsgs]] ]; retrieveOK Ź TRUE; }; }; ENDCASE => { NULL }; }; }; -- End of servers loop, exit. IF ( NOT serverKnown ) THEN Report["\nNoMailboxes"]; EXITS unwinding => Report["UNWIND during newMail\n" ]; }; DrainServer: PROC [stream: IO.STREAM, rh: MailRetrieve.Handle, msiData: MsiData] RETURNS [num: INT, state: RetrieveState, msgH, lastMsgH: MsgHandle] ~ { <> ENABLE UNWIND => NULL; msgState: MsgState; thisMsgH: MsgHandle; num Ź 0; DO [msgState, state, thisMsgH] Ź ReadMessageItems[stream, rh, msiData]; SELECT msgState FROM noMore => { EXIT }; OK, wasDeleted => { NULL }; readButNotFlushed => { NULL }; -- will do something different eventually retrieveFailed => { num Ź -1; EXIT }; ENDCASE => { ERROR }; IF ( NOT ( msgState = wasDeleted ) ) THEN { IF ( num Ź num.SUCC ) MOD 10 = 0 THEN Report ["! "] ELSE Report["."]; }; IF ( msgH = NIL ) THEN msgH Ź lastMsgH Ź thisMsgH ELSE IF ( thisMsgH # NIL ) THEN { lastMsgH.next Ź thisMsgH; lastMsgH Ź thisMsgH }; ENDLOOP; }; MsgState: TYPE ~ { OK, retrieveFailed, noMore, wasDeleted, readButNotFlushed }; errorRope: ROPE ~ " ... %g error, exp: %g\n"; ReadMessageItems: PROC [stream: IO.STREAM, rh: MailRetrieve.Handle, msiData: MsiData] RETURNS [msgState: MsgState, state: RetrieveState, msgH: MsgHandle] ~ { <> ENABLE BEGIN MailRetrieve.Failed => { state Ź FailedWhyToAtom[why]; Report[errorRope, [atom[state]], [rope[text]] ]; GOTO retFailed; }; IO.Error => { state Ź IO.AtomFromErrorCode[ec]; Report[errorRope, [atom[state]], [rope[msg]] ]; GOTO retFailed; }; END; msgExists, archived, deleted, read: BOOL; msgState Ź OK; state Ź $OK; [msgExists, archived, deleted, read] Ź MailRetrieve.NextMessage[rh]; SELECT TRUE FROM ( deleted ) => { msgState Ź wasDeleted; RETURN }; ( NOT msgExists ) => { msgState Ź noMore; RETURN }; ( read ) => msgState Ź readButNotFlushed; -- more on this later ENDCASE => { NULL }; { <> ok: BOOL; [ok, msgH] Ź MsgToStream[rh, stream, msiData]; IF ( NOT ok ) THEN msgState Ź retrieveFailed; }; EXITS retFailed => { msgState Ź retrieveFailed }; }; FailedWhyToAtom: PROC[why: MailRetrieve.FailureReason] RETURNS[a: ATOM] ~ { a Ź SELECT why FROM $communicationFailure => $communicationFailure, $noSuchServer => $noSuchServer, $connectionRejected => $connectionRejected, $badCredentials => $badCredentials, $unknownFailure => $unknownFailure, ENDCASE => $unknownError; }; IdOnFileWithSender: PROC [ts: MailBasics.Timestamp, sender: MailBasics.RName] RETURNS [idOnFile: ROPE] ~ { msgNameWithSenderFormat: ROPE ~ "%g %g"; thisSender: ROPE Ź sender.name; IF ( thisSender.Fetch[0] = '" ) THEN { pos: INT ~ thisSender.Find["\"", 1]; IF ( pos # -1 ) THEN thisSender Ź Rope.Concat[thisSender.Substr[1, pos.PRED], thisSender.Substr[pos.SUCC]]; }; RETURN[IO.PutFR[msgNameWithSenderFormat, [rope[thisSender]], [rope[ts]]] ]; }; MsgToStream: PROC [rh: MailRetrieve.Handle, stream: STREAM, msiData: MsiData] RETURNS [ok: BOOL Ź FALSE, msgH: MsgHandle Ź NIL] ~ { <> entryPos: INT ~ stream.GetLength[]; { ENABLE UNWIND => { stream.SetLength[entryPos] }; -- might this fail if out of space? msgTemplatePos: INT; headersPos, textLen: INT; formatPos, formatLen: INT Ź 0; initialCR: BOOL Ź FALSE; timeStamp: MailBasics.Timestamp; sender: MailBasics.RName; msg, plainText, formatting: ROPE; [timeStamp, sender, ] Ź MailRetrieve.StartMessage[rh]; msg Ź IdOnFileWithSender[timeStamp, sender]; stream.SetIndex[entryPos]; -- make sure at end <<>> <> stream.PutF1[headerEntryTemplate, [integer[0]] ]; msgTemplatePos Ź stream.GetIndex[]; stream.PutF[createMsgTemplate, [rope[msg]], [integer[0]], [integer[0]] ]; headersPos Ź stream.GetIndex[]; [plainText, formatting, textLen, , ] Ź MailMessage.ReadOneMessageX[rh, timeStamp, sender.name]; IF ( textLen = -1 ) THEN { stream.SetLength[entryPos]; StrmFlush[stream, msiData]; RETURN }; IF ( formatting # NIL ) AND ( plainText.Length[] > 0 ) THEN { firstChar: CHAR ~ plainText.Fetch[0]; IF ( initialCR Ź ( firstChar = '\r )) THEN plainText Ź plainText.Substr[1]; }; textLen Ź plainText.Length[]; stream.PutRope[plainText]; IF formatting # NIL THEN { formatPos Ź stream.GetLength[]; formatLen Ź formatting.Length[]; }; stream.PutRope[formatting]; stream.PutChar['\r]; <<{ endPos: INT ~ stream.GetLength[]; }; -- ASSERT end-header=text+format?>> IF ( NOT initialCR ) AND ( formatting # NIL ) THEN { textLen Ź textLen - 1; headersPos Ź headersPos + 1; }; stream.SetIndex[msgTemplatePos]; stream.PutF[createMsgTemplate, [rope[msg]], [integer[textLen]], [integer[formatLen]] ]; StrmFlush[stream, msiData]; msgH Ź NEW[MsgHandleRec Ź [headersPos: headersPos, textLen: textLen, formatPos: formatPos, formatLen: formatLen] ]; stream.SetIndex[entryPos]; msgH.entryStart Ź entryPos; msgH.entryLen Ź stream.GetLength[] - entryPos; stream.PutF1[headerEntryTemplate, [integer[msgH.entryLen]] ]; ok Ź TRUE; }; }; SquashRopeIntoWidth: PROC [s: ROPE, colWidth: INT] RETURNS [ROPE] ~ { <> width: INT; { ENABLE RuntimeError.BoundsFault => { GOTO doItTheHardWay }; width Ź VFonts.StringWidth[s]; DO IF ( width <= colWidth ) THEN EXIT; -- truncate { guessLength: INT Ź s.Length[] * colWidth / width; s Ź Rope.Concat[s.Substr[0, MAX[0, guessLength-4]], "..."]; width Ź VFonts.StringWidth[s]; }; ENDLOOP; EXITS doItTheHardWay => { [width, s]Ź DoItTheHardWay[s, colWidth] }; }; { <> blankCount: INT ~ ( (colWidth - width) / blankWidth ) + 1; -- force at least one blank some: INT ~ MIN[blankCount, blanks.Length[]]; white: ROPE ~ blanks.Substr[len: some]; s Ź s.Concat[white]; RETURN[s] }; }; DoItTheHardWay: PROC [s: ROPE, colWidth: INT] RETURNS [width: INT, s1: ROPE] ~ { thisWidth: INTEGER; dots: ROPE = "..."; nullWidth: INTEGER = VFonts.CharWidth['\000]; widthŹ VFonts.StringWidth[dots]; FOR i: INT IN [0 .. s.Length[]) DO thisWidthŹ VFonts.CharWidth[s.Fetch[i] ! RuntimeError.BoundsFault => thisWidth Ź nullWidth]; width Ź width + thisWidth; IF ( width > colWidth ) THEN { width Ź width - thisWidth; s1Ź Rope.Concat[s.Substr[0, MAX[0, i.PRED]], dots]; RETURN }; ENDLOOP; s1Ź s.Concat[dots]; }; RemoveComments: PROC [name: ROPE] RETURNS [shortName: ROPE] ~ { start, end: INT; name Ź name.Concat[" "]; <" in the name>> start Ź name.Find["<"]; IF ( start > 0 ) THEN { end Ź name.Find[">", start.SUCC]; IF ( end > 0 ) THEN name Ź name.Replace[start, end-start+1]; }; <> start Ź name.Find["("]; IF ( start > 0 ) THEN { end Ź name.Find[")", start.SUCC]; IF ( end > 0 ) THEN name Ź name.Replace[start, end-start+1]; }; shortName Ź name.Substr[len: name.Length[].PRED] }; <> bufsiz: NAT ~ RefText.page; copyBuffer: REF TEXT Ź NEW[TEXT[bufsiz]]; StrmToStrmCopy: PROC [to, from: IO.STREAM] ~ { DO IF ( from.GetBlock[copyBuffer, 0, bufsiz] = 0 ) THEN EXIT; to.PutBlock[copyBuffer]; ENDLOOP }; CopyBytes: PROC [to, from: IO.STREAM, num: INT] ~ { bytes: INT Ź num; WHILE ( bytes >= bufsiz ) DO [] Ź from.GetBlock[copyBuffer, 0, bufsiz]; to.PutBlock[copyBuffer]; bytes Ź bytes - bufsiz; ENDLOOP; IF ( bytes # 0 ) THEN { [] Ź from.GetBlock[copyBuffer, 0, bytes]; to.PutBlock[copyBuffer]; }; }; <> END.