MSRetrieveImpl.mesa
Copyright Ó 1987, 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Doug Terry, November 29, 1988 8:38:05 pm PST
Wes Irish, December 22, 1988 2:57:28 pm PST
Willie-sue, December 10, 1991 7:58 pm PST
Willie-Sue Orr, January 18, 1990 1:43:21 pm PST
Tim Diebert: November 16, 1989 9:34:06 am PST
Demers, December 14, 1989 1:00:08 pm PST
Operations for retrieval of electronic mail messages from XNS mail servers.
DIRECTORY
AuthenticationP14V2 USING [CallProblem, Problem],
CHEntriesP0V0 USING [mailboxes],
CrRPC USING [BulkDataSink, CreateClientHandle, DestroyClientHandle, Error, ErrorReason, Handle],
EnvelopeFormatP1517V1,
InbasketP18V2 USING [AccessError, AccessProblem, AuthenticationError, BodyPartSequence, BodyPartSequenceObject, ChangeMessageStatus, Delete, InbasketInUse, IndexError, IndexProblem, Logoff, Logon, MailPoll, nullIndex, OtherError, OtherProblem, Range, RetrieveBodyParts, RetrieveEnvelopes, Session, SessionError, SessionProblem, ServiceError, ServiceProblem, State, Status],
IO,
MailBasicsItemTypes USING [interpress, nsTextFile, otherNSFile, postscript, vpDocument, vpFolder],
MailTransportP17V5 USING [Envelope],
MSBasics USING [BodyPartInfo, CHName, Envelope, lastBodyPart],
MSRetrieve,
MSUtils,
Process,
Rope,
UserProfile USING [Boolean],
XNS USING [Address],
XNSAuth USING [AuthenticationError, CallError, Conversation, Credentials, GetCredentials, GetIdentityDetails,GetNextVerifier, Identity, Initiate, MakeIdentity, SetRecipientHostNumber, Terminate, Verifier],
XNSCH USING [Conversation, Error, InitiateConversation, Item, LookupAddressFromRope, LookupItemProperty, TerminateConversation],
XNSCHItemOps USING [Error, NameListFromItem],
XNSCHName USING [Name, RopeFromName];
MSRetrieveImpl: CEDAR MONITOR
IMPORTS CrRPC, InbasketP18V2, IO, MSUtils, Process, Rope, UserProfile, XNSAuth, XNSCH, XNSCHItemOps, XNSCHName
EXPORTS MSRetrieve
~ BEGIN
This is a MONITOR because the client and the polling process run concurrently...it's the responsibility of the client not to have more than one outstanding call per handle.
OPEN
Authentication: AuthenticationP14V2,
CHEntries: CHEntriesP0V0,
EnvelopeFormat: EnvelopeFormatP1517V1,
Inbasket: InbasketP18V2,
MailTransport: MailTransportP17V5;
STREAM: TYPE ~ IO.STREAM;
ROPE: TYPE ~ Rope.ROPE;
LORA: TYPE ~ LIST OF REF ANY;
Debugging Junk
dbMsg: BOOL ¬ FALSE;
SetDBMsg: PROC [new: BOOL] RETURNS [old: BOOL] ~ {
old ¬ dbMsg; dbMsg ¬ new;
};
DBMsg: PROC [r: ROPE] ~ {
StringFromRope: PROC [zero: CARD32, r: ROPE] RETURNS [CARD32] ~ TRUSTED MACHINE CODE { "XR𡤌harStarFromRope" };
ConsoleMsg: PROC [m: CARD32] ~ TRUSTED MACHINE CODE { "XR𡤌onsoleMsg" };
msg: CARD32 ;
IF NOT dbMsg THEN RETURN;
msg ← StringFromRope[0, r];
ConsoleMsg[msg];
};
Handles and sessions
MSHandles are not tied directly to sessions with a MS server since MSHandles are potentially long-lived (hours or days) whereas sessions should be fairly short to avoid tying up resources on the server. Sessions are automatically established when needed and automatically released when further activity in the near future is unlikely (e.g. when NextServer returns noMore=TRUE).
Handle: TYPE ~ MSRetrieve.Handle; -- should always be of type MSHandle
MSHandle: TYPE ~ REF MSHandleObject;
MSHandleObject: TYPE ~ RECORD [
User identity, protected by the monitor lock ...
identity: XNSAuth.Identity ¬ NIL,
mailboxes: MBoxList ¬ NIL,
state: MSRetrieve.MboxState ¬ unknown,
State of current processing
service: XNSCHName.Name,
serviceAddr: REF XNS.Address ¬ NIL,
sessionEstablished: BOOLEAN ¬ FALSE,
session: Inbasket.Session,
unreadMailboxes: MBoxList ¬ NIL,
msg: CARD32 ¬ Inbasket.nullIndex, -- current message
msgList: LIST OF Inbasket.Range ¬ NIL, -- list of messages we've read
msgWithAttachmentsList: LIST OF Inbasket.Range ¬ NIL,
envelope: MSBasics.Envelope,
tocIndex: CARD32 ¬ LAST[CARD32],
msgsThisServer: INT ¬ 0,
Handle state
pollingInterval: CARDINAL ¬ minPollingInterval,
reportProc: MSRetrieve.ChangeReportProc ¬ NIL, -- write-once
closed: BOOLEAN ¬ FALSE
];
minPollingInterval: CARDINAL ~ 30; -- seconds
RPCData: TYPE ~ RECORD [
conv: XNSAuth.Conversation ¬ NIL,
rpcH: CrRPC.Handle ¬ NIL
];
MBoxList: TYPE ~ LIST OF XNSCHName.Name;
maxMsgsPerSession: INT ¬ 120;  -- xns mail servers seem to drop connnections when the mailbox has lots of messages; we "claim" the mailbox is empty after this many messages have been retrieved
SetMaxMsgsPerSession: PROC [new: INT] RETURNS [old: INT] -- DEBUG --
~ { old ¬ maxMsgsPerSession; maxMsgsPerSession ¬ new; };
GetUser: PROC [msH: MSHandle] RETURNS [user: XNSCHName.Name] ~ -- INLINE -- { user ¬ XNSAuth.GetIdentityDetails[msH.identity].name };
GetCreds: PROC [rpcD: RPCData] RETURNS [creds: XNSAuth.Credentials] ~ -- INLINE -- { creds ¬ XNSAuth.GetCredentials[rpcD.conv] };
GetVerf: PROC [rpcD: RPCData] RETURNS [verf: XNSAuth.Verifier] ~ -- INLINE -- { verf ¬ XNSAuth.GetNextVerifier[rpcD.conv] };
RefAddressFromName: PROC [name: XNSCHName.Name] RETURNS [refAddress: REF XNS.Address] ~ {
! May raise any error that might be raised during address lookup ...
There must be a better way to do this!
refAddress ¬ NEW[XNS.Address ¬ XNSCH.LookupAddressFromRope[XNSCHName.RopeFromName[name]].address];
};
PutRPCData: PROC [rpcD: RPCData] ~ {
IF rpcD.rpcH # NIL THEN CrRPC.DestroyClientHandle[rpcD.rpcH];
IF rpcD.conv # NIL THEN XNSAuth.Terminate[rpcD.conv];
};
GetRPCData: PROC [myID: XNSAuth.Identity, service: XNSCHName.Name, optionalAddr: REF XNS.Address] RETURNS [rpcD: RPCData ¬ [NIL, NIL]] ~ {
ENABLE UNWIND => PutRPCData[rpcD];
refAddr: REF XNS.Address;
N.B. the following could just use optionalAddr without copying it, I think ... ajd
IF optionalAddr = NIL
THEN refAddr ¬ RefAddressFromName[service]
ELSE refAddr ¬ NEW[XNS.Address ¬ optionalAddr­];
rpcD.rpcH ¬ CrRPC.CreateClientHandle[$CMUX, refAddr];
rpcD.conv ¬ XNSAuth.Initiate[myID, service];
XNSAuth.SetRecipientHostNumber[rpcD.conv, refAddr.host];
};
EstablishSession: PROC [msH: MSHandle] ~ {
rpcD: RPCData ¬ [NIL, NIL];
DoLogon: PROC ~ {
ENABLE UNWIND => PutRPCData[rpcD];
DBMsg[IO.PutFR1["Logon %g\n", IO.rope[XNSCHName.RopeFromName[msH.service]]]];
rpcD ¬ GetRPCData[msH.identity, msH.service, msH.serviceAddr];
msH.session ¬ Inbasket.Logon[rpcD.rpcH, GetUser[msH], GetCreds[rpcD], GetVerf[rpcD]].session;
msH.sessionEstablished ¬ TRUE;
PutRPCData[rpcD];
};
IF msH.sessionEstablished THEN {
DBMsg[IO.PutFR1["Continue session %g\n", IO.rope[XNSCHName.RopeFromName[msH.service]]]];
RETURN;
};
CallEnabled[DoLogon];
};
ReleaseSession: PROC [msH: MSHandle] ~ {
rpcD: RPCData ¬ [NIL, NIL];
DoLogoff: PROC ~ {
ENABLE UNWIND => PutRPCData[rpcD];
DBMsg[IO.PutFR1["Logoff %g\n", IO.rope[XNSCHName.RopeFromName[msH.service]]]];
rpcD ¬ GetRPCData[msH.identity, msH.service, msH.serviceAddr];
Inbasket.Logoff[rpcD.rpcH, msH.session];
msH.sessionEstablished ¬ FALSE;
PutRPCData[rpcD];
};
IF msH.sessionEstablished THEN CallEnabled[DoLogoff ! Failed => CONTINUE];
};
Exported procedures
Create: PUBLIC PROC [pollingInterval: CARDINAL, reportChanges: MSRetrieve.ChangeReportProc ¬ NIL] RETURNS [Handle] ~ {
Must be called before any other entries in this interface. Can be called many times. "pollingInterval" is the interval in seconds to wait between successive inbox checks and "reportChanges" (if provided) is called whenever the state of the user's authentication or mailboxes changes; "reportChanges" will not be called if the state changes to "unknown" or "userOK".
msH: MSHandle ¬ NEW[MSHandleObject];
msH.reportProc ¬ reportChanges;
msH.pollingInterval ¬ MAX[pollingInterval, minPollingInterval];
IF reportChanges # NIL THEN TRUSTED {
Process.Detach[ FORK PollMboxStatus[msH] ];
};
RETURN[msH];
};
Close: PUBLIC PROC [handle: Handle] RETURNS [] ~ {
Releases resources used by this handle. Further use of this handle is illegal.
msH: MSHandle ¬ NARROW[handle];
ReleaseSession[msH];
msH.closed ¬ TRUE;
Handle is garbage collected; nothing actually prevents the client from holding on to the handle and continuing to use it.
};
NewUser: PUBLIC PROC [handle: Handle, user: MSBasics.CHName, password: ROPE] RETURNS [] ~ {
Provides new user name and password, and starts authentication and mailbox checking.
msH: MSHandle ¬ NARROW[handle];
DoNewUser: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
msH.identity ¬ NIL;
msH.mailboxes ¬ NIL;
msH.state ¬ cantAuth;
msH.identity ¬ XNSAuth.MakeIdentity[user, password, simple];
msH.state ¬ badName;
msH.mailboxes ¬ GetMailboxes[user];
IF msH.mailboxes # NIL THEN msH.state ¬ userOK;
DBMsg[IO.PutFR1["NewUser state %g\n", IO.card[ORD[msH.state]]]];
};
ReleaseSession[msH];
CallEnabled[DoNewUser];
};
MailboxStateInner: PROC [handle: Handle]
RETURNS [oldState, newState: MSRetrieve.MboxState ¬ unknown] ~ {
Returns the current mailbox state. No ERRORs.
msH: MSHandle ¬ NARROW[handle];
down, empty, msgs: BOOLEAN ¬ FALSE;
computedState: MSRetrieve.MboxState;
identity: XNSAuth.Identity;
mailboxes: MBoxList;
GetHandleInfo: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
identity ¬ msH.identity;
mailboxes ¬ msH.mailboxes;
oldState ¬ msH.state;
};
SetNewState: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
IF msH.state >= userOK AND computedState >= userOK THEN msH.state ¬ computedState;
newState ¬ msH.state;
};
DBMsg["MailboxState\n"];
GetHandleInfo[];
IF oldState < userOK THEN {
DBMsg[IO.PutFR1["MailboxState %g\n", IO.card[ORD[msH.state]]]];
RETURN [oldState, oldState];
};
IF identity = NIL THEN ERROR; -- can't happen
FOR mbox: MBoxList ¬ mailboxes, mbox.rest WHILE mbox#NIL AND NOT msgs DO
down, empty, and msgs are set TRUE if they are TRUE for some server
SELECT GetServerState[identity, mbox.first, NIL] FROM
unknown => down ¬ TRUE;
empty => empty ¬ TRUE;
notEmpty => msgs ¬ TRUE;
ENDCASE;
ENDLOOP;
computedState ¬ SELECT TRUE FROM
msgs => notEmpty,
empty AND down => someEmpty,
down => allDown,
empty => allEmpty,
ENDCASE => unknown; -- No mailboxes?
DBMsg[IO.PutFR1["MailboxState %g\n", IO.card[ORD[msH.state]]]];
SetNewState[];
};
MailboxState: PUBLIC PROC [handle: Handle] RETURNS [state: MSRetrieve.MboxState] ~ { RETURN [MailboxStateInner[handle].newState] };
GetServerState: PROC [myID: XNSAuth.Identity, server: XNSCHName.Name, serverAddr: REF XNS.Address] RETURNS [state: MSRetrieve.ServerState ¬ unknown] ~ {
No ERRORs, returns unknown on failure.
rpcD: RPCData ¬ [NIL, NIL];
DoGetServerState: PROC ~ {
ENABLE UNWIND => PutRPCData[rpcD];
msgCount: Inbasket.State;
rpcD ¬ GetRPCData[myID, server, serverAddr];
msgCount ¬ Inbasket.MailPoll[rpcD.rpcH, XNSAuth.GetIdentityDetails[myID].name, GetCreds[rpcD], GetVerf[rpcD]];
state ¬ IF msgCount.total # 0 THEN notEmpty ELSE empty;
PutRPCData[rpcD];
};
CallEnabled[DoGetServerState ! Failed => CONTINUE];
};
NextServer: PUBLIC PROC [handle: Handle] RETURNS [noMore: BOOLEAN, state: MSRetrieve.ServerState] ~ {
Returns information about the next server in the mailbox site list of the user, and that server becomes the "current server". If there is no such server, noMore=TRUE, in which case the next call to "NextServer" will start a new sequence of mail retrieval. If the state is "unknown", attempting to access the mailbox is inadvisable, as the server is probably down. If the state is "empty", there may in fact be mail, as the state is only a hint obtained by polling.
ERRORs: Failed.
msH: MSHandle ¬ NARROW[handle];
DBMsg["NextServer\n"];
ReleaseSession[msH]; -- probably won't use it for awhile
msH.unreadMailboxes ¬ IF msH.unreadMailboxes = NIL THEN msH.mailboxes ELSE msH.unreadMailboxes.rest;
IF msH.unreadMailboxes = NIL
THEN {
msH.serviceAddr ¬ NIL;
msH.service ¬ [NIL, NIL, NIL];
DBMsg["NextServer noMore, unknown\n"];
RETURN [noMore: TRUE, state: unknown];
}
ELSE {
The order of the following two assignments is important because RefAddressFromName may raise an error ...
msH.serviceAddr ¬ RefAddressFromName[msH.unreadMailboxes.first];
msH.service ¬ msH.unreadMailboxes.first;
};
msH.msg ¬ Inbasket.nullIndex;
msH.msgsThisServer ¬ 0;
noMore ¬ FALSE;
state ¬ GetServerState[msH.identity, msH.service, msH.serviceAddr];
DBMsg[IO.PutFR1["NextServer %g\n", IO.rope[XNSCHName.RopeFromName[msH.service]]]];
};
ServerName: PUBLIC PROC [handle: Handle] RETURNS [MSBasics.CHName] ~ {
Provides the name of the current server. For MTP registries, this will be equivalent to the registry name.
msH: MSHandle ¬ NARROW[handle];
RETURN[ msH.service ];
};
AddMsgToList: PROC [thisMsg: CARD32, oldList: LIST OF Inbasket.Range] RETURNS [newList: LIST OF Inbasket.Range] ~ {
SELECT TRUE FROM
((oldList = NIL) OR (thisMsg > oldList.first.high+1)) =>
newList ¬ CONS[[low~thisMsg, high~thisMsg], oldList];
(thisMsg = oldList.first.high+1) =>
newList ¬ CONS[[low~oldList.first.low, high~thisMsg], oldList.rest];
thisMsg >= oldList.first.low =>
newList ¬ oldList;
ENDCASE =>
newList ¬ CONS[oldList.first, AddMsgToList[thisMsg, oldList.rest]];
};
NextMessage: PUBLIC PROC [handle: Handle]
RETURNS [msgExists, previouslyRead: BOOL ¬ FALSE] ~ {
Returns information about the next message in the mailbox, and that message becomes the "current message". If there is no such message, msgExists=FALSE. If previouslyRead=TRUE then the message is not new, i.e. it has been marked as being read.
ERRORs: Failure.
msH: MSHandle ¬ NARROW[handle];
rpcD: RPCData ¬ [NIL, NIL];
DoNextMessage: PROC ~ {
ENABLE UNWIND => { msH.msgList ¬ NIL; PutRPCData[rpcD] };
msgEnvelope: MailTransport.Envelope;
msgStatus: Inbasket.Status;
thisMsg: CARD32;
EstablishSession[msH];
rpcD ¬ GetRPCData[msH.identity, msH.service, msH.serviceAddr];
[msgEnvelope, msgStatus, thisMsg] ¬ Inbasket.RetrieveEnvelopes[rpcD.rpcH, msH.msg, next, msH.session];
msgExists ¬ thisMsg#Inbasket.nullIndex;
previouslyRead ¬ msgStatus.messageStatus.existenceOfMessage=known;
IF msgExists THEN {
msH.envelope ¬ MSUtils.ParseEnvelope[msgEnvelope];
IF HasAttachments[msH.envelope] THEN msH.msgWithAttachmentsList ¬ AddMsgToList[thisMsg, msH.msgWithAttachmentsList]
ELSE msH.msgList ¬ AddMsgToList[thisMsg, msH.msgList];
msH.msg ¬ thisMsg;
msH.tocIndex ¬ LAST[CARD32];
msH.msgsThisServer ¬ msH.msgsThisServer + 1;
};
PutRPCData[rpcD];
};
IF ( msH.msgsThisServer = maxMsgsPerSession ) THEN RETURN[FALSE, FALSE];
CallEnabled[DoNextMessage];
};
GetMessageEnvelope: PUBLIC PROC [handle: Handle] RETURNS [envelope: MSBasics.Envelope] ~ {
Retrieves the message's postmark, msgID, sender, etc.
msH: MSHandle ¬ NARROW[handle];
envelope ¬ msH.envelope;
};
NextBodyPart: PUBLIC PROC [handle: Handle] RETURNS [pb: MSBasics.BodyPartInfo] ~ {
Skips the remainder of any previous item, then delivers the header of the next item.
msH: MSHandle ¬ NARROW[handle];
msH.tocIndex ¬ msH.tocIndex + 1;
IF msH.tocIndex >= msH.envelope.toc.length THEN RETURN[[MSBasics.lastBodyPart, 0]];
pb ¬ msH.envelope.toc[msH.tocIndex];
};
GetBodyPart: PUBLIC PROC [handle: Handle] RETURNS [s: STREAM] ~ {
Provides an IO stream for reading the current item.
s ¬ IO.RIS[GetBodyPartAsRope[handle]];
};
GetBodyPartAsRope: PUBLIC PROC [handle: Handle] RETURNS [r: ROPE] ~ {
Provides the current item as a ROPE.
ReadBodyPart: MSRetrieve.GetBodyPartCallback = {
PROC [s: STREAM, checkAbort: PROC RETURNS [BOOL]] RETURNS [abort: BOOL]
text: Rope.Text ¬ Rope.NewText[MIN[maxText, bytesRemaining]];
pos: NAT ¬ 0;
bytesRead: NAT ¬ 0;
WHILE NOT IO.EndOf[s] DO
IF checkAbort[] THEN RETURN[TRUE];
TRUSTED {bytesRead ¬ IO.GetBlock[s, LOOPHOLE[text], pos, text.max]};
pos ¬ pos + bytesRead;
IF debugStrm # NIL THEN
debugStrm.PutF["bytesRead: %g, text.max: %g\n", [integer[bytesRead]], [integer[text.max]] ];
IF pos >= text.max THEN {
contents ¬ Rope.Concat[contents, text];
bytesRemaining ¬ bytesRemaining - pos;
IF bytesRemaining > 0 THEN text ¬ Rope.NewText[MIN[maxText, bytesRemaining]];
pos ¬ 0;
};
IF bytesRead = 0 AND NOT IO.EndOf[s] THEN Process.PauseMsec[200];
ENDLOOP;
RETURN[FALSE];
};
msH: MSHandle ¬ NARROW[handle];
bodyPartSize: INT ¬ msH.envelope.toc[msH.tocIndex].sizeInBytes;
maxText: INT ¬ 2048;
bytesRemaining: INT ¬ bodyPartSize;
contents: ROPE ¬ NIL;
GetBodyPartViaCallback[handle, ReadBodyPart];
IF bytesRemaining # 0 THEN ERROR Failed[$BrainDamagedServer, IO.PutFR["It said the item was %g bytes but it delivered %g bytes.", [integer[bodyPartSize]], [integer[contents.Length[]]] ] ];
r ¬ contents;
};
GetBodyPartViaCallback: PUBLIC PROC [handle: Handle, proc: MSRetrieve.GetBodyPartCallback] ~ {
Provides the current item via a Callback.
msH: MSHandle ¬ NARROW[handle];
rpcD: RPCData ¬ [NIL, NIL];
ReadBulkData: CrRPC.BulkDataSink = {
[h: CrRPC.Handle, s: STREAM, checkAbort: CrRPC.BulkDataCheckAbortProc] RETURNS [abort: BOOL]
userCheckAbort: PROC RETURNS [BOOL] ~ { RETURN[checkAbort[h]] };
RETURN[proc[s, userCheckAbort]];
};
DoGetBodyPartViaCallback: PROC ~ {
bodyPartSize: INT ¬ msH.envelope.toc[msH.tocIndex].sizeInBytes;
IF bodyPartSize > 0 THEN {
ENABLE UNWIND => PutRPCData[rpcD];
bodyParts: Inbasket.BodyPartSequence ¬ NEW[Inbasket.BodyPartSequenceObject[1]];
bodyParts[0] ¬ msH.tocIndex;
EstablishSession[msH];
rpcD ¬ GetRPCData[msH.identity, msH.service, msH.serviceAddr];
Inbasket.RetrieveBodyParts[rpcD.rpcH, msH.msg, bodyParts, ReadBulkData, msH.session];
PutRPCData[rpcD];
};
};
CallEnabled[DoGetBodyPartViaCallback];
};
MarkMessage: PUBLIC PROC [handle: Handle] ~ {
Marks current message as being read.
msH: MSHandle ¬ NARROW[handle];
rpcD: RPCData ¬ [NIL, NIL];
DoMarkMessage: PROC ~ {
ENABLE UNWIND => PutRPCData[rpcD];
range: Inbasket.Range ¬ [low: msH.msg, high: msH.msg];
EstablishSession[msH];
rpcD ¬ GetRPCData[msH.identity, msH.service, msH.serviceAddr];
Inbasket.ChangeMessageStatus[rpcD.rpcH, range, FALSE, 0, msH.session];
PutRPCData[rpcD];
};
CallEnabled[DoMarkMessage];
};
DeleteMessage: PUBLIC PROC [handle: Handle] ~ {
Deletes current message.
msH: MSHandle ¬ NARROW[handle];
rpcD: RPCData ¬ [NIL, NIL];
DoDeleteMessage: PROC ~ {
ENABLE UNWIND => PutRPCData[rpcD];
range: Inbasket.Range ¬ [low: msH.msg, high: msH.msg];
IF msH.msg = Inbasket.nullIndex THEN RETURN;
EstablishSession[msH];
rpcD ¬ GetRPCData[msH.identity, msH.service, msH.serviceAddr];
Inbasket.Delete[rpcD.rpcH, range, msH.session];
IF msH.msgList # NIL AND msH.msgList.first.high = msH.msg
THEN {
IF msH.msgList.first.low = msH.msg
THEN msH.msgList ¬ msH.msgList.rest
ELSE msH.msgList.first.high ¬ msH.msgList.first.high - 1;
}
ELSE ERROR Failed[$Delete, IO.PutFR["msH.msgList.first.high: %g, msH.msg: %g", [integer[msH.msgList.first.high]], [integer[msH.msg]] ] ]; -- something's inconsistent
PutRPCData[rpcD];
};
CallEnabled[DoDeleteMessage];
};
Accept: PUBLIC PROC [handle: Handle] ~ {
Flush the mailbox entirely (and irrecoverably).
msH: MSHandle ¬ NARROW[handle];
rpcD: RPCData ¬ [NIL, NIL];
DeleteMessages: PROC [msgList: LIST OF Inbasket.Range] ~ {
Note that we are intentionally deleting the oldest range first, the most recent last; just in case the mail server cares...
IF msgList = NIL THEN RETURN;
DeleteMessages[msgList.rest];
Inbasket.Delete[rpcD.rpcH, msgList.first, msH.session];
};
DoAccept: PROC ~ {
ENABLE UNWIND => PutRPCData[rpcD];
EstablishSession[msH];
rpcD ¬ GetRPCData[msH.identity, msH.service, msH.serviceAddr];
DeleteMessages[msH.msgList];
msH.msgList ¬ NIL;
IF UserProfile.Boolean["XNSMail.FlushMsgsWithAttachments", FALSE] THEN {
DeleteMessages[msH.msgWithAttachmentsList];
msH.msgWithAttachmentsList ¬ NIL;
};
msH.msg ¬ Inbasket.nullIndex;
PutRPCData[rpcD];
};
IF ( msH.msgList # NIL ) OR ( msH.msgWithAttachmentsList # NIL ) THEN CallEnabled[DoAccept];
};
HasAttachments: PROC[envelop: MSBasics.Envelope] RETURNS[yes: BOOL ¬ FALSE] = {
FOR i: CARD32 IN [0..envelop.toc.length) DO
SELECT envelop.toc[i].type FROM
MailBasicsItemTypes.vpFolder,
MailBasicsItemTypes.vpDocument,
MailBasicsItemTypes.otherNSFile,
MailBasicsItemTypes.interpress,
MailBasicsItemTypes.postscript => RETURN[TRUE];
MailBasicsItemTypes.nsTextFile =>
IF UserProfile.Boolean["XNSMail.nsTextFileAsFile", FALSE] THEN RETURN[TRUE];
ENDCASE;
ENDLOOP;
RETURN;
};
Errors
All errors raised by underlying protocols (Inbasket, Authentication, Clearinghouse) are turned into "Failed".
Failed: PUBLIC ERROR [why: MSRetrieve.FailureReason, text: ROPE] = CODE;
May be signalled by any of the procedures that handle messages.
CallEnabled: PROC [proc: PROC] ~ {
ENABLE {
CrRPC.Error => ReportRPCError[errorReason, text];
XNSAuth.AuthenticationError => ReportAuthenticationError[problem];
XNSAuth.CallError => ReportAuthCallError[problem];
Inbasket.AccessError => ReportAccessError[problem];
Inbasket.AuthenticationError => ReportAuthenticationError[problem];
Inbasket.InbasketInUse => ReportInbasketInUse[user];
Inbasket.IndexError => ReportIndexError[problem];
Inbasket.OtherError => ReportOtherError[problem];
Inbasket.ServiceError => ReportServiceError[problem];
Inbasket.SessionError => ReportSessionError[problem];
};
proc[];
};
Errors that can be raised by the Courier RPC runtime:
ReportRPCError: PROC [errorReason: CrRPC.ErrorReason, text: ROPE] = {
ERROR Failed[$RPC, text];
};
Errors that can be raised by Authentication:
ReportAuthCallError: PROC [problem: Authentication.CallProblem] = {
SELECT problem FROM
tooBusy => ERROR Failed[$Authentication, "server is too busy to service this request"];
accessRightsInsufficient => ERROR Failed[$Authentication, "operation prevented by access controls"];
keysUnavailable => ERROR Failed[$Authentication, "the server that holds the required keys was inaccessible"];
strongKeyDoesNotExist => ERROR Failed[$Authentication, "a strong key critical to this operation has not been registered"];
simpleKeyDoesNotExist => ERROR Failed[$Authentication, "a simple key critical to this operation has not been registered"];
strongKeyAlreadyRegistered => ERROR Failed[$Authentication, "cannot create a strong key for an entity which already has one"];
simpleKeyAlreadyRegistered => ERROR Failed[$Authentication, "cannot create a simple key for an entity which already has one"];
domainForNewKeyUnavailable => ERROR Failed[$Authentication, "cannot create a new key because the domain to hold it is inaccessible"];
domainForNewKeyUnknown => ERROR Failed[$Authentication, "cannot create a new key because the domain to hold it is unknown"];
badKey => ERROR Failed[$Authentication, "bad key passed to CreateStrongKey or ChangeStrongKey"];
badName => ERROR Failed[$Authentication, "bad name passed to CreateStrongKey or ChangeStrongKey"];
databaseFull => ERROR Failed[$Authentication, "no more data can be added to the Authentication database"];
other => ERROR Failed[$Authentication, "some unknown Authentication call problem"];
ENDCASE => ERROR;
};
ReportAuthenticationError: PROC [problem: Authentication.Problem] = {
SELECT problem FROM
credentialsInvalid => ERROR Failed[$Authentication, "credentials unacceptable"];
verifierInvalid => ERROR Failed[$Authentication, "verifier unacceptable"];
verifierExpired => ERROR Failed[$Authentication, "the verifier was too old"];
verifierReused => ERROR Failed[$Authentication, "the verifier has been used before"];
credentialsExpired => ERROR Failed[$Authentication, "the credentials have expired"];
inappropriateCredentials => ERROR Failed[$Authentication, "passed strong, wanted simple, or vice versa"];
ENDCASE => ERROR;
};
Errors that can be raised by the Inbasket protocol:
ReportAccessError: PROC [problem: Inbasket.AccessProblem] = {
SELECT problem FROM
accessRightsInsufficient => ERROR Failed[$Authentication, "the user doesn't have access"];
accessRightsIndeterminate => ERROR Failed[$Authentication, "cannot determine whether the user has access"];
noSuchInbasket => ERROR Failed[$Protocol, "no inbasket for this recipient"];
inbasketIndeterminate => ERROR Failed[$Protocol, "cannot resolve potential alias"];
wrongService => ERROR Failed[$Protocol, "mailbox does not reside on this service"];
ENDCASE => ERROR;
};
ReportSessionError: PROC [problem: Inbasket.SessionProblem] = {
SELECT problem FROM
tokenInvalid => ERROR Failed[$Protocol, "the Inbasket.Session is invalid"];
ENDCASE => ERROR;
};
ReportServiceError: PROC [problem: Inbasket.ServiceProblem] = {
SELECT problem FROM
cannotAuthenticate => ERROR Failed[$Service, "generally, an Authentication.CallProblem on the server"];
serviceFull => ERROR Failed[$Service, "no more operations of that type can be accepted"];
serviceUnavailable => ERROR Failed[$Service, "operations of that type are currently disabled"];
ENDCASE => ERROR;
};
ReportOtherError: PROC [problem: Inbasket.OtherProblem] = {
SELECT problem FROM
cantExpedite => ERROR Failed[$Protocol, "the operation cannot be expedited"];
malformedMessage => ERROR Failed[$Protocol, "the message bodyparts or other portions are malformed"];
invalidOperation => ERROR Failed[$Protocol, "the sequence of operations is invalid"];
ENDCASE => ERROR Failed[$Protocol, "unknown inbasket error"];
};
ReportIndexError: PROC [problem: Inbasket.IndexProblem] = {
SELECT problem FROM
invalidIndex => ERROR Failed[$Protocol, "the index doesn't name an existing message"];
invalidBodyPartIndex => ERROR Failed[$Protocol, "the index doesn't name an existing body part"];
ENDCASE => ERROR;
};
ReportInbasketInUse: PROC [user: XNSCHName.Name] = {
ERROR Failed[$Service, Rope.Concat["inbasket is currently in use by ", XNSCHName.RopeFromName[user]]];
};
Status change reports
Should do something about this in case a mail server wedges ... ajd
PollMboxStatus: PROC [msH: MSHandle] RETURNS [] ~ {
prevState, state: MSRetrieve.MboxState;
WHILE NOT msH.closed DO
[prevState, state] ¬ MailboxStateInner[msH];
IF msH.reportProc = NIL THEN ERROR; -- can't happen
msH.reportProc[state, msH]; -- always report the state
IF (state # prevState) AND (state > userOK) THEN {
IF msH.reportProc = NIL THEN ERROR; -- can't happen
msH.reportProc[state, msH];
};
Process.PauseMsec[1000*msH.pollingInterval];
ENDLOOP;
};
Mailboxes
GetMailboxes: PROC [name: XNSCHName.Name] RETURNS [mailboxes: MBoxList] = {
item: XNSCH.Item;
c: XNSCH.Conversation;
alreadyRetried: BOOL ¬ FALSE;
DBMsg[IO.PutFR1["GetMailboxes %g\n", IO.rope[XNSCHName.RopeFromName[name]]]];
DO
c ¬ XNSCH.InitiateConversation[];
item ¬ XNSCH.LookupItemProperty[c, name, CHEntries.mailboxes
! XNSCH.Error => CONTINUE ].item;
IF item # NIL THEN EXIT;
XNSCH.TerminateConversation[c];
IF alreadyRetried THEN RETURN[NIL];
alreadyRetried ¬ TRUE;
ENDLOOP;
mailboxes ¬ XNSCHItemOps.NameListFromItem[item, 2
! XNSCHItemOps.Error => CONTINUE].names;
XNSCH.TerminateConversation[c];
FOR each: MBoxList ¬ mailboxes, each.rest WHILE each # NIL DO
DBMsg[IO.PutFR1["GetMailboxes found %g\n", IO.rope[XNSCHName.RopeFromName[each.first]]]];
ENDLOOP;
};
END.