-- File: ArpaMailParser.mesa
-- Last edited by Brotz, March 6, 1983 3:29 PM
-- Last edited by Taft, May 14, 1983 5:13 PM

DIRECTORY
Ascii USING [CR, DEL, NUL, SP, TAB],
MailParseDefs USING [endOfInput, endOfList, maxRecipientLength, ParseErrorCode],
Storage USING [Free, FreeString, Node, String],
String USING [AppendChar, AppendString, EquivalentString, StringBoundsFault];

ArpaMailParser: PROGRAM
IMPORTS Storage, String
EXPORTS MailParseDefs =

BEGIN
OPEN MailParseDefs;

-- Types --

-- Some special characters specified by RFC 822 --

openComment: CHARACTER = ’(;
closeComment: CHARACTER = ’);
quoteNext: CHARACTER = ’\;
quotes: CHARACTER = ’";
comma: CHARACTER = ’,;
colon: CHARACTER = ’:;
semiColon: CHARACTER = ’;;
openRoute: CHARACTER = ’<;
closeRoute: CHARACTER = ’>;
openSquareBracket: CHARACTER = ’[;
closeSquareBracket: CHARACTER = ’];
dot: CHARACTER = ’.;
atSign: CHARACTER = ’@;

TokenType: TYPE =
{atom, dot, atSign, comma, colon, semiColon, openRoute, closeRoute, domainLiteral,
endOfLine, endOfList, endOfInput};

ParseInfo: TYPE = RECORD
[next: PROCEDURE RETURNS [CHARACTER],
signalTruncation: BOOLEAN ← FALSE,
giveACR: BOOLEAN ← FALSE,
char: CHARACTER ← Ascii.NUL];
ParseHandle: PUBLIC TYPE = POINTER TO ParseInfo;

ParseError: PUBLIC ERROR [code: ParseErrorCode] = CODE;

SyntaxError: ERROR = CODE;


InitializeParse: PUBLIC PROCEDURE [next: PROCEDURE RETURNS [CHARACTER],
notifyTruncation: BOOLEAN ← FALSE] RETURNS [ph: ParseHandle] =
-- Initializes the header parser, and returns a ParseHandle which is to be passed to all other
-- procedures of this interface. Subsequent invocations of GetFieldName, GetFieldBody,
-- and ParseNameList will obtain their input using "next". If "notifyTruncation" is TRUE,
-- GetFieldName and GetFieldBody will raise ParseError[truncated] if the string they are
-- collecting overflows the string provided. (The signal is not raised until the entire field
-- name or body has been scanned.) If "notifyTruncation" is FALSE, this signal is
-- suppressed.
BEGIN
ph ← Storage.Node[SIZE[ParseInfo]];
ph↑ ← ParseInfo[next: next, signalTruncation: notifyTruncation];
END; -- of InitializeParse --


FinalizeParse: PUBLIC PROCEDURE [ph: ParseHandle] =
-- Finalizes the parser instance specified by "pH". This procedure must be called when the
-- client has finished parsing, either because of normal completion or because some error
-- has occurred. After calling this procedure, "pH" is no longer meaningful and must not
-- be reused. Note: FinalizeParse may not be called while a call to ParseNameList is
-- pending (for the same ParseHandle).
BEGIN
Storage.Free[ph];
END; -- of FinalizeParse --


GetFieldName: PUBLIC PROCEDURE [ph: ParseHandle, fieldNameOut: STRING]
RETURNS [found: BOOLEAN] =
-- GetFieldName presumes that "next" (see InitializeParse) is positioned to read the first
-- character of a field name and returns the field name, without the terminating colon,
-- in "fieldNameOut". GetFieldName leaves "next" ready to return the first character
-- following the colon (or, if the end of the message header has been reached, the
-- character (if any) after the two CRs that normally terminate the header). If the field
-- name is too long, the behavior of GetFieldName depends upon the "notifyTruncation"
-- parameter passed to InitializeParse. Upon return, "found" is FALSE if no field names
-- remain in the header. If the header field ends prematurely or illegal header characters
-- are encountered, ParseError[badFieldName] is raised.
BEGIN
char: CHARACTER;
truncated, blanks: BOOLEAN ← FALSE;

fieldNameOut.length ← 0;
DO
SELECT char ← Get[ph] FROM
Ascii.CR, endOfInput =>
IF fieldNameOut.length = 0 THEN RETURN[FALSE]
ELSE ERROR ParseError[badFieldName];
’: =>
IF truncated AND ph.signalTruncation THEN ERROR ParseError[truncated]
ELSE RETURN[TRUE];
Ascii.SP, Ascii.TAB => blanks ← TRUE;
endOfList, < 40C => ERROR ParseError[badFieldName];
ENDCASE =>
SELECT TRUE FROM
blanks => ERROR ParseError[badFieldName];
fieldNameOut.length = fieldNameOut.maxlength => truncated ← TRUE;
ENDCASE => String.AppendChar[fieldNameOut, char];
ENDLOOP;
END; -- of GetFieldName --


GetFieldBody: PUBLIC PROCEDURE
[ph: ParseHandle, fieldBodyOut: STRING, suppressWhiteSpace: BOOLEAN ← FALSE] =
-- The (remainder of the) current field body is read using "next" (see InitializeParse) and is
-- returned in "fieldBodyOut". If the field body is too long, the behavior GetFieldBody
-- depends upon the "notifyTruncation" parameter passed to InitializeParse. If the field
-- body terminates before a CR is seen, ParseError[badFieldBody] is raised. Upon return,
-- "fieldBodyOut" has no initial or terminal white space (blanks and tabs) and, if
-- "suppressWhiteSpace" is TRUE, each internal run of white space has been replaced by
-- a single blank. ArpaNet folding conventions are also observed.
BEGIN
char: CHARACTER;
truncated: BOOLEAN ← FALSE;
spaceSeen: BOOLEAN ← TRUE; -- TRUE means ignore leading spaces

RemoveTrailingSpace: PROCEDURE = INLINE
BEGIN
WHILE fieldBodyOut.length > 0 AND fieldBodyOut[fieldBodyOut.length - 1] = Ascii.SP DO
fieldBodyOut.length ← fieldBodyOut.length - 1;
ENDLOOP;
END; -- of RemoveTrailingSpace --

fieldBodyOut.length ← 0;
IF fieldBodyOut.maxlength # 0 THEN
BEGIN
DO
SELECT char ← Get[ph] FROM
Ascii.SP, Ascii.TAB =>
BEGIN
IF spaceSeen THEN LOOP;
IF suppressWhiteSpace THEN {char ← Ascii.SP; spaceSeen ← TRUE};
END;
endOfInput => GO TO Trouble;
endOfList, Ascii.CR => EXIT;
ENDCASE => spaceSeen ← FALSE;
IF fieldBodyOut.length = fieldBodyOut.maxlength THEN {truncated ← TRUE; EXIT};
String.AppendChar[fieldBodyOut, char];
ENDLOOP;
RemoveTrailingSpace[];
IF ~truncated THEN RETURN;
END;
DO -- faster loop for discarding
SELECT char ← Get[ph] FROM
Ascii.CR, endOfList => EXIT;
endOfInput => GO TO Trouble;
ENDCASE => truncated ← TRUE;
ENDLOOP;
IF truncated AND ph.signalTruncation THEN ERROR ParseError[truncated];
EXITS
Trouble => ERROR ParseError[badFieldBody];
END; -- of GetFieldBody --


ParseNameList: PUBLIC PROCEDURE
[ph: ParseHandle,
process: PROCEDURE [STRING, STRING, BOOLEAN, BOOLEAN] RETURNS [BOOLEAN],
-- process PROC [name, registry, isFile, isNested] RETURNS [write] --
write: PROCEDURE [CHARACTER] ← NIL ] =
-- ParseNameList expects to read characters using "next" (see InitializeParse) for a structured
-- field body consisting of a list of recipient names. For each such name encountered, it
-- will call "process", passing it two string arguments that designate the simple name and
-- registry. The simple name is always non-empty. If the registry is absent, a string of
-- length zero (not NIL) is passed. If the simple name contains an Arpanet host name,
-- the registry passed is "Arpa". The string parameters are free from leading, trailing
-- and excess internal white space and are guaranteed to be at least "maxRecipientLength"
-- characters in length. The "process" routine has a third parameter that indicates, if
-- TRUE, that the simple name is a file name, if FALSE, that the simple name and
-- registry combine to form a normal name. The fourth parameter supplied to "process"
-- indicates, if TRUE, that the name was "nested", i.e., it occurred within brackets or
-- within a group. This is useful to the Answer client who may wish to suppress
-- duplicate elimination in such cases.
-- If any syntax errors are detected during parsing, ParseError[badFieldBody] is raised. It is
-- legitimate for the "process" routine to raise a signal that causes ParseNameList to be
-- unwound.
BEGIN
error: ParseErrorCode ← none;
name: STRING ← [maxRecipientLength];
registry: STRING ← [maxRecipientLength];
token: STRING ← [maxRecipientLength];
outputString: STRING ← IF write = NIL THEN NIL ELSE Storage.String[maxRecipientLength];
dotIndex, lastAtomIndex: CARDINAL ← 0;
maxOutputStringLength: CARDINAL = 1000;

-- Local procedure ParseList does all the work. It is a local procedure so we can catch
-- its ERRORs easily.

ParseList: PROCEDURE =
BEGIN
lookingFor: {name, delim, registry, groupContents, routeAddress};
-- Semantics of states:
-- name: expect the first atom of a name or the first atom of a domain.
-- these can be distinguished by the seenAtSign Boolean.
-- delim: have just seen an atom, expect a delimiter: dot, atSign, closeRoute, semiColon,
-- endOfLine, or endOfList.
-- registry: have just seen a dot, now expect an atom that is a registry candidate.
-- groupContents: have just seen a group opening colon. This state is ephemeral-we are
-- looking for an immediate semiColon that will indicate that the name accumulated so far
-- is a filename. If the next token is not a semiColon, treat as lookingFor=name (but clear
-- the accumulated name first).
-- routeAddress: have just seen an openRoute. Handle the awful route syntax:
-- @domain,@domain, ... @domain:
-- If not immediately followed by an atSign, treat as lookingFor=name.
-- Typical sequence of states is
-- name, delim, (if see dot:)[ registry, delim, (if see atSign:)[name, delim,[registry, delim]*]]
inRoute, inGroup, needAtSign, seenAtSign: BOOLEAN;
oldRegistryLength: CARDINAL;
haveAlreadyWritten: BOOLEAN ← FALSE;

AppendNameAndRegistry: PROCEDURE =
BEGIN
IF registry.length > 0 THEN
{String.AppendChar[name, ’.]; String.AppendString[name, registry]; registry.length ← 0};
END; -- of AppendNameAndRegistry --

CheckForArpa: PROCEDURE =
BEGIN
numArpaAliases: CARDINAL = 3;
arpaAliases: ARRAY [0..numArpaAliases) OF STRING = [
-- The first one is the preferred registry for ARPA recipients, but any of
-- the others is acceptable and is left unchanged if present. Note that
-- the name "ARPA" is overloaded: it is used as both a Xerox registry name
-- and a top-level ARPA domain name.
"AG"L, "ArpaGateway"L, "ARPA"L];
IF seenAtSign THEN
FOR i: CARDINAL IN [0..numArpaAliases) DO
IF String.EquivalentString[registry, arpaAliases[i]] THEN EXIT;
REPEAT
FINISHED =>
BEGIN
AppendNameAndRegistry[ ! String.StringBoundsFault => GO TO TooLong];
String.AppendString[registry, arpaAliases[0]];
dotIndex ← 0;
END;
ENDLOOP
ELSE IF registry.length = 0 THEN dotIndex ← 0;
oldRegistryLength ← registry.length;
EXITS
TooLong => SyntaxError;
END; -- of CheckForArpa --

ProcessPhrase: PROCEDURE =
BEGIN
IF inRoute THEN SyntaxError;
name.length ← registry.length ← 0;
IF outputString # NIL THEN {AppendOutputChar[Ascii.SP]; AppendOutputString[token]};
DO -- Flush till colon or angle bracket.
SELECT GetToken[ ! AtomTooLong => LOOP] FROM
colon =>
BEGIN
inGroup ← TRUE;
lookingFor ← groupContents;
IF outputString # NIL THEN AppendOutputChar[’:];
EXIT;
END;
openRoute =>
BEGIN
lookingFor ← routeAddress;
inRoute ← TRUE;
IF outputString # NIL THEN {AppendOutputChar[Ascii.SP]; AppendOutputChar[’<]};
EXIT;
END;
atom => IF outputString # NIL THEN
{AppendOutputChar[Ascii.SP]; AppendOutputString[token]};
dot => IF outputString # NIL THEN AppendOutputChar[’.];
ENDCASE => SyntaxError;
ENDLOOP;
END; -- of ProcessPhrase --

ProcessRoute: PROCEDURE =
BEGIN
String.AppendChar[name, ’@];
needAtSign ← TRUE;
IF outputString # NIL THEN AppendOutputChar[’@];
DO
SELECT GetToken[] FROM
atom, domainLiteral =>
BEGIN
String.AppendString[name, token];
IF outputString # NIL THEN AppendOutputString[token];
END;
ENDCASE => SyntaxError;
SELECT GetToken[] FROM
dot =>
BEGIN
String.AppendChar[name, ’.];
IF outputString # NIL THEN AppendOutputChar[’.];
END;
comma =>
IF GetToken[] = atSign THEN
BEGIN
String.AppendString[name, ",@"L];
IF outputString # NIL THEN AppendOutputString[",@"L];
END
ELSE SyntaxError;
colon =>
BEGIN
String.AppendChar[name, ’:];
IF outputString # NIL THEN AppendOutputChar[’:];
lookingFor ← name;
EXIT;
END;
ENDCASE => SyntaxError;
ENDLOOP;
END; -- of ProcessRoute --

GetAtom: PROCEDURE =
BEGIN
tooLong: BOOLEAN ← FALSE;
DO
char: CHARACTER;
SELECT char ← Get[ph] FROM
Ascii.SP, Ascii.TAB => EXIT;
dot, atSign, comma, openRoute, closeRoute, endOfList, colon, semiColon,
endOfInput, openSquareBracket, openComment, quotes, closeSquareBracket,
closeComment
=> {ph.char ← char; EXIT};
Ascii.CR => {ph.giveACR ← TRUE; EXIT};
< 40C, quoteNext, Ascii.DEL => ERROR SyntaxError;
ENDCASE =>
IF ~tooLong THEN String.AppendChar
[token, char ! String.StringBoundsFault => {tooLong ← TRUE; LOOP}];
ENDLOOP;
IF tooLong THEN ERROR AtomTooLong;
END; -- of GetAtom --

GetQuotedString: PROCEDURE =
BEGIN
tooLong: BOOLEAN ← FALSE;
DO
char: CHARACTER;
IF ~tooLong THEN String.AppendChar[token, (char ← Get[ph])
! String.StringBoundsFault => {tooLong ← TRUE; CONTINUE}];
SELECT char FROM
quoteNext =>
SELECT char ← Get[ph] FROM
Ascii.CR, endOfList, endOfInput => ERROR SyntaxError;
ENDCASE =>
IF ~tooLong THEN String.AppendChar[token, char
! String.StringBoundsFault => {tooLong ← TRUE; CONTINUE}];
quotes => EXIT;
Ascii.CR, endOfList, endOfInput => ERROR SyntaxError;
ENDCASE;
ENDLOOP;
IF tooLong THEN ERROR AtomTooLong;
END; -- of GetQuotedString --

GetDomainLiteral: PROCEDURE =
BEGIN
DO
char: CHARACTER;
String.AppendChar
[token, (char ← Get[ph]) ! String.StringBoundsFault => GO TO TooLong];
SELECT char FROM
quoteNext =>
SELECT char ← Get[ph] FROM
Ascii.CR, endOfList, endOfInput => ERROR SyntaxError;
ENDCASE =>
String.AppendChar[token, char ! String.StringBoundsFault => GO TO TooLong];
closeSquareBracket => RETURN;
Ascii.CR, endOfList, endOfInput => ERROR SyntaxError;
ENDCASE;
ENDLOOP;
EXITS
TooLong => ERROR SyntaxError;
END; -- of GetDomainLiteral --

GetToken: PROCEDURE RETURNS [tokenType: TokenType] =
BEGIN
char: CHARACTER;
token.length ← 0;
DO
char ← Get[ph];
SELECT char FROM
Ascii.SP, Ascii.TAB => LOOP;
openComment => {FlushComment[]; LOOP};
ENDCASE => EXIT;
ENDLOOP;
SELECT char FROM
dot => RETURN[dot];
atSign => RETURN[atSign];
comma => RETURN[comma];
openRoute => RETURN[openRoute];
closeRoute => RETURN[closeRoute];
Ascii.CR => RETURN[endOfLine];
endOfList => RETURN[endOfList];
endOfInput => RETURN[endOfInput];
colon => RETURN[colon];
semiColon => RETURN[semiColon];
closeSquareBracket, closeComment => ERROR SyntaxError;
openSquareBracket =>
{String.AppendChar[token, char]; GetDomainLiteral[]; RETURN[domainLiteral]};
quotes => {String.AppendChar[token, char]; GetQuotedString[]; RETURN[atom]};
ENDCASE => {String.AppendChar[token, char]; GetAtom[]; RETURN[atom]};
END; -- of GetToken --

FlushComment: PROCEDURE =
BEGIN
char: CHARACTER;
IF outputString # NIL THEN
BEGIN
IF outputString.length > 0 AND outputString[outputString.length - 1] # Ascii.SP THEN
AppendOutputChar[Ascii.SP];
AppendOutputChar[’(];
END;
DO
SELECT (char ← Get[ph]) FROM
quoteNext =>
SELECT (char ← Get[ph]) FROM
Ascii.CR, endOfList, endOfInput => ERROR SyntaxError;
ENDCASE => {AppendOutputChar[’\]; AppendOutputChar[char]};
closeComment =>
{IF outputString # NIL THEN AppendOutputString[") "L]; RETURN};
openComment => FlushComment[];
Ascii.CR, endOfList, endOfInput => ERROR SyntaxError;
ENDCASE => IF outputString # NIL THEN AppendOutputChar[char];
ENDLOOP;
END; -- of FlushComment --

AppendOutputChar: PROCEDURE [char: CHARACTER] =
BEGIN
IF outputString.length >= outputString.maxlength THEN
BEGIN
temp: STRING;
IF outputString.length >= maxOutputStringLength THEN RETURN;
temp ← outputString;
outputString ← Storage.String[outputString.length + outputString.length / 2];
String.AppendString[outputString, temp];
Storage.FreeString[temp];
END;
outputString[outputString.length] ← char;
outputString.length ← outputString.length + 1;
END; -- of AppendOutputChar --

AppendOutputString: PROCEDURE [string: STRING] =
BEGIN
IF outputString.length + string.length > outputString.maxlength THEN
BEGIN
temp: STRING;
IF outputString.length + string.length >= maxOutputStringLength THEN RETURN;
temp ← outputString;
outputString
← Storage.String[outputString.length + outputString.length / 2 + string.length];
String.AppendString[outputString, temp];
Storage.FreeString[temp];
END;
String.AppendString[outputString, string];
END; -- of AppendOutputString --

WriteOutputString: PROCEDURE =
BEGIN
-- (dotIndex # 0) = registry exists in the output string.
-- locate the registry in the output string
registryIndex: CARDINAL
← IF dotIndex # 0 THEN lastAtomIndex - oldRegistryLength ELSE 0;
IF haveAlreadyWritten THEN {write[’,]; write[Ascii.SP]};
haveAlreadyWritten ← TRUE;
-- write up to the dot
FOR i: CARDINAL IN [0 .. IF dotIndex = 0 THEN lastAtomIndex ELSE dotIndex) DO
write[outputString[i]];
ENDLOOP;
-- write the dot
IF registry.length > 0 THEN write[’.];
-- write the registry
FOR i: CARDINAL IN [0 .. registry.length) DO
write[registry[i]];
ENDLOOP;
-- write the comments between the dot and the registry
IF dotIndex # 0 THEN
FOR i: CARDINAL IN (dotIndex .. registryIndex) DO
write[outputString[i]];
ENDLOOP;
-- write the rest
WHILE outputString.length > 0 AND outputString[outputString.length - 1] = Ascii.SP DO
outputString.length ← outputString.length - 1;
ENDLOOP;
FOR i: CARDINAL IN [lastAtomIndex .. outputString.length) DO
write[outputString[i]];
ENDLOOP;
END; -- of WriteOutputString --

inGroup ← FALSE;
DO -- for each list element.
name.length ← registry.length ← dotIndex ← lastAtomIndex ← 0;
lookingFor ← name;
inRoute ← needAtSign ← seenAtSign ← FALSE;
DO -- for tokens within a list element.
BEGIN -- for EXITS --
tokenType: TokenType;
SELECT (tokenType ← GetToken[ ! AtomTooLong => GO TO SecondChance]) FROM
atom =>
SELECT lookingFor FROM
name, registry =>
BEGIN
String.AppendString
[IF lookingFor = name THEN name ELSE registry, token
! String.StringBoundsFault => GO TO SecondChance];
lookingFor ← delim;
IF outputString # NIL THEN
{AppendOutputString[token]; lastAtomIndex ← outputString.length};
END;
groupContents, routeAddress =>
BEGIN
name.length ← registry.length ← 0;
needAtSign ← seenAtSign ← FALSE;
String.AppendString
[name, token ! String.StringBoundsFault => GO TO SecondChance];
lookingFor ← delim;
IF outputString # NIL THEN
BEGIN
IF lookingFor = groupContents THEN AppendOutputChar[Ascii.SP];
AppendOutputString[token];
lastAtomIndex ← outputString.length;
END;
END;
-- abnormal cases follow.
delim => GO TO SecondChance;
ENDCASE;
dot =>
IF lookingFor = delim THEN
BEGIN
AppendNameAndRegistry[ ! String.StringBoundsFault => GO TO SecondChance];
lookingFor ← registry;
IF outputString # NIL THEN
{dotIndex ← outputString.length; AppendOutputChar[’.]};
END
ELSE SyntaxError;
atSign =>
SELECT lookingFor FROM
delim =>
BEGIN
IF seenAtSign THEN SyntaxError;
seenAtSign ← TRUE;
AppendNameAndRegistry[ ! String.StringBoundsFault => GO TO SecondChance];
String.AppendChar[name, ’@ ! String.StringBoundsFault => GO TO SecondChance];
lookingFor ← name;
dotIndex ← lastAtomIndex ← 0;
IF outputString # NIL THEN AppendOutputChar[’@];
END;
routeAddress =>
ProcessRoute[ ! String.StringBoundsFault, AtomTooLong => GO TO NoMoreChances];
name, registry, groupContents => SyntaxError;
ENDCASE;
comma, endOfLine, endOfList, endOfInput =>
BEGIN
IF inRoute OR (tokenType # comma AND inGroup) THEN SyntaxError;
SELECT lookingFor FROM
delim =>
BEGIN
CheckForArpa[];
IF process[name, registry, FALSE, inGroup] AND outputString # NIL THEN
WriteOutputString[];
IF outputString # NIL THEN outputString.length ← 0;
IF tokenType = comma THEN EXIT ELSE RETURN;
END;
name, groupContents =>
BEGIN
IF inRoute OR seenAtSign THEN SyntaxError;
IF registry.length > 0 THEN ERROR;
IF tokenType = comma THEN {lookingFor ← name; EXIT}
ELSE IF inGroup THEN SyntaxError ELSE RETURN;
END;
registry, routeAddress => SyntaxError;
ENDCASE;
END;
colon =>
SELECT lookingFor FROM
delim, registry =>
BEGIN
IF inRoute OR inGroup OR seenAtSign THEN SyntaxError;
AppendNameAndRegistry[ ! String.StringBoundsFault =>
{name.length ← registry.length ← 0; CONTINUE}];
inGroup ← TRUE;
lookingFor ← groupContents;
IF outputString # NIL THEN AppendOutputChar[’:];
dotIndex ← lastAtomIndex ← 0;
END;
name, groupContents, routeAddress => SyntaxError;
ENDCASE;
semiColon =>
BEGIN
emptyGroup: BOOLEAN ← FALSE;
IF ~inGroup OR inRoute THEN SyntaxError;
inGroup ← FALSE;
SELECT lookingFor FROM
groupContents => {IF name.length = 0 THEN SyntaxError; emptyGroup ← TRUE};
delim => {CheckForArpa[]; emptyGroup ← FALSE};
name => IF name.length > 0 THEN SyntaxError;
registry, routeAddress => SyntaxError;
ENDCASE;
IF outputString # NIL THEN AppendOutputChar[’;];
SELECT (tokenType ← GetToken[ ! AtomTooLong => GOTO NoMoreChances]) FROM
comma, endOfLine, endOfList, endOfInput =>
BEGIN
IF name.length > 0 THEN
BEGIN
-- be careful, might have no name if extra trailing comma preceded the semi.
-- ASSERT: CheckForArpa was called if emptyGroup is FALSE.
IF process[name, registry, emptyGroup, TRUE] AND outputString # NIL THEN
WriteOutputString[];
END
ELSE IF outputString # NIL THEN
BEGIN
registry.length ← lastAtomIndex ← dotIndex ← 0;
WriteOutputString[];
END;
IF outputString # NIL THEN outputString.length ← 0;
IF tokenType = comma THEN EXIT ELSE RETURN;
END;
ENDCASE => SyntaxError;
END;
openRoute =>
BEGIN
IF inRoute THEN SyntaxError;
inRoute ← TRUE;
name.length ← registry.length ← dotIndex ← lastAtomIndex ← 0;
lookingFor ← routeAddress;
IF outputString # NIL THEN
BEGIN
IF outputString.length > 0 AND outputString[outputString.length - 1] # Ascii.SP
THEN AppendOutputChar[Ascii.SP];
AppendOutputChar[’<];
END;
END;
closeRoute =>
BEGIN
IF ~inRoute OR lookingFor # delim THEN SyntaxError;
inRoute ← FALSE;
IF needAtSign AND ~seenAtSign THEN SyntaxError;
CheckForArpa[];
IF outputString # NIL THEN AppendOutputChar[’>];
SELECT (tokenType ← GetToken[ ! AtomTooLong => GOTO NoMoreChances]) FROM
comma, endOfLine, endOfList, endOfInput, semiColon =>
BEGIN
IF inGroup AND tokenType # comma AND tokenType # semiColon THEN SyntaxError;
IF tokenType=semiColon AND outputString#NIL THEN AppendOutputChar[’;];
IF process[name, registry, FALSE, TRUE] AND outputString # NIL THEN
WriteOutputString[];
IF outputString # NIL THEN outputString.length ← 0;
IF tokenType = semiColon THEN {inGroup← FALSE; EXIT};
IF tokenType = comma THEN EXIT ELSE RETURN;
END;
ENDCASE => SyntaxError;
END;
domainLiteral =>
SELECT lookingFor FROM
name, registry =>
BEGIN
IF ~seenAtSign THEN SyntaxError;
String.AppendString
[IF lookingFor = name THEN name ELSE registry, token
! String.StringBoundsFault => GO TO NoMoreChances];
lookingFor ← delim;
IF outputString # NIL THEN
{AppendOutputString[token]; dotIndex ← 0; lastAtomIndex ← outputString.length};
END;
delim, groupContents, routeAddress => SyntaxError;
ENDCASE;
ENDCASE => ERROR;
EXITS
SecondChance => ProcessPhrase[];
NoMoreChances => SyntaxError;
END; -- of EXITS block --
ENDLOOP;
ENDLOOP; -- for each list element.
END; -- of ParseList --

-- Body of ParseNameList --

ParseList[ !
SyntaxError => {error ← badFieldBody; CONTINUE};
String.StringBoundsFault => {error ← truncated; CONTINUE}];
IF outputString # NIL THEN Storage.FreeString[outputString];
IF error # none THEN ERROR ParseError[error];
END; -- of ParseNameList --



AtomTooLong: ERROR = CODE;


Get: PROCEDURE [ph: ParseHandle] RETURNS [char: CHARACTER] =
-- Obtains next input character and smoothes over a few lexical quirks. This procedure
-- deals with Arpa-standard line-folding.
BEGIN
IF ph.giveACR THEN {ph.giveACR ← FALSE; RETURN[Ascii.CR]};
IF ph.char = Ascii.NUL THEN
BEGIN
IF (char ← ph.next[]) = Ascii.CR THEN
BEGIN
ph.char ← ph.next[];
SELECT ph.char FROM
Ascii.SP, Ascii.TAB => {ph.char ← Ascii.NUL; RETURN[Ascii.SP]};
ENDCASE;
END;
END
ELSE {char ← ph.char; ph.char ← Ascii.NUL};
END; -- of Get --


END. -- of ArpaMailParser --