GVRetrieveImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Created by Andrew Birrell
Russ Atkinson (RRA) October 18, 1985 6:45:10 pm PDT
Hal Murray, June 3, 1986 3:45:33 pm PDT
DIRECTORY
BasicTime USING [earliestGMT, GMT, Now, Period],
Endian USING [FFromCard, FWORD, HWORD, CardFromF],
GVBasics USING [Connect, ItemHeader, ItemLength, MakeKey, RName, Password, 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,
IO USING [CharsAvail, CreateStreamProcs, CreateStream, EndOfStream, STREAM, StreamProcs, UnsafeBlock],
Process USING [SecondsToTicks, SetTimeout],
Pup USING [Address, nullAddress, nullSocket, Socket],
PupBuffer USING [Buffer],
PupName USING [Error, HisAddresses, NameLookup],
PupSocket USING [AllocBuffer, AppendRope, CopyRope, CreateEphemeral, Destroy, FreeBuffer, Get, GetLocalAddress, GetUserBytes, Kick, Send, SetNoErrors, SetUserHWords, Socket],
PupStream USING [ConsumeMark, StreamClosing, Timeout],
PupType USING [],
PupWKS USING [misc],
Rope USING [Find, Length, ROPE, Substr];
GVRetrieveImpl: CEDAR MONITOR
LOCKS handle USING handle: Handle
IMPORTS BasicTime, Endian, GVBasics, GVNames, GVProtocol, IO, Process, PupName, PupSocket, PupStream, Rope
EXPORTS GVRetrieve = {
MBXState: TYPE = GVRetrieve.MBXState;
RName: TYPE = GVBasics.RName;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
The client's mailboxes are represented by a chain:
MBXPtr: TYPE = REF MBXData;
MBXData: TYPE = RECORD[
next: MBXPtr,
type: GVRetrieve.ServerType,
state: GVRetrieve.ServerState,
addrState: { unknown, known, bad },
replyWanted: BOOLEAN,
addr: Pup.Address,
name: GVBasics.RName ];
The overall state of mail is represented by a HandleObject
Handle: TYPE = REF HandleObject;
HandleObject: PUBLIC TYPE = MONITORED RECORD[
list of the user's mailboxes
MBXChain: MBXPtr,
mbxKnown: BOOLEAN, -- whether user's mailbox sites are known
notEmptyMBXCount: CARDINAL,
unknownMBXCount: CARDINAL,
user's registry type
registry: GVRetrieve.ServerType,
Current state of mail reading:
state: -- position in legal call sequences
{ -- GV states
beforeMBX, beforeTOCr, beforeBody, inBody,
beforeTOCw, afterMessage, afterMBX,
MTP states
end, beginning, message, lastItem, block,
lastBlock, lastMessage },
spareByte: BOOLEAN, -- GV padding, or MTP odd-byte mess
spareByteValue: CHARACTER, -- for MTP odd-byte mess
header: GVBasics.ItemHeader, -- header of current item; length field is decremented as we go
itemLength: INT, -- total length of current item (for IO.GetLength)
currentMBX: MBXPtr, -- mailbox being read
messages: CARDINAL, -- number of messages in the mailbox
currentStr: GVProtocol.Handle, -- stream to mailbox being read
State of mailbox polling:
mbxState: GVRetrieve.MBXState,
polling: BOOLEAN,
pollWanted: BOOLEAN,
newPollWanted: BOOLEAN,
pollReplying: BOOLEAN,
mbxStateChange: CONDITION,
pollCond: CONDITION,
pollID: Endian.FWORD,
sendPoll: PROCESS,
pollStarted: BasicTime.GMT, -- real time when poll last started
Global information supplied by the client:
interval: INT, -- polling interval, in seconds
changes: PROCEDURE[GVRetrieve.MBXState],
userName: GVBasics.RName,
userPwd: Rope.ROPE,
userKey: GVBasics.Password ];
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 before 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 ← NIL;
handle.mbxKnown ← FALSE;
handle.notEmptyMBXCount ← 0;
handle.unknownMBXCount ← 0;
handle.registry ← GV;
handle.spareByte ← FALSE;
handle.currentMBX ← NIL;
handle.messages ← 0;
handle.currentStr ← NIL;
handle.mbxState ← badName;
handle.polling ← FALSE;
handle.pollWanted ← FALSE;
handle.newPollWanted ← FALSE;
handle.pollReplying ← FALSE;
handle.pollID ← Endian.FFromCard[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 = NIL 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: PupSocket.Socket = PupSocket.CreateEphemeral[remote: Pup.nullAddress];
socketAddr: Pup.Address = PupSocket.GetLocalAddress[socket];
replyPoll: PROCESS = FORK PollReplyProcess[handle, socket];
transmissions: CARDINAL ← 0; -- number of retransmissions so far
handle.pollReplying ← TRUE;
TRUSTED {
Process.SetTimeout[@handle.pollCond, Process.SecondsToTicks[retransmitDelay] ];
};
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: MBXPtr ← handle.MBXChain, this.next WHILE this # NIL 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;
Process.SetTimeout[@handle.pollCond, Process.SecondsToTicks[retransmitDelay] ]; }
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, socket, socketAddr];
transmissions ← transmissions + 1;
WAIT handle.pollCond; --wait for reply
IF transmissions >= transmitLimit THEN {
IF handle.mbxState = unknown THEN --no reply
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: MBXPtr ← handle.MBXChain, this.next WHILE this # NIL DO
IF this.replyWanted THEN {
b: PupBuffer.Buffer = PupSocket.AllocBuffer[socket];
PupSocket.CopyRope[b, handle.userName];
b.type ← mailCheckLaurel;
b.id ← handle.pollID;
b.dest ← [this.addr.net, this.addr.host,
IF this.type = MTP THEN PupWKS.misc
ELSE GVProtocol.GetSocket[MSPoll] ];
PupSocket.Send[socket, b, b.dest];
finished ← FALSE; };
ENDLOOP;
IF finished THEN transmissions ← transmitLimit -- all have replied
ELSE WAIT handle.pollCond;
IF transmissions >= transmitLimit THEN {
FOR this: MBXPtr ← handle.MBXChain, this.next WHILE this # NIL DO
IF this.addrState = unknown OR this.replyWanted THEN
NoteChangedMBX[handle, this, unknown];
ENDLOOP;
special case for user with no mailboxes
IF handle.MBXChain = NIL THEN SetMBXState[handle, allEmpty]; }; };
ENDCASE => transmissions ← transmitLimit; -- couldn't authenticate
ENDLOOP;
PupSocket.Kick[socket];
WHILE handle.pollReplying DO WAIT handle.pollCond; ENDLOOP;
JOIN replyPoll;
PupSocket.SetNoErrors[socket];
PupSocket.Destroy[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 = NIL
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 = NIL
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: Pup.Address ← 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 [Pup.Address] = {
IF handle.currentMBX = NIL 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: 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: MBXPtr ← handle.MBXChain, this.next WHILE this # NIL 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];
{ -- Registrys with only one address are MTP
addresses: LIST OF Pup.Address;
handle.registry ← GV; -- default if registry isn't in NLS
addresses ← PupName.HisAddresses[registry, Pup.nullSocket ! PupName.Error =>
IF code = errorFromServer THEN CONTINUE ELSE GOTO noReg ];
IF addresses # NIL AND addresses.rest = NIL THEN handle.registry ← MTP;
};
IF handle.MBXChain # NIL 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: 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 ← PupName.NameLookup[connect,
! PupName.Error =>
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: PupBuffer.Buffer] RETURNS [BOOL] = TRUSTED {
IF NOT handle.pollWanted THEN {
handle.pollReplying ← FALSE; BROADCAST handle.pollCond;
RETURN [FALSE]
};
IF b # NIL AND b.id = handle.pollID THEN {
mbx: MBXPtr;
FOR mbx ← handle.MBXChain, mbx.next UNTIL mbx = NIL 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.type FROM
userAuthOk => {
MTP authentication
mbx.replyWanted ← TRUE;
IF handle.mbxState = unknown THEN SetMBXState[handle, userOK];
handle.pollStarted ← BasicTime.earliestGMT; --force new poll for mbx's
};
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 =>
SELECT b.error.code FROM
noSocket, cantGetThere, hostDown, tooManyHops => 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 ← Endian.FFromCard[Endian.CardFromF[handle.pollID] + 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 # NIL THEN {
GVClose[handle];
handle.currentMBX ← NIL;
};
handle.unknownMBXCount ← handle.notEmptyMBXCount ← 0;
SetMBXState[handle, unknown];
handle.mbxKnown ← FALSE;
handle.MBXChain ← NIL;
};
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: MBXPtr] = {
last: MBXPtr ← NIL;
skip to end of mailbox chain
FOR old: MBXPtr ← handle.MBXChain, old.next UNTIL old = NIL DO
last ← old;
ENDLOOP;
this ← NEW[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 ← NIL;
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, socket: PupSocket.Socket, socketAddr: Pup.Address] = TRUSTED {
this: MBXPtr = handle.MBXChain;
IF this.type # MTP THEN ERROR;
IF this.addrState # known
THEN SetMBXState[handle, cantAuth]
ELSE {
b: PupBuffer.Buffer = PupSocket.AllocBuffer[socket];
b.hWord[0] ← Rope.Length[handle.userName];
b.hWord[1] ← LAST[CARDINAL];
PupSocket.SetUserHWords[b, 2];
PupSocket.AppendRope[b, handle.userName];
{
pos: INT = (PupSocket.GetUserBytes[b] +1)/SIZE[Endian.HWORD]; -- Round UP
b.hWord[pos] ← Rope.Length[handle.userPwd];
b.hWord[pos+1] ← LAST[CARDINAL];
PupSocket.SetUserHWords[b, pos+2];
PupSocket.AppendRope[b, handle.userPwd]; };
b.type ← userAuthReq;
b.dest ← [this.addr.net, this.addr.host, PupWKS.misc];
b.id ← handle.pollID;
PupSocket.Send[socket, b, b.dest];
};
};
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: PupSocket.Socket] = TRUSTED {
main program for replies to the polls
DO
b: PupBuffer.Buffer = PupSocket.Get[socket];
IF NOT ConsiderPollReply[handle, b] THEN EXIT;
IF b # NIL THEN PupSocket.FreeBuffer[b];
ENDLOOP;
};
}.