-- Transport Mechanism: User: "hot" module for mail polling --

-- [Juniper]<DMS>MS>RetrievePoll.mesa

-- Andrew Birrell  26-Feb-81 11:55:54 --

DIRECTORY
BodyDefs	USING[ RName ],
Inline		USING[ COPY, HighHalf, LongCOPY, LowHalf ],
NameInfoDefs	USING[ AuthenticateInfo, AuthenticateKey ],
NameInfoSpecialDefs USING[ CleanUp ],
Process		USING[ SecondsToTicks, SetTimeout ],
ProtocolDefs	USING[ mailServerPollingSocket ],
PupDefs		USING[ GetFreePupBuffer, PupAddress, PupBuffer,
		       PupRouterSendThis, PupSocket, PupSocketDestroy,
		       PupSocketKick, PupSocketMake, ReturnFreePupBuffer,
		       SetPupContentsBytes, SetPupContentsWords,
		       veryLongWait ],
PupTypes	USING[ fillInSocketID, miscSrvSoc, userAuthBad,
		       userAuthOk, userAuthReq ],
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 Inline, NameInfoDefs, NameInfoSpecialDefs, Process,
           ProtocolDefs, PupDefs, RetrieveXDefs, Time
   EXPORTS RetrieveXDefs =

BEGIN

Copy: PROC[from: POINTER, to: LONG POINTER, nwords: CARDINAL] =
   BEGIN
   -- This procedure is required because PupBuffer's are LONG in Pilot
   -- and Inline.LongCopy doesn't work on Alto I's.
   -- I think this procedure will work with a non-zero MDS base --
   longFrom: LONG POINTER = LONG[from];
   IF Inline.HighHalf[longFrom] = Inline.HighHalf[to]
   THEN -- "to" is in the MDS --
        Inline.COPY[from: from,
                    to: Inline.LowHalf[to-(longFrom-from)],
                    nwords: nwords]
   ELSE -- "to" isn't in MDS, so LongCopy must be OK --
        Inline.LongCOPY[from: longFrom, to: to, nwords: nwords];
   END;

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 IF handle.registry = MTP
                     THEN BEGIN
                          SendAuthReq[handle, socketAddr];
                          transmissions _ transmissions + 1;
                          WAIT handle.pollCond--wait for reply--;
                          IF transmissions >= transmitLimit
                          THEN BEGIN
                               IF handle.mbxState = unknown --no reply--
                               THEN SetMBXState[handle, cantAuth];
                               END;
                          END
                     ELSE 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 = PupDefs.GetFreePupBuffer[];
                        Copy[from: @(handle.userName.text),
                             to: @(b.pupString),
                             nwords: (1+handle.userName.length)/2 ];
                        PupDefs.SetPupContentsBytes[b, handle.userName.length];
                        b.pupType _ mailCheckLaurel;
                        b.pupID _ handle.pollID;
                        b.dest _ [this.addr.net, this.addr.host,
                                IF this.type = MTP
                                THEN PupTypes.miscSrvSoc
                                ELSE ProtocolDefs.mailServerPollingSocket];
                        b.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;


SendAuthReq: INTERNAL PROC[handle: RetrieveXDefs.Handle,
                           socketAddr: PupDefs.PupAddress] =
   BEGIN
   this: RetrieveXDefs.MBXPtr = handle.MBXChain;
   IF this.type # MTP THEN ERROR;
   IF this.addrState # known
   THEN SetMBXState[handle, cantAuth]
   ELSE BEGIN
        b: PupDefs.PupBuffer = PupDefs.GetFreePupBuffer[];
        userWords: CARDINAL = SIZE[StringBody[handle.userName.maxlength]];
        pwdWords: CARDINAL = SIZE[StringBody[handle.userPwd.maxlength]];
        Copy[from: handle.userName, to: @(b.pupBody), nwords: userWords ];
        Copy[from: handle.userPwd, to: @(b.pupBody)+userWords,
             nwords: pwdWords ];
        PupDefs.SetPupContentsWords[b, userWords + pwdWords];
        b.pupType _ PupTypes.userAuthReq;
        b.dest _ [this.addr.net, this.addr.host, PupTypes.miscSrvSoc];
        b.pupID _ handle.pollID;
        b.source _ socketAddr;
        PupDefs.PupRouterSendThis[b];
        END;
   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 PupDefs.ReturnFreePupBuffer[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.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.source.net
           AND mbx.addr.host = b.source.host
           THEN BEGIN
                noProcessPupErrorCode: CARDINAL = 2B;
                cantGetTherePupErrorCode: CARDINAL = 1002B;
                eightHopsPupErrorCode: CARDINAL = 1004B;
	      SELECT b.pupType FROM
                  PupTypes.userAuthOk => -- MTP authentication --
                    BEGIN
                    mbx.replyWanted _ TRUE;
                    IF handle.mbxState = unknown
                    THEN SetMBXState[handle, userOK];
                    handle.pollStarted _ 0; --force new poll for mbx's --
                    END;
                  PupTypes.userAuthBad =>
                    IF handle.mbxState = unknown
                    THEN SetMBXState[handle, badPwd--badName?--];
                  mailIsNew =>
                    NoteChangedMBX[handle, mbx, notEmpty];
                  mailNotNew =>
                    NoteChangedMBX[handle, mbx, empty];
                  mailError =>
                    NoteChangedMBX[handle, mbx, empty];
                  error =>
		 -- The following LOOPHOLE brought to you courtesy of the Alto version
		 -- of PupTypes has PupErrorCode: TYPE = RECORD[WORD] and the Pilot
		 -- version has PupErrorCode: TYPE = MACHINE DEPENDENT { .... }.
                    SELECT LOOPHOLE[b.errorCode, CARDINAL] 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.