-- SendParser.mesa
-- Edited by Levin, February 17, 1981  10:49 AM
-- Edited by Schroeder, March 5, 1981  2:07 PM
-- Edited by Brotz, April 8, 1981  4:09 PM

DIRECTORY
  Ascii,
  crD: FROM "CoreDefs",
  csD: FROM "CoreStreamDefs",
  dsD: FROM "DisplayDefs",
  exD: FROM "ExceptionDefs",
  intCommon: FROM "intCommon",
  LaurelSendDefs,
  MailParse,
  opD: FROM "OperationsDefs",
  ovD: FROM "OverviewDefs",
  Storage,
  String;

SendParser: PROGRAM
  IMPORTS csD, exD, intC: intCommon, dsD, LaurelSendDefs, MailParse, opD,
    Storage, String
  EXPORTS LaurelSendDefs =

BEGIN OPEN LaurelSendDefs;

ParseForSend: PUBLIC PROCEDURE [expandPublicDLs: BOOLEAN,
  sendMode: SendMode] RETURNS [unexpandedPublicDLs: CARDINAL,
  netMail: BOOLEAN, fromField: BOOLEAN, replyTo: BOOLEAN] =
BEGIN
pH: MailParse.ParseHandle;

-- DL Expander

DLEntry: TYPE = RECORD
  [next: DLHandle,
  start, end: ovD.CharIndex,
  name: StringBody];
DLHandle: TYPE = POINTER TO DLEntry;

dlHead, currentDL: DLHandle _ NIL;
dlBuffer: csD.StreamHandle;

AcceptDL: PROCEDURE [name: STRING] =
  BEGIN
  dl: DLHandle;
  lastDL: DLHandle _ NIL;
  FOR dl _ dlHead, dl.next UNTIL dl = NIL DO
    IF String.EquivalentString[name, @dl.name] THEN RETURN;
    lastDL _ dl;
    ENDLOOP;
  dl _ Storage.Node[SIZE[DLEntry]+(name.length+1)/2];
  dl^ _ [next: NIL, start: errorStart, end: errorEnd-1,
        name: [length: 0, maxlength: name.length, text: ]];
  IF currentDL # NIL THEN BEGIN
    dl.start _ currentDL.start;
    dl.end _ currentDL.end;
    END;
  String.AppendString[@dl.name, name];
  IF lastDL = NIL
    THEN dlHead _ dl
    ELSE lastDL.next _ dl;
  END; -- of AcceptDL --

FlushDLList: PROCEDURE =
  BEGIN
  dl: DLHandle;
  UNTIL dlHead = NIL DO
    dl _ dlHead.next;
    Storage.Free[dlHead];
    dlHead _ dl;
    ENDLOOP;
  csD.Destroy[dlBuffer];
  END; -- of FlushDLList --

ProcessDLList: PROCEDURE =
  BEGIN
  msg: STRING;
  char: CHARACTER;
  havePH: BOOLEAN _ FALSE;
 
  GetDLChar: PROCEDURE RETURNS [CHARACTER] =
    BEGIN
    char _ csD.Read[dlBuffer
      ! csD.Error => IF reason = ovD.endOfStream THEN
          {char _ MailParse.endOfList; CONTINUE}];
    IF char = Ascii.CR THEN char _ Ascii.SP;
    RETURN[char];
    END; -- of GetDLChar --

  BackupDLChar: PROCEDURE =
    BEGIN
    IF char # MailParse.endOfList
      THEN csD.SetPosition[dlBuffer, csD.GetPosition[dlBuffer] - 1];
    END; -- of BackupDLChar --

  ReportProgress[exD.expandingMsg, NIL, TRUE];
  dlBuffer _ csD.Open[NIL, byte, write, 2];
  BEGIN ENABLE UNWIND =>
    {IF havePH THEN MailParse.FinalizeParse[pH]; FlushDLList[]};
    FOR currentDL _ dlHead, currentDL.next UNTIL currentDL = NIL DO
      MoveUnderline[currentDL.start, currentDL.end];
      publicDLExpansion _ currentDL.name.text[0] # '@;
      DO
        error: ovD.ErrorCode;
        [error, msg] _ CopyFileToCoreStream
          [dlBuffer, @currentDL.name, intC.user];
        IF error # ovD.ok THEN BEGIN
          ENABLE UNWIND => IF msg # NIL THEN Storage.FreeString[msg];
          AbortPoint[];
          IF error = ovD.cantConnect AND RetryThis[NIL, exD.cantExpand]
              THEN BEGIN
              ReportProgress[exD.expandingMsg, NIL, TRUE];
              IF msg # NIL THEN Storage.FreeString[msg];
              LOOP
              END; 
          ReportError[dlExpandError, msg, currentDL.start, currentDL.end];
          END;
      EXIT;
      ENDLOOP;
    AbortPoint[];
    pH _ MailParse.InitializeParse[GetDLChar, BackupDLChar]; havePH _ TRUE;
    MailParse.ParseNameList[pH, ProcessName
      ! MailParse.ParseError, String.StringBoundsFault =>
        ReportError[dlSyntaxError, NIL, currentDL.start, currentDL.end]];
    MailParse.FinalizeParse[pH]; havePH _ FALSE;
    csD.Reset[dlBuffer];
    ENDLOOP;
  END; -- ENABLE UNWIND
  FlushDLList[];
  END;  -- of ProcessDLList --


ProcessName: PROCEDURE[simpleName, registry, arpaHost: STRING,
      ignored: MailParse.NameInfo] RETURNS [accept: BOOLEAN] =
  BEGIN
  quotes, publicDL, noRegistry: BOOLEAN;
  recipient: STRING _ [MailParse.maxRecipientLength];
  errorEnd _ GetCharPosition[];
  IF (quotes _ simpleName[0]='")
    THEN BEGIN
      snDesc: String.SubStringDescriptor _ [simpleName, 1, simpleName.length-2];
      String.AppendSubString[recipient, @snDesc];
      END
    ELSE String.AppendString[recipient, simpleName];
  SELECT TRUE FROM
    (noRegistry _ registry.length=0) AND publicDLExpansion  =>
      -- catches @ or no registry in remote DL
      ReportError[illegalRecipient, NIL, currentDL.start, currentDL.end];
    recipient[0]='@ AND NOT NeedsArpaHost[arpaHost] =>
      BEGIN --file expansion
        IF netMail AND NOT quotes
          THEN ReportError[illegalFileExpansion, NIL, errorStart, errorEnd];
        AcceptDL[recipient];
        IF NOT quotes THEN unquotedFileExpansion _ TRUE;
        END;
    (publicDL _ recipient[recipient.length-1]='^) AND expandPublicDLs =>
      BEGIN
        IF noRegistry THEN unqualifiedNames _ TRUE;
        String.AppendChar[recipient, '.];
        String.AppendString[recipient, IF noRegistry THEN intC.user.registry ELSE registry];
        AcceptDL[recipient];
        END;
    ENDCASE =>
      BEGIN
        IF NeedsArpaHost[arpaHost]
          THEN BEGIN
            -- Arpanet host specified and not PARC-MAXC
            IF unquotedFileExpansion THEN ReportError[illegalFileExpansion, NIL, 0, 0];
            IF NOT noRegistry THEN BEGIN
              String.AppendChar[recipient, '.];
              String.AppendString[recipient, registry];
              END;
            String.AppendChar[recipient, '@];
            String.AppendString[recipient, arpaHost];
            String.AppendString[recipient, ".ArpaGateway"L];
            netMail _ TRUE;
            END
          ELSE BEGIN
            -- Arpanet host not specified or is PARC-MAXC
            IF noRegistry THEN
              IF arpaHost.length ~= 0 THEN registry _ "PA"L
              ELSE {unqualifiedNames _ TRUE; GOTO DontQualify};
            IF String.EquivalentString[registry, intC.user.registry] THEN GO TO DontQualify;
            String.AppendChar[recipient, '.];
            String.AppendString[recipient, registry];
            EXITS DontQualify => NULL;
            END;
        InsertRecipientInList[recipient];
        haveRecipient _ TRUE;
        IF publicDL THEN unexpandedPublicDLs _ unexpandedPublicDLs + 1;
        END;
  AbortPoint[];
  errorStart _ errorEnd;
  RETURN[FALSE]
  END;  -- of ProcessName --

-- beginning of code of ParseForSend

fieldName: STRING _ [MailParse.maxFieldNameSize];
unquotedFileExpansion, unqualifiedNames, publicDLExpansion,
  haveRecipient: BOOLEAN _ FALSE;
errorStart, errorEnd: ovD.CharIndex;

unexpandedPublicDLs _ 0;
netMail _ FALSE;
fromField _ FALSE;
replyTo _ FALSE;

InitReadChar[];
pH _ MailParse.InitializeParse[ReadChar, BackupChar];

DO    -- Until message processed or error detected
  errorStart _ GetCharPosition[];
  IF ~MailParse.GetFieldName[pH, fieldName ! MailParse.ParseError => GO TO syntaxError]
    THEN EXIT;
  IF String.EquivalentString[fieldName,"Date"L]
    OR String.EquivalentString[fieldName,"Sender"L] THEN GOTO syntaxError;
  errorStart _ GetCharPosition[];
  SELECT TRUE FROM
    String.EquivalentString[fieldName,"To"L],
    String.EquivalentString[fieldName,"cc"L],
    String.EquivalentString[fieldName,"c"L],
    String.EquivalentString[fieldName,"bcc"L] =>
      MailParse.ParseNameList[pH, ProcessName
        ! MailParse.ParseError, String.StringBoundsFault => GO TO syntaxError];
    ENDCASE =>
      BEGIN
      SELECT TRUE FROM
        String.EquivalentString[fieldName,"From"L] => fromField _ TRUE;
        String.EquivalentString[fieldName,"Reply-To"L] => replyTo _ TRUE;
        ENDCASE;
      MailParse.GetFieldBody[pH, fieldName ! MailParse.ParseError => GO TO syntaxError];
      END;
  REPEAT syntaxError =>
    BEGIN
    MailParse.FinalizeParse[pH];
    errorEnd _ GetCharPosition[];
    ReportError[messageSyntaxError, NIL, MIN[errorStart, errorEnd-1], errorEnd];
    END;
  ENDLOOP; -- Main message parsing loop
MailParse.FinalizeParse[pH];
IF sendMode = blue AND (dlHead # NIL OR unexpandedPublicDLs # 0) AND ~replyTo
  THEN {exD.DisplayException[exD.deliveryToDL]; InsertReplyToField[]};
IF dlHead # NIL THEN ProcessDLList[];
SELECT TRUE FROM
  NOT haveRecipient =>
      ReportError[noRecipientsSpecified, NIL, 0, 0];
  netMail AND unqualifiedNames
    AND ~String.EquivalentString[intC.user.registry, "PA"L] =>
      ReportError[missingQualification, NIL, 0, 0];
  ENDCASE;
END;  -- of ParseForSend --

NeedsArpaHost: PROCEDURE [host: STRING] RETURNS [BOOLEAN] =
  BEGIN
  i: CARDINAL;
  IF host.length = 0 THEN RETURN[FALSE];
  FOR i IN [0..LENGTH[intC.arpaGatewayHostNames]) DO
    IF String.EquivalentString[host, intC.arpaGatewayHostNames[i]]
      THEN RETURN[FALSE]
    ENDLOOP;
  RETURN[TRUE];
  END;  -- NeedsArpaHost --


CopyFileToCoreStream: PROCEDURE
    [stream: csD.StreamHandle, file: crD.UFilename, user: crD.DMSUser]
  RETURNS [error: ovD.ErrorCode, errorString: STRING] =
-- Assumes that stream is write, byte, positioned at 0.  Will copy contents of file
--   into stream, using a backing temp file if the file is longer than one page.
BEGIN

AcceptBlock: PROCEDURE [p: POINTER, bytes: CARDINAL]
  RETURNS [erc: ovD.ErrorCode] =
  BEGIN
  erc _ ovD.ok;
  IF bytes > 0 THEN csD.WriteBlock[stream, p, 0, bytes];
  END; -- of AcceptBlock --

[error, errorString] _ opD.Expand[file, AcceptBlock];
dsD.SetCursor[hourGlass];
csD.SetPosition[stream, 0];
END;  -- of CopyFileToCoreStream --



END.  -- of SendParser --
(635)\f1