<> <> <> <> <> <> DIRECTORY MailAnswer, MailBasics USING [RName], MailParse, IO, Rope; MailParseAndAnswerImpl: CEDAR MONITOR IMPORTS IO, Rope EXPORTS MailAnswer, MailParse = BEGIN OPEN MailParse, IO; <> <> openComment: CHAR = '(; closeComment: CHAR = '); quoteNext: CHAR = '\\; quotes: CHAR = '"; comma: CHAR = ',; colon: CHAR = ':; semiColon: CHAR = ';; openRoute: CHAR = '<; closeRoute: CHAR = '>; openSquareBracket: CHAR = '[; closeSquareBracket: CHAR = ']; dot: CHAR = '.; atSign: CHAR = '@; TokenType: TYPE = {atom, dot, atSign, comma, colon, semiColon, openRoute, closeRoute, domainLiteral, endOfLine, endOfList, endOfInput}; ParseInfo: PUBLIC TYPE = RECORD [ strm, tokenStrm, tempName: STREAM, giveACR: BOOL ¬ FALSE, peekChar: CHAR ¬ NUL]; ParseHandle: TYPE = REF ParseInfo; ParseError: PUBLIC ERROR [code: ParseErrorCode] = CODE; SyntaxError: ERROR = CODE; AnswerProc: TYPE = MailAnswer.AnswerProc; InitializeParse: PUBLIC PROC RETURNS [ph: ParseHandle] = <> <> <> <> <> <> <> { ph ¬ NEW[ParseInfo¬ [strm: ROS[], tokenStrm: ROS[], tempName: ROS[]]] }; -- of InitializeParse FinalizeParse: PUBLIC PROC [ph: ParseHandle] = { <> <> <> <> <> ph.strm.Close[]; ph.tokenStrm.Close[]; ph.tempName.Close[]; }; -- of FinalizeParse -- GetFieldName: PUBLIC PROC [ph: ParseHandle, next: PROC RETURNS [CHAR]] RETURNS [fieldName: ROPE] = { <> <> <> <> <> <> <> <> char: CHAR; blanks: BOOL ¬ FALSE; ph.strm.Reset[]; DO SELECT char ¬ Get[ph, next] FROM CR, LF, endOfInput => { fieldName ¬ RopeFromROS[ph.strm, FALSE]; IF fieldName.Length[] = 0 THEN RETURN[NIL] ELSE ParseError[badFieldName]; }; ': => RETURN[RopeFromROS[ph.strm, FALSE]]; SP, TAB => blanks ¬ TRUE; endOfList, < 40C => ERROR ParseError[badFieldName]; ENDCASE => SELECT TRUE FROM blanks => ERROR ParseError[badFieldName]; ENDCASE => ph.strm.PutChar[char]; ENDLOOP; }; -- of GetFieldName -- GetFieldBody: PUBLIC PROC [ph: ParseHandle, next: PROC RETURNS [CHAR], suppressBody: BOOL ¬ FALSE, suppressWhiteSpace: BOOL ¬ FALSE] RETURNS [fieldBody: ROPE] = { <> <> <> <> <> <> <> char: CHAR; spaceSeen: BOOL ¬ TRUE; -- TRUE means ignore leading spaces RemoveTrailingSpace: PROC = INLINE BEGIN len: INT¬ fieldBody.Length[]; WHILE len > 0 AND fieldBody.Fetch[len-1] = SP DO len ¬ len - 1; ENDLOOP; fieldBody ¬ fieldBody.Substr[0, len]; END; -- of RemoveTrailingSpace -- IF ~suppressBody THEN ph.strm.Reset[]; DO SELECT char ¬ Get[ph, next] FROM SP, TAB => BEGIN IF spaceSeen THEN LOOP; IF suppressWhiteSpace THEN {char ¬ SP; spaceSeen ¬ TRUE}; END; endOfInput => GO TO Trouble; endOfList, CR, LF => EXIT; ENDCASE => spaceSeen ¬ FALSE; IF ~suppressBody THEN ph.strm.PutChar[char]; ENDLOOP; IF ~suppressBody THEN { fieldBody¬ RopeFromROS[ph.strm, FALSE]; RemoveTrailingSpace[]}; EXITS Trouble => ERROR ParseError[badFieldBody]; }; -- of GetFieldBody -- NameList: PUBLIC PROC[ph: ParseHandle, transport: ATOM, next: PROC RETURNS[CHAR], proc: PROC[rName: RName] RETURNS[nameToWrite: ROPE], write: PROC [ROPE] ¬ NIL ] = { <> <> <> error: ParseErrorCode ¬ none; eol: BOOL ¬ FALSE; recognized: BOOL ¬ FALSE; rName: MailBasics.RName; nameToWrite: ROPE; outputStrm: STREAM ¬ IF write = NIL THEN NIL ELSE ph.strm; tokenStrm: STREAM ¬ ph.tokenStrm; tempName: STREAM ¬ ph.tempName; <> IF outputStrm # NIL THEN outputStrm.Reset[]; UNTIL eol DO char: CHAR; tempName.Reset[]; DO SELECT (char ¬ Get[ph, next] ) FROM -- consume leading white space SP, TAB => LOOP; ENDCASE => EXIT; ENDLOOP; DO SELECT char FROM comma => EXIT; endOfInput => ERROR ParseError[truncated]; endOfList, CR, LF => { eol ¬ TRUE; EXIT }; ENDCASE => tempName.PutChar[char]; char ¬ Get[ph, next]; ENDLOOP; [recognized, rName] ¬ CheckForRecognizedName[RopeFromROS[ph.tempName, FALSE], transport]; IF NOT recognized THEN ParseError[badFieldBody]; nameToWrite ¬ proc[rName]; IF ( write # NIL ) AND ( nameToWrite # NIL ) THEN write[nameToWrite]; ENDLOOP; }; -- of NameList -- Get: PROC [ph: ParseHandle, next: PROC RETURNS[CHAR]] RETURNS [char: CHAR] = { <> <> IF ph.giveACR THEN { ph.giveACR ¬ FALSE; RETURN[CR] }; IF ph.peekChar = NUL THEN BEGIN char ¬ next[]; IF (char = CR ) OR (char = LF) THEN BEGIN ph.peekChar ¬ next[]; SELECT ph.peekChar FROM SP, TAB => { ph.peekChar ¬ NUL; RETURN[SP] }; ENDCASE; END; END ELSE { char ¬ ph.peekChar; ph.peekChar ¬ NUL }; }; -- of Get -- CheckForRecognizedName: PROC[temp: ROPE, transport: ATOM] RETURNS[recognized: BOOL ¬ FALSE, rName: RName] = { FOR pL: LIST OF ParseNameProcRec ¬ GetNameProcs[], pL.rest UNTIL pL=NIL DO SELECT TRUE FROM ( transport = NIL ), ( transport = $any ) => [recognized, rName] ¬ pL.first.proc[temp]; ( transport = pL.first.which) => { [recognized, rName] ¬ pL.first.proc[temp]; RETURN} ; ENDCASE => NULL; IF recognized THEN RETURN; ENDLOOP; }; MakeHeader: PUBLIC PROC[which: ATOM, getChar: PROC [INT] RETURNS [CHAR], inputLength: INT, userRName: RName, cForCopies: BOOL ¬ FALSE ] RETURNS [answerError: BOOL ¬ TRUE, answer: ROPE, errorIndex: INT ¬ 0] = { FOR aL: LIST OF AnswerProcRec ¬ GetAnswerProcs[], aL.rest UNTIL aL = NIL DO IF ( which = $any ) OR (which = aL.first.which ) THEN { [answerError, answer, errorIndex] ¬ aL.first.proc[getChar, inputLength, userRName, cForCopies]; RETURN }; ENDLOOP; }; GetNameProcs: ENTRY PROC RETURNS[LIST OF ParseNameProcRec] = INLINE { RETURN[nameProcList] }; ParseNameProcRec: TYPE = RECORD[which: ATOM, proc: ParseNameProc]; nameProcList: LIST OF ParseNameProcRec ¬ NIL; RegisterNameProc: PUBLIC ENTRY PROC[which: ATOM, nameProc: ParseNameProc] = { ENABLE UNWIND => NULL; nameProcList ¬ CONS[[which, nameProc], nameProcList]; }; convertNameProcList: LIST OF ConvertNameProc ¬ NIL; RegisterConvertNameProc: PUBLIC ENTRY PROC[convertProc: ConvertNameProc] = { ENABLE UNWIND => NULL; convertNameProcList ¬ CONS[convertProc, convertNameProcList]; }; AnswerProcRec: TYPE = RECORD[which: ATOM, proc: AnswerProc]; answerProcList: LIST OF AnswerProcRec ¬ NIL; GetAnswerProcs: ENTRY PROC RETURNS[LIST OF AnswerProcRec] = INLINE { RETURN[answerProcList] }; RegisterAnswerProc: PUBLIC ENTRY PROC[which: ATOM, proc: AnswerProc] = { ENABLE UNWIND => NULL; answerProcList ¬ CONS[[which, proc], answerProcList]; }; END.