<> <> <> <> 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.