DIRECTORY GVMailParse, IO, Rope, RopeList USING [Append], WalnutParseMsg, WalnutSendOps USING [defaultRegistry]; WalnutParseMsgImpl: CEDAR PROGRAM IMPORTS GVMailParse, IO, Rope, RopeList, WalnutParseMsg, WalnutSendOps EXPORTS WalnutParseMsg = BEGIN OPEN WalnutParseMsg; ROPE: TYPE = Rope.ROPE; messageParseArray: PUBLIC ARRAY MessageFieldIndex OF MessageInfo _ [ ["Reply-to", simpleRope], -- this is really wrong, a special case for now ["Sender", simpleRope], ["From", simpleRope], ["To", rNameList], ["cc", rNameList], ["c", rNameList], ["bcc", rNameList], ["Date", simpleRope], ["Subject", simpleRope], ["Categories", rCatList], ["In-reply-to", simpleRope], ["VoiceFileID", simpleRope] ]; ParseMsgFromStream: PUBLIC PROC[strm: IO.STREAM, len: INT, proc: ParseProc] RETURNS[msgHeaders: MsgHeaders] = BEGIN OPEN GVMailParse; mPos: INT_ 0; pH: GVMailParse.ParseHandle_ GVMailParse.InitializeParse[]; NextChar: PROC[] RETURNS [ch: CHAR] = { IF mPos > len THEN ch_ endOfInput ELSE ch_ strm.GetChar[ ! IO.EndOfStream => {mPos_ len; ch_ endOfInput; CONTINUE} ]; mPos_ mPos + 1; }; msgHeaders_ NIL; BEGIN ENABLE ParseError => GOTO parseErrorExit; fieldName: ROPE_ NIL; found: BOOL; wantThisField, continue: BOOL_ TRUE; msgHeaders_ NIL; DO [fieldName, found]_ GVMailParse.GetFieldName[pH, NextChar]; IF ~found THEN EXIT; IF proc # NIL THEN [wantThisField, continue]_ proc[fieldName]; IF wantThisField THEN msgHeaders_ CONS[[fieldName, GVMailParse.GetFieldBody[pH, NextChar]], msgHeaders] ELSE []_ GVMailParse.GetFieldBody[pH, NextChar, TRUE]; IF ~continue THEN EXIT; ENDLOOP; GVMailParse.FinalizeParse[pH]; EXITS parseErrorExit => { GVMailParse.FinalizeParse[pH]; RETURN[msgHeaders]}; END; END; Parse: PUBLIC PROC[text: ROPE] RETURNS[status: SendParseStatus, sPos, mPos: INT, rList: LIST OF ROPE] = BEGIN OPEN GVMailParse; mLF: MessageInfo; lastCharPos: INT_ text.Length[] - 1; lastCharIsCR: BOOL_ (text.Fetch[lastCharPos] = '\n); GetNextChar: PROC[] RETURNS [ch: CHAR] = { IF mPos <= lastCharPos THEN ch_ text.Fetch[mPos] ELSE IF (mPos=lastCharPos+1) AND ~lastCharIsCR THEN ch_ '\n ELSE ch_ endOfInput; mPos_ mPos + 1; }; RNameListField: PROC[index: WalnutParseMsg.MessageFieldIndex] = BEGIN fieldBody, fbEnd: LIST OF ROPE_ NIL; AnotherRName: PROC[r1, r2: ROPE, isFile, isNested: BOOL] RETURNS [ROPE, BOOLEAN] = BEGIN name: ROPE _ CanonicalName[r1, r2]; countOfRecipients: INT_ 0; -- too lazy to figure this out now IF fbEnd=NIL THEN fbEnd_ fieldBody_ CONS[name, NIL] ELSE fbEnd_ fbEnd.rest_ CONS[name, NIL]; IF isFile THEN status_ includesPrivateDL ELSE IF name.Find["^"] < 0 THEN countOfRecipients_ countOfRecipients + 1 ELSE IF status # includesPrivateDL THEN status_ includesPublicDL; RETURN[NIL, FALSE]; END; ParseNameList[pH, GetNextChar, AnotherRName, NIL]; SELECT index FROM toF, ccF, cF, bccF => IF rList = NIL THEN rList_ fieldBody ELSE rList_ RopeList.Append[rList, fieldBody]; ENDCASE => NULL; END; pH: ParseHandle; field: ROPE_ NIL; fieldNotRecognized: BOOL; mPos_ 0; -- where we are in the fulltext status_ ok; -- start with good status pH_ InitializeParse[]; DO sPos_ mPos; [field, fieldNotRecognized]_ GetFieldName[pH, GetNextChar ! ParseError => { FinalizeParse[pH]; GOTO errorExit}]; IF ~fieldNotRecognized THEN EXIT; FOR i: WalnutParseMsg.MessageFieldIndex IN WalnutParseMsg.MessageFieldIndex DO { mLF_ WalnutParseMsg.messageParseArray[i]; IF Rope.Equal[WalnutParseMsg.messageParseArray[i].name, field, FALSE] THEN { fieldNotRecognized_ FALSE; IF mLF.fType = rNameList THEN RNameListField[i ! ParseError => GOTO errorExit] ELSE []_ GetFieldBody[pH, GetNextChar, TRUE]; }; }; ENDLOOP; IF fieldNotRecognized THEN []_ GetFieldBody[pH, GetNextChar, TRUE]; -- skip anything not recognized ENDLOOP; FinalizeParse[pH]; EXITS errorExit => RETURN[syntaxError, sPos, mPos, NIL]; END; CanonicalName: PUBLIC PROC [simpleName, registry: ROPE] RETURNS[name: ROPE] = BEGIN name_ simpleName; IF registry.Length[] = 0 THEN name_ name.Cat[".", WalnutSendOps.defaultRegistry] ELSE name_ name.Cat[".", registry]; END; END. ŠWalnutParseMsgImpl.mesa - procedures for parsing streams Copyright c 1984, 1985 by Xerox Corporation. All rights reserved. Willie-Sue, December 6, 1984 2:01:27 pm PST Russ Atkinson (RRA) March 21, 1985 0:42:18 am PST expects strm to be the beginning of a message; parses the header fields looking for fields, calling proc with each fieldName as found; if proc=NIL THEN return all fields ΚΕ˜codešœ8™8Kšœ Οmœ7™BKšœ+™+K™1—K˜šΟk ˜ K˜ Kšžœ˜Kšœ˜Kšœ žœ ˜Kšœ˜Kšœžœ˜&—K˜šœžœž˜!Kšžœžœ/˜FKšžœž œ˜3—˜Kšžœžœžœ˜—K˜šœžœžœžœ˜BšœΟc/˜LK˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜K˜——K˜š Οnœž œžœžœžœžœ˜mKšœ©™©šž œ ˜Kšœžœ˜ Kšœ;˜;K˜Kš œžœžœžœ˜%šœžœ žœ˜#Kšžœžœ-žœ˜TK˜—K˜K˜Kšœ žœ˜K˜Kšž œžœž˜/Kšœ žœžœ˜Kšœžœ˜ Kšœžœžœ˜$Kšœ žœ˜šž˜Kšœ;˜;Kšžœžœžœ˜Kšžœžœžœ,˜>šžœž˜Kšœ žœA˜QKšžœ,žœ˜6—Kšžœ žœžœ˜—Kšžœ˜K˜Kšœ˜šž˜Kšœ3žœ˜G—Kšžœ˜—Kšžœ˜K˜—K˜š œž œžœžœ&žœ žœžœžœ˜gšžœžœ ˜K˜Kšœ žœ˜$Kšœžœ"˜4K˜Kš  œžœžœžœ˜(šœžœžœ˜2šžœžœžœžœ˜;Kšžœ˜—K˜—K˜K˜š œžœ+˜?Kšž˜Kš œžœžœžœžœ˜$š  œžœ žœžœžœžœžœ˜Ršž˜Kšœžœ˜#KšœžœŸ"˜>š žœžœžœžœžœ˜3Kšžœžœžœ˜(—šžœžœ˜(šžœžœžœ)˜HKšžœžœžœ˜A——Kšžœžœžœ˜Kšžœ˜K˜——šœ-žœ˜2šžœž˜šœžœ žœžœ˜:Kšžœ*˜.——Kšžœžœ˜—Kšžœ˜K˜——K˜Kšœžœžœ˜Kšœžœ˜Kšœ Ÿ˜)Kšœ Ÿ˜&K˜K˜K˜šž˜K˜ ˜IKšœžœ ˜&—Kšžœžœžœ˜!šžœ%žœ"ž˜Nšœ+˜+šžœ=žœž˜Jšœžœ˜šžœž˜Kšœ!žœ ˜0—Kšžœ#žœ˜-—K˜——K˜—Kšžœ˜šžœž˜Kšœ"žœŸ˜H——Kšžœ˜K˜K˜K˜šž˜Kšœ žœžœ˜2—Kšžœ˜—K˜š   œžœžœžœžœžœ˜Mšž˜Kšœ˜šžœžœ3˜PKšžœ˜#——Kšžœ˜—K˜Kšžœ˜K˜K˜—…—Π