<<>> <> <> <> <> DIRECTORY Basics, BasicTime, Commander, Convert, IO, LoganBerry, LoganBerryEntry, RedBlackTree, RefText, Rope, RuntimeError, SimpleFeedback, SunRPC, SunRPCBinding, TapFilter, TapMsgQueue, UserProfile, WalnutDefs, WalnutOps, TabPostOffice; WalnutPostOfficeServerImpl: CEDAR PROGRAM IMPORTS Basics, BasicTime, Commander, Convert, IO, LoganBerryEntry, RedBlackTree, RefText, Rope, RuntimeError, SimpleFeedback, SunRPCBinding, TabPostOffice, TapFilter, TapMsgQueue, UserProfile, WalnutDefs, WalnutOps ~ BEGIN <> ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; MsgInfo: TYPE = TabPostOffice.MsgInfo; <> <> <> <> <> <> <> <> <> <> <> <> <<];>> server: SunRPC.Server; wH: WalnutOps.WalnutOpsHandle; noError: TabPostOffice.ErrorInfo = [errno: 0, msg: NIL]; noFilters: TabPostOffice.FilterSet = NEW[TabPostOffice.SeqType2Object[0]]; <> MsgEntry: TYPE = REF MsgEntryRecord; MsgEntryRecord: TYPE = RECORD [ walnutID: ROPE, info: MsgInfo, text: ROPE _ NIL, bodyStart: INT _ -1 ]; SessionInfo: TYPE = RECORD [ whenStarted: BasicTime.GMT, selectList: TabPostOffice.PropInfoArray, orderList: TabPostOffice.PropertyArray, msgs: RedBlackTree.Table ]; session: SessionInfo; <> StartSession: TabPostOffice.tpostartsessionProc ~ { <<[o: Server1, numselects: INT32, plist: PropInfoArray, numorders: INT32, olist: PropertyArray] RETURNS [res: SessionResult]>> <> <> ENABLE WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE}; pThreshold: INT ¬ -1; PrintDebug["BEGIN StartSession: numselects=%s, plist=%s, numorders=%s, olist=%s", IO.int[numselects], IO.rope[FmtPropI[plist]], IO.int[numorders], IO.rope[FmtPropA[olist]]]; session.whenStarted ¬ BasicTime.Now[]; session.selectList ¬ plist; session.orderList ¬ olist; session.msgs ¬ RedBlackTree.Create[getKey: GetKey, compare: CompareProc]; res.total ¬ 0; res.unread ¬ 0; res.new ¬ 0; IF plist = NIL OR plist.size = 0 THEN { -- use priority threshold by default pThreshold ¬ UserProfile.Number[key: "WalnutPostOffice.PriorityThreshold", default: 50]; }; wH ¬ WalnutOps.GetHandleForRootfile[UserProfile.Token["Walnut.WalnutRootFile"]]; FOR msgSets: LIST OF ROPE _ SelectedMsgSets[plist], msgSets.rest WHILE msgSets # NIL DO enum: WalnutOps.EnumeratorForMsgs; msg: ROPE; PrintDebug["Enumerating msgSet=%s", IO.rope[msgSets.first]]; enum ¬ WalnutOps.EnumerateMsgsInMsgSet[wH, msgSets.first ! WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE}]; msg ¬ WalnutOps.NextMsg[enum].msgID; WHILE msg # NIL DO IF MatchesPriority[msg, pThreshold] THEN { msgEntry: MsgEntry ¬ GetMsgEntry[msg]; IF MatchesSelect[msgEntry, plist] THEN { RedBlackTree.Insert[session.msgs, msgEntry, msgEntry! RedBlackTree.DuplicateKey => {PrintDebug["DuplicateKey!"]; CONTINUE}]; IF msgEntry.info.status # $Read THEN res.unread ¬ res.unread + 1; }; }; msg ¬ WalnutOps.NextMsg[enum].msgID; ENDLOOP; ENDLOOP; res.total ¬ AssignMsgIds[session]; res.new ¬ res.unread; -- technically this isn't right, but it's ok for now [res.loPri, res.hiPri] ¬ GetPriorityRange[session]; res.lastModifyTime ¬ 0; res.lastAccessTime ¬ LAST[INT32]; res.e ¬ noError; PrintDebug["END StartSession"]; }; GetMsgInfo: TabPostOffice.tpogetmsginfoProc ~ { <<[o: Server1, beginId: MsgID, endId: MsgID] RETURNS [res: MsgInfoResult]>> PrintDebug["BEGIN GetMsgInfo: beginId=%s, endId=%s", IO.int[beginId], IO.int[endId]]; res.info ¬ NEW[TabPostOffice.SeqType4Object[endId-beginId+1]]; FOR id: INT IN [beginId..endId] DO msgEntry: MsgEntry ¬ LookupById[session, id]; res.info[msgEntry.info.msgId-beginId] ¬ msgEntry.info; ENDLOOP; res.e ¬ noError; PrintDebug["END GetMsgInfo"]; }; GetMsgText: TabPostOffice.tpogetmsgtextProc ~ { <<[o: Server1, msgId: MsgID, beginByte: INT32, numBytes: INT32, whence: Whences] RETURNS [res: MsgTextResult]>> msgEntry: MsgEntry; PrintDebug["BEGIN GetMsgText: msgId=%s, beginByte=%s, numBytes=%s, whence=%s", IO.int[msgId], IO.int[beginByte], IO.int[numBytes], IO.rope[FmtWhence[whence]]]; msgEntry ¬ LookupById[session, msgId]; res.body ¬ msgEntry.text; IF whence = $BOB THEN res.body ¬ GetBody[res.body]; res.e ¬ noError; PrintDebug["END GetMsgText"]; }; CheckNewMail: TabPostOffice.tpochecknewmailProc ~ { <<[o: Server1] RETURNS [res: NewMailResult]>> PrintDebug["BEGIN CheckNewMail"]; res ¬ [newMail: FALSE, e: noError]; PrintDebug["END CheckNewMail"]; }; partialFolders: BOOLEAN ¬ TRUE; GetFolders: TabPostOffice.tpogetfoldersProc ~ { <<[o: Server1] RETURNS [res: FoldersResult]>> ENABLE WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE}; list: LIST OF ROPE; num: CARD ¬ 0; PrintDebug["BEGIN GetFolders"]; IF partialFolders THEN list ¬ LIST["Active", "CACM", "Cedar10", "LoganBerry", "Modula3", "ParcPad", "Tapestry", "Wallaby"] ELSE list ¬ WalnutOps.MsgSetNames[wH].mL; FOR mL: LIST OF ROPE _ list, mL.rest WHILE mL#NIL DO num ¬ num+1; ENDLOOP; res.numFolders ¬ num; res.folders ¬ NEW[TabPostOffice.SeqType3Object[num]]; num ¬ 0; FOR mL: LIST OF ROPE _ list, mL.rest WHILE mL#NIL DO res.folders[num] ¬ mL.first; num ¬ num+1; ENDLOOP; res.e ¬ noError; PrintDebug["END GetFolders"]; }; MarkMsg: TabPostOffice.tpomarkmsgProc ~ { <<[o: Server1, msgId: MsgID, markID: ROPE, markMsg: ROPE] RETURNS [res: ErrorInfo]>> PrintDebug["BEGIN MarkMsg: msgId=%s, markID=%s, markMsg=%s", IO.int[msgId], IO.rope[markID], IO.rope[markMsg]]; res ¬ noError; PrintDebug["END MarkMsg"]; }; EndSession: TabPostOffice.tpoendsessionProc ~ { <<[o: Server1] RETURNS [res: ErrorInfo]>> PrintDebug["BEGIN EndSession"]; res ¬ noError; PrintDebug["END EndSession"]; }; <> defaultMsgSet: ROPE = "Active"; SelectedMsgSets: PROC [selectList: TabPostOffice.PropInfoArray] RETURNS [msgsets: LIST OF ROPE] ~ { <> msgsets ¬ NIL; FOR i: INT IN [0..selectList.size) DO IF Rope.Equal[selectList[i].p, "Folder", FALSE] THEN { msgSet: ROPE; IF NOT Rope.Equal[selectList[i].r, "Equals", FALSE] THEN LOOP; -- not supported SELECT TRUE FROM Rope.Equal[selectList[i].v, "All", FALSE] => msgSet ¬ "ZZZAll"; Rope.Equal[selectList[i].v, "AllMail", FALSE] => msgSet ¬ "ZZZAll"; Rope.Equal[selectList[i].v, "NewMail", FALSE] => msgSet ¬ "ZZZNew"; Rope.Equal[selectList[i].v, "New", FALSE] => msgSet ¬ "ZZZNew"; ENDCASE => msgSet ¬ selectList[i].v; msgsets ¬ CONS[msgSet, msgsets]; }; ENDLOOP; IF msgsets = NIL THEN { msgsets ¬ UserProfile.ListOfTokens[key: "WalnutPostOffice.ActiveMessageSets", default: LIST[defaultMsgSet]]; }; }; MatchesPriority: PROC [walnutID: ROPE, threshold: INT] RETURNS [matches: BOOLEAN] ~ { <> priority: INT; IF threshold < 0 THEN RETURN[TRUE]; priority ¬ MsgInterestLevel[walnutID]; matches ¬ priority >= threshold; RETURN[matches]; }; MatchesSelect: PROC [msgEntry: MsgEntry, selectList: TabPostOffice.PropInfoArray] RETURNS [matches: BOOLEAN] ~ { <> matches ¬ TRUE; IF msgEntry = NIL THEN RETURN[FALSE]; FOR i: INT IN [0..selectList.size) DO IF Rope.Equal[selectList[i].p, "Priority", FALSE] THEN { threshold: INT ¬ -1; threshold ¬ Convert.IntFromRope[selectList[i].v ! Convert.Error => CONTINUE]; IF threshold = -1 THEN LOOP; -- bogus value SELECT TRUE FROM Rope.Equal[selectList[i].r, "GreaterThan", FALSE] => matches ¬ msgEntry.info.priority > threshold; Rope.Equal[selectList[i].r, "GreaterThanEquals", FALSE] => matches ¬ msgEntry.info.priority >= threshold; Rope.Equal[selectList[i].r, "Equals", FALSE] => matches ¬ msgEntry.info.priority = threshold; Rope.Equal[selectList[i].r, "LessThanEquals", FALSE] => matches ¬ msgEntry.info.priority <= threshold; Rope.Equal[selectList[i].r, "LessThan", FALSE] => matches ¬ msgEntry.info.priority < threshold; ENDCASE => NULL; }; IF matches = FALSE THEN EXIT; ENDLOOP; RETURN[matches]; }; <> <> GetKey: RedBlackTree.GetKey ~ { -- can't be an internal procedure in Cedar10.1 <<[data: UserData] RETURNS [Key]>> RETURN[data]; }; CompareProc: RedBlackTree.Compare ~ { <<[k: Key, data: UserData] RETURNS [Basics.Comparison]>> result: Basics.Comparison; key1: MsgEntry ¬ NARROW[k]; key2: MsgEntry ¬ NARROW[data]; IF key1.info.msgId # -1 AND key2.info.msgId # -1 THEN result ¬ Basics.CompareInt[key1.info.msgId, key2.info.msgId] ELSE result ¬ CompareList[key1, key2, session.orderList]; RETURN[result]; }; CompareList: PROC [m1, m2: MsgEntry, orderList: TabPostOffice.PropertyArray] RETURNS [Basics.Comparison] ~ { <> result: Basics.Comparison ¬ $equal; FOR i: INT IN [0..orderList.size) DO SELECT TRUE FROM Rope.Equal[orderList[i], "Priority", FALSE] => result ¬ ComparePriority[m1.info.priority, m2.info.priority]; Rope.Equal[orderList[i], "Date", FALSE] => result ¬ CompareDate[m1.info.date, m2.info.date]; Rope.Equal[orderList[i], "From", FALSE] => result ¬ Rope.Compare[m1.info.from, m2.info.from, FALSE]; Rope.Equal[orderList[i], "Subject", FALSE] => result ¬ Rope.Compare[m1.info.subject, m2.info.subject, FALSE]; Rope.Equal[orderList[i], "To", FALSE] => result ¬ Rope.Compare[m1.info.to, m2.info.to, FALSE]; Rope.Equal[orderList[i], "New", FALSE] => result ¬ CompareStatus[m1.info.status, m2.info.status, $New, TRUE]; Rope.Equal[orderList[i], "Old", FALSE] => result ¬ CompareStatus[m1.info.status, m2.info.status, $New, FALSE]; Rope.Equal[orderList[i], "Read", FALSE] => result ¬ CompareStatus[m1.info.status, m2.info.status, $Read, TRUE]; Rope.Equal[orderList[i], "Unread", FALSE] => result ¬ CompareStatus[m1.info.status, m2.info.status, $Read, FALSE]; ENDCASE => result ¬ $equal; IF result # $equal THEN EXIT; ENDLOOP; IF result = equal THEN result ¬ Rope.Compare[m1.walnutID, m2.walnutID]; RETURN [result]; }; ComparePriority: PROC [p1, p2: INT] RETURNS [Basics.Comparison] ~ { <> RETURN [Basics.CompareInt[p2, p1]]; }; CompareDate: PROC [d1, d2: ROPE, oldestFirst: BOOLEAN ¬ TRUE] RETURNS [Basics.Comparison] ~ { result: Basics.Comparison; t1, t2: BasicTime.GMT; t1 ¬ Convert.TimeFromRope[d1 ! Convert.Error => CONTINUE]; t2 ¬ Convert.TimeFromRope[d2 ! Convert.Error => CONTINUE]; SELECT BasicTime.Period[from: t1, to: t2] FROM > 0 => result ¬ IF oldestFirst THEN $less ELSE $greater; < 0 => result ¬ IF oldestFirst THEN $greater ELSE $less; ENDCASE => result ¬ $equal; RETURN [result]; }; CompareStatus: PROC [s1, s2, status: TabPostOffice.Status, statusFirst: BOOLEAN ¬ TRUE] RETURNS [Basics.Comparison] ~ { result: Basics.Comparison; SELECT TRUE FROM s1 = status AND s2 # status => result ¬ IF statusFirst THEN $less ELSE $greater; s1 # status AND s2 = status => result ¬ IF statusFirst THEN $greater ELSE $less; ENDCASE => result ¬ $equal; RETURN [result]; }; GetPriorityRange: PROC [session: SessionInfo] RETURNS [low, high: INT] ~ { LowHigh: RedBlackTree.EachNode ~ { <<[data: UserData] RETURNS [stop: BOOL ¬ FALSE]>> me: MsgEntry ¬ NARROW[data]; low ¬ MIN[low, me.info.priority]; high ¬ MAX[high, me.info.priority]; }; low ¬ LAST[INT]; high ¬ 0; RedBlackTree.EnumerateIncreasing[session.msgs, LowHigh]; }; AssignMsgIds: PROC [session: SessionInfo] RETURNS [total: INT] ~ { id: CARD ¬ 0; NextId: RedBlackTree.EachNode ~ { <<[data: UserData] RETURNS [stop: BOOL ¬ FALSE]>> mi: MsgEntry ¬ NARROW[data]; mi.info.msgId ¬ id; id ¬ id + 1; }; RedBlackTree.EnumerateIncreasing[session.msgs, NextId]; total ¬ id; }; <> lookupKey: MsgEntry ¬ NEW[MsgEntryRecord]; LookupById: PROC [session: SessionInfo, msgId: INT] RETURNS [entry: MsgEntry] ~ { data: RedBlackTree.UserData; lookupKey.info.msgId ¬ msgId; data ¬ RedBlackTree.Lookup[session.msgs, lookupKey]; entry ¬ NARROW[data]; }; <> GetMsgEntry: PROC [walnutID: ROPE] RETURNS [msgEntry: MsgEntry] ~ { <> <> ENABLE WalnutDefs.Error => {PrintDebug["WALNUT ERROR: who=%s, code=%s, explanation=%s", IO.atom[who], IO.atom[code], IO.rope[explanation]]; CONTINUE}; GetAndCheckMsgSize: PROC [walnutID: ROPE] RETURNS [nat: NAT] = { <> CheckForNat: PROC [len: INT] RETURNS[nat: NAT] = { nat ¬ len }; len: INT ¬ WalnutOps.GetMsgSize[wH, walnutID].textLen; lengthThreshold: INT ¬ UserProfile.Number[key: "WalnutPostOffice.LengthThreshold", default: 5000]; IF len < lengthThreshold THEN nat ¬ len ELSE nat ¬ 0; < {nat ¬ 0; CONTINUE};>> <> <> }; size: NAT; fields: LoganBerry.Entry; msgEntry ¬ NEW[MsgEntryRecord]; msgEntry.walnutID ¬ walnutID; size ¬ GetAndCheckMsgSize[walnutID]; IF size # 0 THEN { msgEntry.text ¬ RefText.TrustTextAsRope[WalnutOps.GetMsgText[wH, walnutID, NIL]]; } ELSE { PrintDebug["Msg <%s> too long so only grabbing headers", IO.rope[walnutID]]; msgEntry.text ¬ RefText.TrustTextAsRope[WalnutOps.GetMsgHeaders[wH, walnutID, NIL]]; msgEntry.text ¬ Rope.Concat[msgEntry.text, "\n*** Message too long! ***\n"]; }; msgEntry.text ¬ CrsToNls[msgEntry.text]; fields ¬ TapMsgQueue.EntryFromMsg[TapFilter.ParseMsgIntoFields[msgEntry.text]]; msgEntry.info.msgId ¬ -1; -- don't know ID yet since it depends on sort order msgEntry.info.from ¬ LoganBerryEntry.GetAttr[fields, $from]; msgEntry.info.to ¬ LoganBerryEntry.GetAttr[fields, $to]; msgEntry.info.cc ¬ LoganBerryEntry.GetAttr[fields, $cc]; msgEntry.info.subject ¬ LoganBerryEntry.GetAttr[fields, $subject]; msgEntry.info.date ¬ LoganBerryEntry.GetAttr[fields, $date]; msgEntry.info.priority ¬ MsgInterestLevel[walnutID]; msgEntry.info.filters ¬ noFilters; msgEntry.info.status ¬ IF WalnutOps.GetHasBeenRead[wH, walnutID] THEN $Read ELSE $Unread; msgEntry.info.bodyLength ¬ Rope.Length[msgEntry.text]; msgEntry.info.bodyLines ¬ msgEntry.info.bodyLength/30; -- a very rough estimate }; MsgInterestLevel: PUBLIC PROC [msg: ROPE] RETURNS [ilevel: INT] ~ { <> Max: PROC [values: LIST OF ROPE] RETURNS [max: INT] ~ { max ¬ -1; FOR rL: LIST OF ROPE ¬ values, rL.rest WHILE rL # NIL DO i: INT ¬ LoganBerryEntry.V2I[rL.first]; IF i > max THEN max ¬ i; ENDLOOP; }; annotationDBName: ROPE ¬ UserProfile.Token[key: "WallTapestry.AnnotationDB", default: NIL]; ilevel ¬ -1; IF annotationDBName # NIL THEN BEGIN annot: TapFilter.Annotation; annot ¬ TapFilter.GetAnnotations[annotDB: annotationDBName, msgID: msg]; ilevel ¬ Max[LoganBerryEntry.GetAllAttrs[entry: annot, type: $Level]]; ilevel ¬ MAX[ilevel, Max[LoganBerryEntry.GetAllAttrs[entry: annot, type: $level]]]; END; IF ilevel = -1 THEN ilevel ¬ 50; }; GetBody: PROC [whole: ROPE] RETURNS [body: ROPE] ~ { <> i, previ: INT ¬ -1; WHILE i < Rope.Length[whole] DO previ ¬ i; i ¬ Rope.SkipTo[s: whole, pos: previ+1, skip: "\l\n\r"]; IF i = previ+1 THEN EXIT; ENDLOOP; body ¬ Rope.Substr[whole, i+1]; RETURN[body]; }; CrsToNls: PROC [old: ROPE] RETURNS [new: ROPE] ~ { <> TransCrsToNls: Rope.TranslatorType ~ { <> IF old = '\r THEN RETURN['\l] ELSE RETURN[old]; }; new ¬ Rope.Translate[base: old, translator: TransCrsToNls]; }; <> FmtPropI: PROC [v: TabPostOffice.PropInfoArray] RETURNS [rope: ROPE] ~ { rope ¬ NIL; FOR i: INT IN [0..v.size) DO IF rope#NIL THEN rope ¬ Rope.Concat[rope, "/"]; rope ¬ Rope.Cat[rope, v[i].p, "-", v[i].r]; rope ¬ Rope.Cat[rope, "-", v[i].v]; ENDLOOP; }; FmtPropA: PROC [v: TabPostOffice.PropertyArray] RETURNS [rope: ROPE] ~ { rope ¬ NIL; FOR i: INT IN [0..v.size) DO IF rope#NIL THEN rope ¬ Rope.Concat[rope, "/"]; rope ¬ Rope.Concat[rope, v[i]]; ENDLOOP; }; FmtWhence: PROC [v: TabPostOffice.Whences] RETURNS [rope: ROPE] ~ { SELECT v FROM $BOM => rope ¬ "BOM"; $BOB => rope ¬ "BOB"; ENDCASE; }; PrintDebug: PROC [format: Rope.ROPE ¬ NIL, v1, v2, v3, v4, v5: IO.Value ¬ [null[]]] ~ { SimpleFeedback.Append[$WalnutPostOffice, $begin, $Debug, "WalnutPostOffice: "]; SELECT TRUE FROM v1 = [null[]] => SimpleFeedback.Append[$WalnutPostOffice, $end, $Debug, format]; v2 = [null[]] => SimpleFeedback.PutF[$WalnutPostOffice, $end, $Debug, format, v1]; ENDCASE => SimpleFeedback.PutFL[$WalnutPostOffice, $end, $Debug, format, LIST[v1, v2, v3, v4, v5]]; }; <> ExportService: PROC [] RETURNS [] ~ { server ¬ TabPostOffice.MakeServer1Server [ data: NIL, tpostartsession: StartSession, tpogetmsginfo: GetMsgInfo, tpogetmsgtext: GetMsgText, tpochecknewmail: CheckNewMail, tpogetfolders: GetFolders, tpomarkmsg: MarkMsg, tpoendsession: EndSession ]; server ¬ SunRPCBinding.Export[unboundServer: server, transport: $TCP]; }; DoIt: Commander.CommandProc ~ { ExportService[]; IO.PutRope[cmd.out, "Walnut PostOffice server is now running.\n"]; }; Commander.Register["WalnutPostOfficeServer", DoIt, "Start Walnut PostOffice server"]; END.