WalnutParseMsgImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
last edited by: Willie-Sue, July 10, 1985 9:42:18 am PDT
procedures for parsing from streams and ropes
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] =
proc is called for each fieldName encountered in the headers; if proc = NIL then all fields are returned
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] =
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
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.