<> <> <> <<>> <> 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] ]; ParseHeadersFromRope: PUBLIC PROC[headers: ROPE, proc: ParseProc] RETURNS[msgHeaders: MsgHeaders] = <> BEGIN OPEN GVMailParse; mPos: INT _ 0; len: INT _ headers.Length[]; pH: GVMailParse.ParseHandle _ GVMailParse.InitializeParse[]; NextChar: PROC[] RETURNS [ch: CHAR] = { IF mPos >= len THEN ch _ endOfInput ELSE ch _ headers.Fetch[mPos]; mPos _ mPos + 1; }; msgHeaders _ NIL; IF headers.Fetch[0] = '\n THEN mPos _ 1; -- ignore initial CR (tioga formatting nonsense) BEGIN ENABLE ParseError => GOTO parseErrorExit; fieldName: ROPE _ NIL; found: BOOL; wantThisField, continue: BOOL _ TRUE; 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; 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; IF strm.PeekChar[] = '\n THEN { -- ignore initial CR (tioga formatting nonsense) [] _ strm.GetChar[]; mPos _ 1; }; BEGIN ENABLE ParseError => GOTO parseErrorExit; fieldName: ROPE _ NIL; found: BOOL; wantThisField, continue: BOOL _ TRUE; 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.