-- Copyright (C) 1981, 1984  by Xerox Corporation. All rights reserved. 
-- RetrievePoll.mesa, Transport Mechanism: User: "hot" module for mail polling --

-- HGM: 10-Dec-84 23:38:27
-- Andrew Birrell  26-Feb-81 11:55:54 --
-- Hankins	26-Jul-84 14:25:39	Klamath update (pup rework)

DIRECTORY
  BodyDefs USING [RName],
  Buffer USING [AccessHandle, GetBuffer, MakePool, ReturnBuffer],
  Inline USING [LongCOPY, LowHalf],
  NameInfoDefs USING [AuthenticateInfo, AuthenticateKey],
  NameInfoSpecialDefs USING [CleanUp],
  Process USING [SecondsToTicks, SetTimeout],
  ProtocolDefs USING [mailServerPollingSocket],
  PupDefs USING [
    PupAddress, PupBuffer, PupRouterSendThis, PupSocket, PupSocketDestroy,
    PupSocketKick, PupSocketMake, SetPupContentsBytes,
    veryLongWait],
  PupTypes USING [fillInSocketID],
  RetrieveDefs USING [MBXState, ServerState],
  RetrieveXDefs USING [
    FindAddress, FindRegistryAndMailboxes, Handle, MBXPtr, noMBX],
  System USING [GreenwichMeanTime],
  Time USING [Current];

RetrievePoll: MONITOR LOCKS handle USING handle: RetrieveXDefs.Handle
  IMPORTS
    Buffer, Inline, NameInfoDefs, NameInfoSpecialDefs, Process, ProtocolDefs,
    PupDefs, RetrieveXDefs, Time
  EXPORTS RetrieveXDefs =

  BEGIN

  bufferPool: Buffer.AccessHandle ← Buffer.MakePool[send: 4, receive: 0];

  transmitLimit: CARDINAL = 5 -- max number of transmissions of poll -- ;
  retransmitDelay: CARDINAL = 2 -- seconds bfore re-transmittting -- ;


  SendPollProcess: PUBLIC ENTRY PROCEDURE [handle: RetrieveXDefs.Handle] =
    BEGIN  -- main program for sending polls --
    socket: PupDefs.PupSocket = PupDefs.PupSocketMake[
      PupTypes.fillInSocketID, , PupDefs.veryLongWait];
    socketAddr: PupDefs.PupAddress = socket.getLocalAddress[];
    replyPoll: PROCESS = FORK PollReplyProcess[handle, socket];
    transmissions: CARDINAL ← 0;  -- number of retransmissions so far --
    handle.pollReplying ← TRUE;
    Process.SetTimeout[@handle.pollCond, Process.SecondsToTicks[retransmitDelay]];
    WHILE handle.pollWanted DO
      now: System.GreenwichMeanTime = Time.Current[];
      IF handle.newPollWanted OR now >= handle.pollStarted + handle.interval THEN
        BEGIN
        handle.pollStarted ← now;
        transmissions ← 0;
        IF handle.mbxState NOT IN [userOK..notEmpty] THEN
          handle.mbxState ← unknown  --retry authentication--
        ELSE
          BEGIN
          IF handle.notEmptyMBXCount = 0 AND handle.unknownMBXCount # 0 THEN
            handle.mbxState ← userOK --was someEmpty or allDown-- ;
          FOR this: RetrieveXDefs.MBXPtr ← handle.MBXChain, this.next WHILE this #
            RetrieveXDefs.noMBX DO
            IF this.addrState = unknown THEN
              RetrieveXDefs.FindAddress[handle, this];
            IF this.addrState = known
              AND (handle.newPollWanted OR this.state # notEmpty) THEN
              this.replyWanted ← TRUE;
            ENDLOOP;
          END;
        handle.newPollWanted ← FALSE;
        BROADCAST handle.mbxStateChange;
        END;
      IF transmissions >= transmitLimit THEN
        BEGIN
        Process.SetTimeout[
          @handle.pollCond, Process.SecondsToTicks[
          Inline.LowHalf[(handle.pollStarted + handle.interval) - now]]];
        WAIT handle.pollCond;
        Process.SetTimeout[
          @handle.pollCond, Process.SecondsToTicks[retransmitDelay]];
        END
      ELSE
        SELECT handle.mbxState FROM
          unknown =>
            BEGIN -- authenticate --
            IF NOT handle.mbxKnown THEN
              RetrieveXDefs.FindRegistryAndMailboxes[handle];
            IF handle.mbxState = unknown THEN
              BEGIN
              info: NameInfoDefs.AuthenticateInfo =
                NameInfoDefs.AuthenticateKey[handle.userName, handle.userKey];
              SetMBXState[
                handle,
                SELECT info FROM
                  individual => userOK,
                  badPwd => badPwd,
                  group, notFound => badName,
                  allDown => cantAuth,
                  ENDCASE => ERROR];
              END
            --ELSE "FindRegistryAndMailboxes" failed-- ;
            END;
          IN [userOK..notEmpty] =>  --authenticated--
            BEGIN  -- poll the mailboxes --
            finished: BOOLEAN ← TRUE;  --whether all have replied--
            transmissions ← transmissions + 1;
            FOR this: RetrieveXDefs.MBXPtr ← handle.MBXChain, this.next WHILE this
              # RetrieveXDefs.noMBX DO
              IF this.replyWanted THEN
                BEGIN
                b: PupDefs.PupBuffer = Buffer.GetBuffer[
                  type: pup, aH: bufferPool, function: send];
                Inline.LongCOPY[
                  from: @(handle.userName.text), to: @(b.pup.pupString),
                  nwords: (1 + handle.userName.length) / 2];
                PupDefs.SetPupContentsBytes[b, handle.userName.length];
                b.pup.pupType ← mailCheckLaurel;
                b.pup.pupID ← handle.pollID;
                b.pup.dest ← [
                  this.addr.net, this.addr.host, ProtocolDefs.mailServerPollingSocket];
                b.pup.source ← socketAddr;
                PupDefs.PupRouterSendThis[b];
                finished ← FALSE;
                END;
              ENDLOOP;
            IF finished THEN transmissions ← transmitLimit  -- all have replied --
            ELSE WAIT handle.pollCond;
            IF transmissions >= transmitLimit THEN
              BEGIN
              FOR this: RetrieveXDefs.MBXPtr ← handle.MBXChain, this.next WHILE
                this # RetrieveXDefs.noMBX DO
                IF this.addrState = unknown OR this.replyWanted THEN
                  NoteChangedMBX[handle, this, unknown];
                ENDLOOP;
              -- special case for user with no mailboxes --
              IF handle.MBXChain = RetrieveXDefs.noMBX THEN
                SetMBXState[handle, allEmpty];
              NameInfoSpecialDefs.CleanUp[];
              END;
            END;
          ENDCASE =>  -- couldn't authenticate --
            transmissions ← transmitLimit;
      ENDLOOP;
    PupDefs.PupSocketKick[socket];
    WHILE handle.pollReplying DO WAIT handle.pollCond ENDLOOP;
    JOIN replyPoll;
    PupDefs.PupSocketDestroy[socket];
    handle.polling ← FALSE;
    NOTIFY handle.pollCond;
    END;


  PollReplyProcess: PROCEDURE [
    handle: RetrieveXDefs.Handle, socket: PupDefs.PupSocket] =
    BEGIN  -- main program for replies to the polls --
    DO
      BEGIN
      b: PupDefs.PupBuffer = socket.get[];
      IF NOT ConsiderPollReply[handle, b] THEN EXIT;
      IF b # NIL THEN Buffer.ReturnBuffer[b];
      END;
      ENDLOOP;
    END;

  ConsiderPollReply: ENTRY PROCEDURE [
    handle: RetrieveXDefs.Handle, b: PupDefs.PupBuffer] RETURNS [BOOLEAN] =
    BEGIN
    IF NOT handle.pollWanted THEN
      BEGIN
      handle.pollReplying ← FALSE;
      BROADCAST handle.pollCond;
      RETURN[FALSE]
      END;
    IF b # NIL AND b.pup.pupID = handle.pollID THEN
      BEGIN
      mbx: RetrieveXDefs.MBXPtr;
      FOR mbx ← handle.MBXChain, mbx.next UNTIL mbx = RetrieveXDefs.noMBX DO
        IF mbx.addrState = known AND mbx.addr.net = b.pup.source.net
          AND mbx.addr.host = b.pup.source.host THEN
          BEGIN
          SELECT b.pup.pupType FROM
            mailIsNew => NoteChangedMBX[handle, mbx, notEmpty];
            mailNotNew => NoteChangedMBX[handle, mbx, empty];
            mailError => NoteChangedMBX[handle, mbx, empty];
            error =>
              SELECT b.pup.errorCode FROM
                noProcessPupErrorCode, cantGetTherePupErrorCode,
                  eightHopsPupErrorCode => NoteChangedMBX[handle, mbx, unknown];
                ENDCASE => NULL;
            ENDCASE => NULL;
          END;
        ENDLOOP;
      END;
    RETURN[TRUE]
    END;


  NoteChangedMBX: PUBLIC INTERNAL PROCEDURE [
    handle: RetrieveXDefs.Handle, mbx: RetrieveXDefs.MBXPtr,
    new: RetrieveDefs.ServerState] =
    BEGIN
    mbx.replyWanted ← FALSE;
    BROADCAST handle.mbxStateChange;
    IF new # mbx.state THEN
      SELECT new FROM
        unknown =>
          BEGIN
          IF mbx.state = notEmpty THEN
            handle.notEmptyMBXCount ← handle.notEmptyMBXCount - 1;
          handle.unknownMBXCount ← handle.unknownMBXCount + 1;
          END;
        empty =>
          BEGIN
          SELECT mbx.state FROM
            unknown => handle.unknownMBXCount ← handle.unknownMBXCount - 1;
            notEmpty => handle.notEmptyMBXCount ← handle.notEmptyMBXCount - 1;
            ENDCASE => NULL;
          END;
        notEmpty =>
          BEGIN
          IF mbx.state = unknown THEN
            handle.unknownMBXCount ← handle.unknownMBXCount - 1;
          handle.notEmptyMBXCount ← handle.notEmptyMBXCount + 1;
          END;
        ENDCASE => ERROR;
    mbx.state ← new;
    IF new = unknown THEN  -- if server is down, its address may change! --
      mbx.addrState ← unknown;
    BEGIN
    -- consider whether poll is complete --
    complete: BOOLEAN ← TRUE;
    emptyFound: BOOLEAN ← FALSE;
    FOR this: RetrieveXDefs.MBXPtr ← handle.MBXChain, this.next WHILE this #
      RetrieveXDefs.noMBX DO
      IF this.state = empty THEN emptyFound ← TRUE;
      IF this.replyWanted THEN complete ← FALSE;
      ENDLOOP;
    -- definitive calculation of global state! --
    SetMBXState[
      handle,
      SELECT TRUE FROM
        (handle.notEmptyMBXCount # 0) => notEmpty,
        (handle.unknownMBXCount = 0) => allEmpty,
        (NOT complete) => userOK,
        emptyFound => someEmpty
        ENDCASE => allDown];
    END;
    END;

  SetMBXState: PUBLIC INTERNAL PROCEDURE [
    handle: RetrieveXDefs.Handle, state: RetrieveDefs.MBXState] =
    BEGIN
    BROADCAST handle.mbxStateChange;
    IF state # userOK AND handle.changes # NIL THEN handle.changes[state];
    handle.mbxState ← state;
    END;

  END.