GVRetrieveImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Created by Andrew Birrell
Russ Atkinson (RRA) February 11, 1986 4:04:39 pm PST
DIRECTORY
BasicTime USING [earliestGMT, GMT, Now, Period],
GVBasics USING [Connect, ItemHeader, ItemLength, MakeKey, RName, Timestamp],
GVNames USING [AuthenticateInfo, AuthenticateKey, ConnectInfo, Expand, ExpandInfo, GetConnect, NameType, RListHandle],
GVProtocol USING [Close, CreateStream, Failed, FailureReason, GetSocket, Handle, ReceiveAck, ReceiveBoolean, ReceiveByte, ReceiveBytes, ReceiveCount, ReceiveItemHeader, ReceiveRemark, ReceiveRName, ReceiveTimestamp, SendMSOperation, SendNow, SendPassword, SendRemark, SendRName],
GVRetrieve USING [FailureReason, MBXState, ServerState, ServerType],
GVRetrieveInternal USING [Handle, HandleObject, MBXData, MBXPtr, noMBX],
IO USING [CharsAvail, CreateStreamProcs, CreateStream, EndOfStream, STREAM, StreamProcs, UnsafeBlock],
Process USING [SecondsToTicks, SetTimeout],
PupDefs USING [AppendRopeToPupBuffer, EnumeratePupAddresses, GetFreePupBuffer, GetPupAddress, GetPupContentsBytes, MoveRopeToPupBuffer, PupBuffer, PupNameTrouble, PupRouterSendThis, PupSocket, PupSocketDestroy, PupSocketKick, PupSocketMake, ReturnFreePupBuffer, SetPupContentsWords, veryLongWait],
PupStream USING [ConsumeMark, StreamClosing, TimeOut],
PupTypes USING [fillInSocketID, miscSrvSoc, PupAddress, userAuthBad, userAuthOk, userAuthReq],
Rope USING [Find, Length, ROPE, Substr];
GVRetrieveImpl: CEDAR MONITOR
LOCKS handle USING handle: GVRetrieveInternal.Handle
IMPORTS BasicTime, GVBasics, GVNames, GVProtocol, IO, Process, PupDefs, PupStream, Rope
EXPORTS GVRetrieve, GVRetrieveInternal = {
Handle: PUBLIC TYPE = GVRetrieveInternal.Handle;
HandleObject: PUBLIC TYPE = GVRetrieveInternal.HandleObject;
MBXState: TYPE = GVRetrieve.MBXState;
PupAddress: TYPE = PupTypes.PupAddress;
RName: TYPE = GVBasics.RName;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Global variables
myStreamProcs: REF IO.StreamProcs = IO.CreateStreamProcs[
variety: $input, class: $Grapevine,
getChar: GVGetChar,
endOf: GVEndOf,
getLength: GVGetLength,
charsAvail: GVCharsAvail,
unsafeGetBlock: GVUnsafeGetBlock,
close: GVCloseStream ];
transmitLimit: CARDINAL ← 5 -- max number of transmissions of poll --;
retransmitDelay: CARDINAL ← 10 -- seconds bfore re-transmittting --;
Errors
Failed: PUBLIC ERROR[why: GVRetrieve.FailureReason, text: ROPE] = CODE;
WrongCallSequence: ERROR = CODE;
Public procedures
Create: PUBLIC PROC [pollingInterval: CARDINAL, reportChanges: PROC [MBXState] ← NIL] RETURNS [handle: Handle] = {
handle ← NEW[HandleObject];
{
handle.MBXChain ← GVRetrieveInternal.noMBX;
handle.mbxKnown ← FALSE;
handle.notEmptyMBXCount ← 0;
handle.unknownMBXCount ← 0;
handle.registry ← GV;
handle.spareByte ← FALSE;
handle.currentMBX ← GVRetrieveInternal.noMBX;
handle.messages ← 0;
handle.currentStr ← NIL;
handle.mbxState ← badName;
handle.polling ← FALSE;
handle.pollWanted ← FALSE;
handle.newPollWanted ← FALSE;
handle.pollReplying ← FALSE;
handle.pollID ← [0,1];
handle.pollStarted ← BasicTime.Now[];
handle.interval ← pollingInterval;
handle.changes ← reportChanges;
handle.userName ← NIL;
handle.userPwd ← NIL;
handle.userKey ← [0,0,0,0];
};
};
Public ENTRY procedures
MailboxState: PUBLIC ENTRY PROC [handle: Handle] RETURNS [state: MBXState] = {
ENABLE UNWIND => NULL;
DO
SELECT handle.mbxState FROM
unknown, userOK => WAIT handle.mbxStateChange;
ENDCASE => EXIT;
ENDLOOP;
RETURN [handle.mbxState]
};
ServerName: PUBLIC ENTRY PROC [handle: Handle] RETURNS [serverName: RName] = {
IF handle.currentMBX = GVRetrieveInternal.noMBX THEN ERROR WrongCallSequence[];
RETURN [handle.currentMBX.name];
};
WaitForMail: PUBLIC ENTRY PROC [handle: Handle] = {
WHILE handle.mbxState # notEmpty DO WAIT handle.mbxStateChange ENDLOOP;
};
Close: PUBLIC ENTRY PROC [handle: Handle] = {
UnsetMailboxes[handle];
handle.userName ← NIL;
handle.userPwd ← NIL;
};
NewUser: PUBLIC ENTRY PROC [ handle: Handle, user, password: ROPE] = {
UnsetMailboxes[handle];
IF user.Length[] = 0
THEN SetMBXState[handle, badName]
ELSE IF password.Length[] = 0
THEN SetMBXState[handle, badPwd]
ELSE {
handle.userName ← user;
handle.userPwd ← password;
handle.userKey ← GVBasics.MakeKey[handle.userPwd];
RestartPoll[handle];
};
};
DeleteMessage: PUBLIC ENTRY PROC [handle: Handle] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
WHILE handle.state = inBody DO [] ← InnerNextItem[handle]; ENDLOOP;
IF handle.state # beforeBody THEN ERROR WrongCallSequence[];
GVProtocol.SendMSOperation[handle.currentStr, deleteMessage];
GVProtocol.SendNow[handle.currentStr];
GVProtocol.ReceiveAck[handle.currentStr];
handle.state ← beforeBody;
};
Accept: PUBLIC ENTRY PROC [handle: Handle] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
IF handle.state # afterMBX THEN ERROR WrongCallSequence[];
GVProtocol.SendMSOperation[handle.currentStr, flushMBX];
GVProtocol.SendNow[handle.currentStr];
GVProtocol.ReceiveAck[handle.currentStr];
NoteChangedMBX[handle, handle.currentMBX, empty];
};
SendPollProcess: PUBLIC ENTRY PROC [handle: Handle] = TRUSTED {
main program for sending polls
socket: PupDefs.PupSocket = PupDefs.PupSocketMake[
PupTypes.fillInSocketID, , PupDefs.veryLongWait];
socketAddr: PupAddress = socket.getLocalAddress[];
replyPoll: PROCESS = FORK PollReplyProcess[handle, socket];
transmissions: CARDINAL ← 0; -- number of retransmissions so far
SetPollTimeout: PROC = TRUSTED {
Process.SetTimeout[@handle.pollCond, Process.SecondsToTicks[retransmitDelay] ];
};
handle.pollReplying ← TRUE;
SetPollTimeout[];
WHILE handle.pollWanted DO
now: BasicTime.GMT = BasicTime.Now[];
elapsedSecs: INT = BasicTime.Period[from: handle.pollStarted, to: now];
IF handle.newPollWanted OR elapsedSecs >= handle.interval THEN {
handle.pollStarted ← now;
transmissions ← 0;
IF handle.mbxState NOT IN [userOK..notEmpty]
THEN handle.mbxState ← unknown --retry authentication--
ELSE {
IF handle.notEmptyMBXCount = 0 AND handle.unknownMBXCount # 0 THEN
handle.mbxState ← userOK --was someEmpty or allDown--;
FOR this: GVRetrieveInternal.MBXPtr ← handle.MBXChain, this.next WHILE this # GVRetrieveInternal.noMBX DO
IF this.addrState = unknown THEN FindAddress[handle, this];
IF this.addrState = known AND (handle.newPollWanted OR this.state # notEmpty)
THEN this.replyWanted ← TRUE;
ENDLOOP;
};
handle.newPollWanted ← FALSE;
BROADCAST handle.mbxStateChange;
};
IF transmissions >= transmitLimit
THEN TRUSTED {
Process.SetTimeout[@handle.pollCond, Process.SecondsToTicks[handle.interval-elapsedSecs]];
WAIT handle.pollCond;
SetPollTimeout[];
}
ELSE SELECT handle.mbxState FROM
unknown => {
authenticate
IF NOT handle.mbxKnown THEN FindRegistryAndMailboxes[handle];
IF handle.mbxState = unknown THEN
IF handle.registry = MTP
THEN {
SendAuthReq[handle, socketAddr];
transmissions ← transmissions + 1;
WAIT handle.pollCond--wait for reply--;
IF transmissions >= transmitLimit THEN {
IF handle.mbxState = unknown --no reply--
THEN SetMBXState[handle, cantAuth];
};
}
ELSE {
info: GVNames.AuthenticateInfo =
GVNames.AuthenticateKey[handle.userName, handle.userKey];
SetMBXState[handle,
SELECT info FROM
individual => userOK,
badPwd => badPwd,
group, notFound => badName,
allDown => cantAuth,
ENDCASE => ERROR];
}
--ELSE "FindRegistryAndMailboxes" failed--;
};
IN [userOK..notEmpty] => --authenticated-- {
poll the mailboxes
finished: BOOL ← TRUE; --whether all have replied--
transmissions ← transmissions + 1;
FOR this: GVRetrieveInternal.MBXPtr ← handle.MBXChain, this.next WHILE this # GVRetrieveInternal.noMBX DO
IF this.replyWanted THEN {
b: PupDefs.PupBuffer = PupDefs.GetFreePupBuffer[];
PupDefs.MoveRopeToPupBuffer[b, handle.userName];
b.pupType ← mailCheckLaurel;
b.pupID ← handle.pollID;
b.dest ← [this.addr.net, this.addr.host,
IF this.type = MTP
THEN PupTypes.miscSrvSoc
ELSE GVProtocol.GetSocket[MSPoll] ];
b.source ← socketAddr;
PupDefs.PupRouterSendThis[b];
finished ← FALSE;
};
ENDLOOP;
IF finished
THEN transmissions ← transmitLimit -- all have replied
ELSE WAIT handle.pollCond;
IF transmissions >= transmitLimit THEN {
FOR this: GVRetrieveInternal.MBXPtr ← handle.MBXChain, this.next WHILE this # GVRetrieveInternal.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 = GVRetrieveInternal.noMBX THEN
SetMBXState[handle, allEmpty];
};
};
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;
};
NextServer: PUBLIC ENTRY PROC [handle: Handle] RETURNS [noMore: BOOL, state: GVRetrieve.ServerState, type: GVRetrieve.ServerType] = {
ENABLE UNWIND => NULL;
DO
SELECT handle.mbxState FROM
unknown, userOK => WAIT handle.mbxStateChange;
ENDCASE => EXIT;
ENDLOOP;
IF handle.currentMBX = GVRetrieveInternal.noMBX
THEN {
handle.currentMBX ← handle.MBXChain;
handle.newPollWanted ← TRUE; BROADCAST handle.pollCond;
WHILE handle.newPollWanted DO WAIT handle.mbxStateChange ENDLOOP;
}
ELSE {
GVClose[handle];
handle.currentMBX ← handle.currentMBX.next;
};
IF handle.currentMBX = GVRetrieveInternal.noMBX
THEN {
noMore ← TRUE;
}
ELSE {
noMore ← FALSE;
WHILE handle.currentMBX.replyWanted DO WAIT handle.mbxStateChange ENDLOOP;
state ← handle.currentMBX.state;
IF handle.currentMBX.type = MTP
THEN {
handle.state ← beginning;
type ← MTP;
}
ELSE {
handle.header ← [type: LastItem, length: 0];
handle.spareByte ← FALSE;
handle.state ← beforeMBX;
type ← GV;
};
};
};
NextMessage: PUBLIC ENTRY PROC [handle: Handle] RETURNS [msgExists: BOOL, archived: BOOL, deleted: BOOL] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
IF handle.state = beforeMBX THEN {
addr: PupAddress ← ServerAddress[handle];
we exited by a signal if the address wasn't available
IF handle.currentStr # NIL THEN ERROR;
IF handle.currentMBX.type # GV THEN
ERROR Failed[communicationFailure, "Can't access MTP mailboxes from Cedar"];
handle.currentStr ← GVProtocol.CreateStream[handle.currentMBX.addr, MSRetrieve];
GVProtocol.SendMSOperation[handle.currentStr, openMBX];
GVProtocol.SendRName[handle.currentStr, handle.userName];
GVProtocol.SendPassword[str:handle.currentStr, pw:handle.userKey];
GVProtocol.SendNow[handle.currentStr];
{
info: GVNames.AuthenticateInfo = LOOPHOLE[GVProtocol.ReceiveByte[handle.currentStr]];
SELECT info FROM
allDown => ERROR Failed[communicationFailure, "You mailbox server can't contact an authentication server"];
notFound, group, badPwd => ERROR Failed[badCredentials, "Your mailbox server doesn't like your name or password"];
individual => NULL;
ENDCASE => ERROR Failed[unknownFailure, "Unknown return code from mailbox"];
};
handle.messages ← GVProtocol.ReceiveCount[handle.currentStr];
handle.state ← afterMessage;
};
WHILE handle.state = inBody DO [] ← InnerNextItem[handle]; ENDLOOP;
IF handle.state = beforeBody THEN handle.state ← afterMessage;
handle.state is now afterMessage or afterMBX
IF handle.messages = 0
THEN {
handle.state ← afterMBX;
RETURN [FALSE, FALSE, FALSE];
}
ELSE {
handle.messages ← handle.messages-1;
GVProtocol.SendMSOperation[handle.currentStr, nextMessage];
GVProtocol.SendNow[handle.currentStr];
msgExists ← GVProtocol.ReceiveBoolean[handle.currentStr];
archived ← GVProtocol.ReceiveBoolean[handle.currentStr];
deleted ← GVProtocol.ReceiveBoolean[handle.currentStr];
IF msgExists THEN handle.state ← beforeBody ELSE ERROR;
};
};
ReadTOC: PUBLIC ENTRY PROC [handle: Handle] RETURNS [ROPE] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
WHILE handle.state = inBody DO [] ← InnerNextItem[handle]; ENDLOOP;
IF handle.state # beforeBody THEN ERROR WrongCallSequence[];
GVProtocol.SendMSOperation[handle.currentStr, readTOC];
GVProtocol.SendNow[handle.currentStr];
RETURN [GVProtocol.ReceiveRemark[handle.currentStr]];
};
StartMessage: PUBLIC ENTRY PROC [handle: Handle] RETURNS [postmark: GVBasics.Timestamp, sender: RName, returnTo: RName] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
[postmark, sender, returnTo] ← InnerStartMessage[handle];
};
NextItem: PUBLIC ENTRY PROC [handle: Handle] RETURNS [itemHeader: GVBasics.ItemHeader] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
IF handle.state # inBody THEN [] ← InnerStartMessage[handle];
RETURN [ InnerNextItem[handle] ]
};
GetItem: PUBLIC ENTRY PROC [handle: Handle] RETURNS [STREAM] = {
IF handle.state # inBody THEN ERROR WrongCallSequence[];
RETURN [IO.CreateStream[myStreamProcs, handle] ];
};
WriteTOC: PUBLIC ENTRY PROC [handle: Handle, entry: ROPE] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
WHILE handle.state = inBody DO [] ← InnerNextItem[handle]; ENDLOOP;
IF handle.state # beforeBody THEN ERROR WrongCallSequence[];
GVProtocol.SendMSOperation[handle.currentStr, writeTOC];
GVProtocol.SendRemark[handle.currentStr, entry];
GVProtocol.SendNow[handle.currentStr];
GVProtocol.ReceiveAck[handle.currentStr];
handle.state ← beforeBody;
};
Public INTERNAL procedures
ServerAddress: PUBLIC INTERNAL PROC [handle: Handle] RETURNS [PupAddress] = {
IF handle.currentMBX = GVRetrieveInternal.noMBX THEN ERROR WrongCallSequence[];
IF handle.currentMBX.addrState = unknown THEN FindAddress[handle, handle.currentMBX];
SELECT handle.currentMBX.addrState FROM
unknown => ERROR Failed[communicationFailure, "Can't find mailbox server address"];
bad => ERROR Failed[noSuchServer, "Your mailbox site name is not valid"];
known => RETURN [handle.currentMBX.addr];
ENDCASE => ERROR;
};
GVClose: PUBLIC INTERNAL PROC [handle: Handle] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
IF handle.currentStr # NIL THEN GVProtocol.Close[handle.currentStr];
handle.currentStr ← NIL; handle.state ← beforeMBX;
};
NoteChangedMBX: PUBLIC INTERNAL PROC [handle: Handle, mbx: GVRetrieveInternal.MBXPtr, new: GVRetrieve.ServerState] = {
mbx.replyWanted ← FALSE;
BROADCAST handle.mbxStateChange;
IF new # mbx.state THEN SELECT new FROM
unknown => {
IF mbx.state = notEmpty THEN
handle.notEmptyMBXCount ← handle.notEmptyMBXCount - 1;
handle.unknownMBXCount ← handle.unknownMBXCount + 1;
};
empty => {
SELECT mbx.state FROM
unknown => handle.unknownMBXCount ← handle.unknownMBXCount - 1;
notEmpty => handle.notEmptyMBXCount ← handle.notEmptyMBXCount - 1;
ENDCASE => NULL;
};
notEmpty => {
IF mbx.state = unknown THEN
handle.unknownMBXCount ← handle.unknownMBXCount - 1;
handle.notEmptyMBXCount ← handle.notEmptyMBXCount + 1;
};
ENDCASE => ERROR;
mbx.state ← new;
IF new = unknown THEN
if server is down, its address may change!
mbx.addrState ← unknown;
{
consider whether poll is complete
complete: BOOL ← TRUE;
emptyFound: BOOL ← FALSE;
FOR this: GVRetrieveInternal.MBXPtr ← handle.MBXChain, this.next WHILE this # GVRetrieveInternal.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 ];
};
};
SetMBXState: PUBLIC INTERNAL PROC [handle: Handle, state: MBXState] = {
BROADCAST handle.mbxStateChange;
IF state # userOK AND handle.changes # NIL THEN handle.changes[state];
handle.mbxState ← state;
};
FindRegistryAndMailboxes: PUBLIC INTERNAL PROC [handle: Handle] = {
length: INT = handle.userName.Length[];
firstRegChar: INT = handle.userName.Find["."]+1; -- =0 if no dot found
registry: ROPE = handle.userName.Substr[firstRegChar, length-firstRegChar];
{
called: BOOL ← FALSE;
Work: INTERNAL PROC [addr:PupAddress] RETURNS [stop:BOOL] = {
IF called
THEN { handle.registry ← GV; stop ← TRUE }
ELSE { handle.registry ← MTP; called ← TRUE; stop ← FALSE };
};
handle.registry ← GV; -- default if registry isn't in NLS
[] ← PupDefs.EnumeratePupAddresses[registry, Work
! PupDefs.PupNameTrouble =>
IF code = errorFromServer THEN CONTINUE ELSE GOTO noReg ];
};
IF handle.MBXChain # GVRetrieveInternal.noMBX THEN ERROR;
IF handle.registry = MTP
THEN {
FindAddress[handle, AddMBX[handle, registry]];
handle.mbxKnown ← TRUE;
}
ELSE FindGVMailboxes[handle];
EXITS
noReg => SetMBXState[handle, cantAuth];
};
FindAddress: PUBLIC INTERNAL PROC [handle: Handle, mbx: GVRetrieveInternal.MBXPtr] = {
connect: GVBasics.Connect;
info: GVNames.ConnectInfo;
IF mbx.addrState # unknown THEN ERROR;
IF mbx.type = GV
THEN {
[info, connect] ← GVNames.GetConnect[mbx.name];
SELECT info FROM
individual => NULL;
allDown => GOTO noAddr;
group, notFound => GOTO badConnect;
ENDCASE => ERROR;
}
ELSE connect ← mbx.name;
mbx^.addr ← PupDefs.GetPupAddress[[0,0], connect
! PupDefs.PupNameTrouble =>
IF code = errorFromServer THEN GOTO badConnect ELSE GOTO noAddr ];
mbx.addrState ← known;
EXITS
badConnect => {
NoteChangedMBX[handle,mbx,empty];
mbx.addrState ← bad };
noAddr => NULL;
};
Private ENTRY procedures
EntryGetChar: ENTRY PROC [handle: Handle] RETURNS [CHAR] = {
ENABLE { GVProtocol.Failed => Fail[why, text]; UNWIND => NULL };
IF handle.header.length = 0 THEN ERROR IO.EndOfStream[handle.currentStr];
RETURN [ LOOPHOLE[GVProtocol.ReceiveByte[handle.currentStr]] ]
};
EntryUnsafeGetBlock: ENTRY UNSAFE PROC [handle: Handle, block: IO.UnsafeBlock] RETURNS [nBytesRead: INT] = UNCHECKED {
returns 0 forever if we're at the end of the item
ENABLE { GVProtocol.Failed => CHECKED{ Fail[why, text] }; UNWIND => NULL };
amount: INT = MIN[block.count, handle.header.length];
IF handle.state # inBody THEN ERROR WrongCallSequence[];
GVProtocol.ReceiveBytes[handle.currentStr, [block.base, block.startIndex, block.startIndex+amount]];
handle.header.length ← handle.header.length - amount;
RETURN [amount]
};
EntryEndOf: ENTRY PROC [handle: Handle] RETURNS [BOOL] = {
RETURN [handle.header.length = 0];
};
EntryGetLength: ENTRY PROC [handle: Handle] RETURNS [length: INT] = {
RETURN [handle.itemLength];
};
EntryCharsAvail: ENTRY PROC [handle: Handle] RETURNS [BOOL] = {
RETURN [handle.header.length > 0 AND handle.currentStr.CharsAvail[]>0];
};
EntryCloseStream: ENTRY PROC [handle: Handle, abort: BOOL ← FALSE] = {
InnerSkipItem[handle];
};
ConsiderPollReply: ENTRY PROC [handle: Handle, b: PupDefs.PupBuffer] RETURNS [BOOL] = TRUSTED {
IF NOT handle.pollWanted THEN {
handle.pollReplying ← FALSE; BROADCAST handle.pollCond;
RETURN [FALSE]
};
IF b # NIL AND b.pupID = handle.pollID THEN {
mbx: GVRetrieveInternal.MBXPtr;
FOR mbx ← handle.MBXChain, mbx.next UNTIL mbx = GVRetrieveInternal.noMBX DO
IF mbx.addrState = known
AND mbx.addr.net = b.source.net
AND mbx.addr.host = b.source.host
THEN {
noProcessPupErrorCode: CARDINAL = 2B;
cantGetTherePupErrorCode: CARDINAL = 1002B;
eightHopsPupErrorCode: CARDINAL = 1004B;
SELECT b.pupType FROM
PupTypes.userAuthOk => {
MTP authentication
mbx.replyWanted ← TRUE;
IF handle.mbxState = unknown THEN SetMBXState[handle, userOK];
handle.pollStarted ← BasicTime.earliestGMT; --force new poll for mbx's
};
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;
};
ENDLOOP;
};
RETURN [TRUE]
};
Private INTERNAL procedures
InnerStartMessage: INTERNAL PROC [handle: Handle] RETURNS [postmark: GVBasics.Timestamp, sender: RName, returnTo: RName] = {
WHILE handle.state = inBody DO [] ← InnerNextItem[handle]; ENDLOOP;
IF handle.state # beforeBody THEN ERROR WrongCallSequence[];
GVProtocol.SendMSOperation[handle.currentStr, readMessage];
GVProtocol.SendNow[handle.currentStr];
handle.state ← inBody;
handle.header ← GVProtocol.ReceiveItemHeader[handle.currentStr ];
IF handle.header.type # PostMark THEN ERROR;
postmark ← GVProtocol.ReceiveTimestamp[handle.currentStr];
handle.header ← GVProtocol.ReceiveItemHeader[handle.currentStr];
IF handle.header.type # Sender THEN ERROR;
sender ← GVProtocol.ReceiveRName[handle.currentStr];
handle.header ← GVProtocol.ReceiveItemHeader[handle.currentStr];
IF handle.header.type # ReturnTo THEN ERROR;
returnTo ← GVProtocol.ReceiveRName[handle.currentStr];
handle.header.length ← 0; -- no more data in this item --
};
InnerNextItem: INTERNAL PROC [handle: Handle] RETURNS [itemHeader: GVBasics.ItemHeader] = {
IF handle.state # inBody THEN ERROR WrongCallSequence[];
IF handle.header.length > 0 OR handle.spareByte THEN InnerSkipItem[handle];
handle.header ← GVProtocol.ReceiveItemHeader[handle.currentStr];
handle.itemLength ← handle.header.length;
arrange for InnerSkip to include padding byte
handle.spareByte ← handle.header.length MOD 2 # 0;
IF handle.header.type = LastItem THEN {
IF handle.header.length > 0 THEN InnerSkipItem[handle];
[] ← PupStream.ConsumeMark[handle.currentStr !
PupStream.StreamClosing => Fail[communicationError, text];
PupStream.TimeOut => Fail[communicationError, "Mailbox server not sending data"]];
handle.state ← beforeBody;
};
itemHeader ← handle.header;
};
RestartPoll: INTERNAL PROC [handle: Handle] = {
handle.pollID.b ← handle.pollID.b + 1; --to ignore old poll replies--
IF NOT handle.polling THEN
handle.sendPoll ← FORK SendPollProcess[handle];
handle.polling ← handle.pollWanted ← TRUE;
handle.newPollWanted ← TRUE; BROADCAST handle.pollCond;
};
UnsetMailboxes: INTERNAL PROC [handle: Handle] = {
IF handle.polling THEN {
sendPoll: PROCESS ← NIL;
handle.pollWanted ← FALSE;
BROADCAST handle.pollCond;
WHILE handle.polling DO WAIT handle.pollCond ENDLOOP;
sendPoll ← handle.sendPoll;
IF sendPoll # NIL THEN TRUSTED {
RRA: Wait for the sendPoll process to finish. Also show that we do not need another JOIN.
handle.sendPoll ← NIL;
JOIN sendPoll;
};
};
IF handle.currentMBX # GVRetrieveInternal.noMBX THEN {
GVClose[handle];
handle.currentMBX ← GVRetrieveInternal.noMBX;
};
handle.unknownMBXCount ← handle.notEmptyMBXCount ← 0;
SetMBXState[handle, unknown];
handle.mbxKnown ← FALSE;
handle.MBXChain ← GVRetrieveInternal.noMBX;
};
FindGVMailboxes: INTERNAL PROC [handle: Handle] = {
IF handle.registry # GV
THEN ERROR
ELSE TRUSTED {
info: GVNames.ExpandInfo = GVNames.Expand[handle.userName];
WITH info SELECT FROM
allDown => SetMBXState[handle, cantAuth];
notFound => SetMBXState[handle, badName];
group =>
this case includes individual with forwarding
handle.mbxKnown ← TRUE;
individual => {
FOR site: GVNames.RListHandle ← sites, site.rest UNTIL site = NIL DO
FindAddress[handle, AddMBX[handle, site.first] ];
ENDLOOP;
handle.mbxKnown ← TRUE;
};
ENDCASE => ERROR;
};
};
AddMBX: INTERNAL PROC [handle: Handle, site: RName] RETURNS [this: GVRetrieveInternal.MBXPtr] = {
last: GVRetrieveInternal.MBXPtr ← NIL;
skip to end of mailbox chain
FOR old: GVRetrieveInternal.MBXPtr ← handle.MBXChain, old.next UNTIL old = NIL DO
last ← old;
ENDLOOP;
this ← NEW[GVRetrieveInternal.MBXData];
IF last = NIL THEN handle.MBXChain ← this ELSE last.next ← this;
this.name ← site;
this.type ← IF site.Find["."] < 0 THEN MTP ELSE GV;
this.next ← GVRetrieveInternal.noMBX;
this.state ← unknown; this.replyWanted ← TRUE;
handle.unknownMBXCount ← handle.unknownMBXCount + 1;
IF handle.mbxState = allEmpty THEN SetMBXState[handle, userOK];
this.addrState ← unknown;
};
InnerSkipItem: INTERNAL PROC [handle: Handle] = {
length: CARDINAL = 128;
buffer: PACKED ARRAY [0..length) OF CHAR;
IF handle.state # inBody THEN ERROR WrongCallSequence[];
IF handle.spareByte THEN handle.header.length ← handle.header.length+1;
handle.spareByte ← FALSE;
WHILE handle.header.length > 0 DO TRUSTED {
wanted: INT = MIN[handle.header.length, length];
GVProtocol.ReceiveBytes[handle.currentStr, [LOOPHOLE[LONG[@buffer]], 0, wanted]
! GVProtocol.Failed => Fail[communicationError, text] ];
handle.header.length ← handle.header.length - wanted;
};
ENDLOOP;
};
SendAuthReq: INTERNAL PROC [handle: Handle, socketAddr: PupAddress] = TRUSTED {
this: GVRetrieveInternal.MBXPtr = handle.MBXChain;
IF this.type # MTP THEN ERROR;
IF this.addrState # known
THEN SetMBXState[handle, cantAuth]
ELSE {
b: PupDefs.PupBuffer = PupDefs.GetFreePupBuffer[];
b.pupWords[0] ← handle.userName.Length[];
b.pupWords[1] ← LAST[CARDINAL];
PupDefs.SetPupContentsWords[b, 2];
PupDefs.AppendRopeToPupBuffer[b, handle.userName];
{
pos: INT = (PupDefs.GetPupContentsBytes[b] +1)/2;
b.pupWords[pos] ← handle.userPwd.Length[];
b.pupWords[pos+1] ← LAST[CARDINAL];
PupDefs.SetPupContentsWords[b, pos+2];
PupDefs.AppendRopeToPupBuffer[b, handle.userPwd];
};
b.pupType ← PupTypes.userAuthReq;
b.dest ← [this.addr.net, this.addr.host, PupTypes.miscSrvSoc];
b.pupID ← handle.pollID;
b.source ← socketAddr;
PupDefs.PupRouterSendThis[b];
};
};
Private utilities
Fail: PROC [why: GVProtocol.FailureReason, text: ROPE] = {
ERROR Failed[IF why = protocolError
THEN unknownFailure
ELSE communicationFailure, text];
};
GVGetChar: PROC [self: STREAM] RETURNS [CHAR] = {
RETURN [EntryGetChar[NARROW[self.streamData]]];
};
GVUnsafeGetBlock: UNSAFE PROC [self: STREAM, block: IO.UnsafeBlock] RETURNS [ nBytesRead: INT] = UNCHECKED {
RETURN [EntryUnsafeGetBlock[NARROW[self.streamData], block]];
};
GVEndOf: PROC [self: STREAM] RETURNS [BOOL] = {
RETURN [EntryEndOf[NARROW[self.streamData]]];
};
GVGetLength: PROC [self: STREAM] RETURNS [length: INT] = {
RETURN [EntryGetLength[NARROW[self.streamData]]];
};
GVCharsAvail: PROC [self: STREAM, wait: BOOL] RETURNS [INT] = {
RETURN [IF EntryCharsAvail[NARROW[self.streamData]] THEN 1 ELSE 0];
};
GVCloseStream: PROC [self: STREAM, abort: BOOL ← FALSE] = {
EntryCloseStream[NARROW[self.streamData], abort];
};
PollReplyProcess: PROC [handle: Handle, socket: PupDefs.PupSocket] = TRUSTED {
main program for replies to the polls
DO
b: PupDefs.PupBuffer = socket.get[];
IF NOT ConsiderPollReply[handle, b] THEN EXIT;
IF b # NIL THEN PupDefs.ReturnFreePupBuffer[b];
ENDLOOP;
};
}.