-- Copyright (C) 1982, 1984  by Xerox Corporation. All rights reserved. 
-- Readmail.mesa, Transport Mechanism Mail Server - client reading mail --

-- HGM, 18-Nov-84  0:35:59
-- Andrew Birrell  25-Oct-82 10:53:32 --

DIRECTORY
  BodyDefs USING [maxRNameLength, Password, RName],
  LogDefs USING [ShowLine],
  MailboxDefs USING [
    Close, DeleteMessage, FlushAndClose, InaccessibleArchive, MBXHandle,
    NextMessage, Open, ReadTOC, SendBody, WriteTOC],
  NameInfoDefs USING [AuthenticateInfo, AuthenticateKey],
  PolicyDefs USING [CheckOperation, EndOperation],
  ProtocolDefs USING [
    Failed, Handle, mailServerOutputSocket, maxRemarkLength, MSOperation,
    ReceiveMSOperation, ReceivePassword, ReceiveRemark, ReceiveRName, Remark,
    SendAck, SendBoolean, SendByte, SendCount, SendNow, SendRemark],
  PupStream USING [
    CreatePupByteStreamListener, PupAddress, RejectThisRequest, SecondsToTocks],
  RestartDefs USING [] --EXPORT only-- ,
  String USING [AppendNumber, AppendString, EquivalentSubStrings, SubStringDescriptor];

ReadMail: PROGRAM
  IMPORTS
    LogDefs, MailboxDefs, NameInfoDefs, PolicyDefs, ProtocolDefs, PupStream,
    String
  EXPORTS RestartDefs --PROGRAM-- =

  BEGIN


  EndsWith: PROC [s: STRING, b: STRING] RETURNS [BOOLEAN] =
    BEGIN
    pattern: String.SubStringDescriptor ¬ [b, 0, b.length];
    target: String.SubStringDescriptor ¬ [s, s.length - b.length, b.length];
    RETURN[
      s.length >= b.length AND String.EquivalentSubStrings[@pattern, @target]]
    END;

  Receive: PROCEDURE [str: ProtocolDefs.Handle, where: PupStream.PupAddress] =
    BEGIN OPEN ProtocolDefs;

    client: BodyDefs.RName = [BodyDefs.maxRNameLength];
    state: {closed, open, inMessage} ¬ closed;
    mbx: MailboxDefs.MBXHandle;
    found: BOOLEAN ¬ FALSE;
    Open: PROC =
      BEGIN
      count: CARDINAL;
      [found, count, mbx] ¬ MailboxDefs.Open[client];
      IF found THEN state ¬ open;
      ProtocolDefs.SendCount[str, IF found THEN count ELSE 0];
      END;


    DO
      ENABLE ProtocolDefs.Failed, MailboxDefs.InaccessibleArchive => EXIT;
      op: ProtocolDefs.MSOperation;
      op ¬ ProtocolDefs.ReceiveMSOperation[
        str !
        ProtocolDefs.Failed =>
          IF why = noData AND EndsWith[client, ".gv"] THEN RETRY
        -- i.e. if caller is an R-Server -- ];
      SELECT op FROM
        openMBX =>
          BEGIN
          key: BodyDefs.Password;
          info: NameInfoDefs.AuthenticateInfo;
          ProtocolDefs.ReceiveRName[str, client];
          key ¬ ProtocolDefs.ReceivePassword[str, [0, 0, 0, 0]];
          IF state # closed THEN EXIT;
          info ¬ NameInfoDefs.AuthenticateKey[client, key];
          ProtocolDefs.SendByte[str, LOOPHOLE[info]];
          IF info = individual THEN Open[];
          END;
        nextMessage =>
          BEGIN
          msgExists, archived, deleted: BOOLEAN;
          IF state = inMessage THEN state ¬ open;
          -- pretend that not found means empty mailbox --
          IF found THEN
            IF state # open THEN EXIT
            ELSE
              BEGIN
              [msgExists, archived, deleted] ¬ MailboxDefs.NextMessage[mbx];
              state ¬ IF deleted THEN open ELSE inMessage;
              END
          ELSE msgExists ¬ archived ¬ deleted ¬ FALSE;
          ProtocolDefs.SendBoolean[str, msgExists];
          ProtocolDefs.SendBoolean[str, archived];
          ProtocolDefs.SendBoolean[str, deleted];
          END;
        readTOC =>
          BEGIN
          remark: ProtocolDefs.Remark = [ProtocolDefs.maxRemarkLength];
          IF state # inMessage THEN EXIT;
          MailboxDefs.ReadTOC[mbx, remark];
          ProtocolDefs.SendRemark[str, remark];
          END;
        readMessage =>
          BEGIN
          IF state # inMessage THEN EXIT;
          MailboxDefs.SendBody[mbx, str];
          END;
        writeTOC =>
          BEGIN
          remark: ProtocolDefs.Remark = [ProtocolDefs.maxRemarkLength];
          ProtocolDefs.ReceiveRemark[str, remark];
          IF state # inMessage THEN EXIT;
          MailboxDefs.WriteTOC[mbx, remark];
          ProtocolDefs.SendAck[str];
          END;
        deleteMessage =>
          BEGIN
          IF state # inMessage THEN EXIT;
          MailboxDefs.DeleteMessage[mbx];
          ProtocolDefs.SendAck[str];
          END;
        flushMBX =>
          BEGIN
          IF found THEN
            BEGIN
            IF state = closed THEN EXIT;
            MailboxDefs.FlushAndClose[mbx];
            state ¬ closed;
            END
          ELSE NULL;
          ProtocolDefs.SendAck[str];
          END;
        ENDCASE => EXIT;
      ProtocolDefs.SendNow[str];
      ENDLOOP;

    IF state # closed THEN MailboxDefs.Close[mbx];

    str.delete[str];

    PolicyDefs.EndOperation[readMail];

    END;


  ReadMailFilter: PROCEDURE [from: PupStream.PupAddress] =
    BEGIN
    IF NOT PolicyDefs.CheckOperation[readMail] THEN
      BEGIN
      s: STRING = [100];
      String.AppendString[s, "Rejected ReadMail connection from "L];
      String.AppendNumber[s, from.net, 8];
      String.AppendString[s, "#"L];
      String.AppendNumber[s, from.host, 8];
      String.AppendString[s, "#"L];
      LogDefs.ShowLine[s];
      ERROR PupStream.RejectThisRequest["Server full"L];
      END
    END;


  [] ¬ PupStream.CreatePupByteStreamListener[
    ProtocolDefs.mailServerOutputSocket, Receive, PupStream.SecondsToTocks[120],
    ReadMailFilter];


  END.