-- File: ArpaMailParser.mesa
-- Last edited by Brotz, March 6, 1983  3:29 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
  IF seenAtSign AND ~String.EquivalentString[registry, "Arpa"L] THEN
    BEGIN
    AppendNameAndRegistry[ ! String.StringBoundsFault => GO TO TooLong];
    String.AppendString[registry, "Arpa"L];
    dotIndex _ 0;
    END
  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 =>
            BEGIN
            IF inGroup AND tokenType # comma THEN SyntaxError;
            IF process[name, registry, FALSE, TRUE] AND outputString # NIL THEN
              WriteOutputString[];
            IF outputString # NIL THEN outputString.length _ 0;
            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 --(635)\f1