MailRetrieveImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Doug Terry, December 12, 1988 6:06:03 pm PST
Wes Irish, December 22, 1988 6:11:51 pm PST
Willie-sue, November 2, 1992 3:12 pm PST
Operations for retrieval of electronic mail messages. Modules register procs for particular mail services.
DIRECTORY
Ascii USING [Digit, Letter],
Convert USING [AppendTimeRFC822],
IO,
MailBasics,
MailBasicsItemTypes,
MailBasicsMoreItemTypes,
MailRetrieve,
MailUtils,
Process,
RefText,
Rope;
MailRetrieveImpl: CEDAR MONITOR
IMPORTS Ascii, Convert, IO, MailUtils, Process, RefText, Rope
EXPORTS MailRetrieve
~ BEGIN OPEN MailRetrieve;
STREAM: TYPE ~ IO.STREAM;
ROPE: TYPE ~ Rope.ROPE;
MailRetrieveProcsRef: TYPE ~ MailRetrieve.MailRetrieveProcsRef;
Handles
A RetrieveHandle allows clients to retrieval mail from one or more mailboxes on one or more different types of mail servers. Associated with each handle is a list of mailboxes. For each mailbox, there is a record that holds the information needed to interact with the mail service maintaining the appropriate mailbox.
mailHandles: LIST OF RetrieveHandle; -- all currently active mail handles
AnyMailBox: TYPE ~ REF AnyMailBoxObject;
AnyMailBoxObject: TYPE ~ RECORD[
procs: MailRetrieve.MailRetrieveProcsRef,
ref: REF
];
AnyMailBoxList: TYPE ~ LIST OF AnyMailBox;
RetrieveHandle: TYPE ~ REF RetrieveHandleObject;
RetrieveHandleObject: TYPE ~ RECORD [
mailboxes: AnyMailBoxList ¬ NIL,   -- list of GVInfo, MSInfo, etc.
pollingInterval: CARDINAL,   -- time between change reports
reportChangesProc: PROC [Handle, MBXState],  -- user provided procedure
lastReportedState: MBXState ¬ unknown,  -- last reported state
currentItem: STREAM ¬ NIL,   -- current item stream
unreadMailboxes: AnyMailBoxList ¬ NIL   -- mboxes being read
];
CreateHandle: PROC [] RETURNS [h: RetrieveHandle] ~ {
h ¬ NEW[RetrieveHandleObject];
mailHandles ¬ CONS[h, mailHandles];
};
DeleteHandle: PROC [h: RetrieveHandle] RETURNS [] ~ {
IF h = mailHandles.first
THEN mailHandles ¬ mailHandles.rest
ELSE FOR l: LIST OF RetrieveHandle ¬ mailHandles, l.rest WHILE l.rest#NIL DO
IF h = l.rest.first THEN { l.rest ¬ l.rest.rest; EXIT; };
ENDLOOP;
};
Exported procedures
Failed: PUBLIC ERROR [why: FailureReason, text: ROPE] = CODE;
May be signalled by any of the procedures that handle messages.
Create: PUBLIC PROC [pollingInterval: CARDINAL, reportChanges: PROC [Handle, MBXState] ¬ 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".
h: RetrieveHandle ¬ CreateHandle[];
h.pollingInterval ¬ pollingInterval;
h.reportChangesProc ¬ reportChanges;
RETURN[h];
};
Close: PUBLIC PROC [handle: Handle] RETURNS [] ~ {
Releases resources used by this handle. Further use of this handle is illegal.
WITH handle SELECT FROM h: RetrieveHandle => {
Close each mailbox
FOR ml: AnyMailBoxList ¬ h.mailboxes, ml.rest WHILE ml#NIL DO
ml.first.procs.Close[ml.first.ref];
ENDLOOP;
};
ENDCASE => ERROR;
};
NewUser: PUBLIC PROC [handle: Handle, user: MailBasics.RName, password: ROPE] ~ {
Provides new user name and password, and starts authentication and mailbox checking. This can be called several times to associate several mailboxes with the handle.
WITH handle SELECT FROM h: RetrieveHandle => {
thisBox: AnyMailBox ¬ NEW[AnyMailBoxObject];
thisBox.procs ¬ GetRegisteredRetrieveMailProcs[user.ns];
IF thisBox.procs = NIL THEN
ERROR Failed[$unregisteredMailProtocol, IO.PutFR1["%g not registered", [atom[user.ns]]] ];
thisBox.ref ¬ thisBox.procs.NewUser[handle, user, password, h.pollingInterval, ReportChangesProc];
h.mailboxes ¬ CONS[thisBox, h.mailboxes];
};
ENDCASE => ERROR;
};
MailboxState: PUBLIC PROC [handle: Handle] RETURNS [state: MBXState ¬ unknown] ~ {
Returns the current mailbox state. Will not return "unknown" or "userOK" (These change to "cantAuth" or "allDown" after suitable timeouts if necessary.)
WITH handle SELECT FROM h: RetrieveHandle => {
Check the state of each mailbox and combine them to form an overall state
FOR ml: AnyMailBoxList ¬ h.mailboxes, ml.rest WHILE ml#NIL DO
mboxState: MBXState;
mboxState ¬ ml.first.procs.MailboxState[ml.first.ref];
state ¬ MergeStates[state, mboxState];
ENDLOOP;
};
ENDCASE => ERROR;
};
NextServer: PUBLIC PROC [handle: Handle, reset: BOOLEAN ¬ FALSE]
RETURNS [noMore: BOOL ¬ TRUE, state: ServerState ¬ unknown, type: ServerType] ~ {
Returns information about the next server in the mailbox site list of the user (or the first server if reset=TRUE), 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.
WITH handle SELECT FROM h: RetrieveHandle => {
IF reset OR h.unreadMailboxes=NIL THEN -- start new sequence of mail retrieval
h.unreadMailboxes ¬ h.mailboxes;
WHILE h.unreadMailboxes #NIL DO
this: AnyMailBox = h.unreadMailboxes.first;
[noMore, state, type] ¬ this.procs.NextServer[this.ref];
IF noMore
THEN h.unreadMailboxes ¬ h.unreadMailboxes.rest -- try next mailbox if any
ELSE EXIT; -- return what we found
ENDLOOP;
};
ENDCASE => ERROR;
};
ServerName: PUBLIC PROC [handle: Handle] RETURNS [serverName: MailBasics.RName] ~ {
Provides the name of the current server. For MTP registries, this will be equivalent to the registry name.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [[NIL, NIL]];
RETURN[h.unreadMailboxes.first.procs.ServerName[h.unreadMailboxes.first.ref]];
};
ENDCASE => ERROR;
};
UserName: PUBLIC PROC [handle: Handle] RETURNS [userName: MailBasics.RName] ~ {
Provides the name of the current mailbox being accessed.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [[NIL, NIL]];
RETURN[h.unreadMailboxes.first.procs.UserName[h.unreadMailboxes.first.ref]];
};
ENDCASE => ERROR;
};
NextMessage: PUBLIC PROC [handle: Handle] RETURNS [msgExists, archived, deleted, read: BOOLEAN] ~ {
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 deleted=TRUE then the message is really just a placeholder and has been removed from the mailbox; you should not attempt to access the message. Returning archived=TRUE indicates that the message has been spilled to some file server, and accessing it is likely to be much slower. If read=TRUE then the message is not new, i.e. it has been previously marked as being read.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [FALSE, FALSE, FALSE, FALSE];
[msgExists, archived, deleted, read] ¬ h.unreadMailboxes.first.procs.NextMessage[h.unreadMailboxes.first.ref];
};
ENDCASE => ERROR;
};
StartMessage: PUBLIC PROC [handle: Handle] RETURNS [postmark: MailBasics.Timestamp, sender: MailBasics.RName, returnTo: MailBasics.RName] ~ {
Returns information from the envelope of the message.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [NIL, [NIL, NIL], [NIL, NIL]];
[postmark, sender, returnTo] ¬ h.unreadMailboxes.first.procs.StartMessage[h.unreadMailboxes.first.ref];
};
ENDCASE => ERROR;
};
NextItem: PUBLIC PROC [handle: Handle] RETURNS [MailBasics.ItemHeader] ~ {
Skips the remainder of any previous item, then delivers the header of the next item.
This implementation is responsible for mediating between the types of items that Grapevine returns and those that this interface returns; ditto for XNS mail body parts.
WITH handle SELECT FROM h: RetrieveHandle => {
ih: MailBasics.ItemHeader;
IF h.unreadMailboxes=NIL THEN RETURN [[type: MailBasicsItemTypes.lastItem, length: 0]];
[ih, h.currentItem] ¬ h.unreadMailboxes.first.procs.NextItem[h.unreadMailboxes.first.ref];
RETURN[ih];
};
ENDCASE => ERROR;
};
GetItem: PUBLIC PROC [handle: Handle] RETURNS [STREAM] ~ {
Provides an IO stream for reading the current item.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [NIL];
IF h.currentItem#NIL THEN RETURN[h.currentItem];
RETURN[h.unreadMailboxes.first.procs.GetItem[h.unreadMailboxes.first.ref]];
};
ENDCASE => ERROR;
};
GetItemAsRope: PUBLIC PROC [handle: Handle] RETURNS [ROPE] ~ {
Provides the current item as a ROPE.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [NIL];
IF h.currentItem#NIL THEN RETURN[MailUtils.RopeFromStream[h.currentItem]];
RETURN[h.unreadMailboxes.first.procs.GetItemAsRope[h.unreadMailboxes.first.ref]];
};
ENDCASE => ERROR;
};
GetItemViaCallback: PUBLIC PROC [handle: Handle, proc: MailRetrieve.GetItemCallback] ~ {
Provides the current item via a callback.
CheckForAbort: PROC RETURNS [BOOL] ~ {
RETURN[FALSE];
};
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN;
IF h.currentItem#NIL THEN {
[] ¬ proc[h.currentItem, CheckForAbort];
RETURN;
};
h.unreadMailboxes.first.procs.GetItemViaCallback[h.unreadMailboxes.first.ref, proc];
};
ENDCASE => ERROR;
};
MarkMessage: PUBLIC PROC [handle: Handle] RETURNS [] ~ {
Marks current message as being read.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [];
h.unreadMailboxes.first.procs.MarkMessage[h.unreadMailboxes.first.ref];
};
ENDCASE => ERROR;
};
DeleteMessage: PUBLIC PROC [handle: Handle] RETURNS [] ~ {
Deletes current message.
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [];
h.unreadMailboxes.first.procs.DeleteMessage[h.unreadMailboxes.first.ref];
};
ENDCASE => ERROR;
};
Accept: PUBLIC PROC [handle: Handle] RETURNS [] ~ {
Flush the mailbox entirely (and irrecoverably).
WITH handle SELECT FROM h: RetrieveHandle => {
IF h.unreadMailboxes=NIL THEN RETURN [];
h.unreadMailboxes.first.procs.Accept[h.unreadMailboxes.first.ref];
};
ENDCASE => ERROR;
};
ReportChangesProc: PROC[handle: Handle, state: MBXState] = {
callback proc from registered retrieveMailProcs
WITH handle SELECT FROM h: RetrieveHandle => {
h.lastReportedState ¬ state;
IF h.reportChangesProc # NIL THEN
TRUSTED { Process.Detach[ FORK h.reportChangesProc[h, state] ]; };
};
ENDCASE => ERROR;
};
Intelligible: PROC[timeStamp: MailBasics.Timestamp, sender: ROPE] RETURNS[ROPE] = {
nameCount: INT ¬ 0;
timeBuf.length ¬ 0;
FOR i: INT IN [0..sender.Length[]) DO
c: CHAR = sender.Fetch[i];
IF ~(Ascii.Letter[c] OR Ascii.Digit[c]) THEN LOOP;
timeBuf ¬ RefText.AppendChar[timeBuf, c];
IF (nameCount ¬ nameCount + 1) >= 8 THEN EXIT;
ENDLOOP;
timeBuf ¬ RefText.AppendChar[timeBuf, '-]; -- after name
timeBuf ¬ Convert.AppendTimeRFC822[timeBuf, MailUtils.GetTimeFromPostmark[timeStamp]];
FOR i: NAT IN [0..timeBuf.length) DO
SELECT timeBuf[i] FROM
' , '\t => timeBuf[i] ¬ '-;
': => timeBuf[i] ¬ '.;
ENDCASE;
ENDLOOP;
RETURN[Rope.FromRefText[timeBuf]];
};
timeBuf: REF TEXT ¬ NEW[TEXT[RefText.line]];
Registration
retrieveProcsList: LIST OF MailRetrieveProcsRef ¬ NIL;
RegisterMailRetrieveProcs: PUBLIC ENTRY PROC [procs: MailRetrieveProcsRef] = {
retrieveProcsList ¬ CONS[procs, retrieveProcsList];
};
GetRegisteredRetrieveProcsList: PUBLIC ENTRY PROC RETURNS [LIST OF MailRetrieveProcsRef] = {
RETURN [ retrieveProcsList ];
};
GetRegisteredRetrieveMailProcs: PUBLIC ENTRY PROC[which: ATOM]
RETURNS [MailRetrieveProcsRef] = {
FOR rL: LIST OF MailRetrieveProcsRef ¬ retrieveProcsList, rL.rest UNTIL rL = NIL DO
IF rL.first.which = which THEN RETURN[rL.first];
ENDLOOP;
RETURN[NIL];
};
The following table takes an existing state and a new state and gives a combined state that results from merging the two. The rules for merging states is as follows:
- bad news (badName, badPwd, cantAuth) always wins
- no news (unknown, userOK) always loses
- notEmpty wins over any other definite news
- someEmpty wins over allDown or allEmpty
stateCombiningTable: ARRAY MBXState OF ARRAY MBXState OF MBXState = [
[ unknown, badName, badPwd, cantAuth, userOK, allDown, someEmpty, allEmpty, notEmpty ] ,
[ badName, badName, badName, badName, badName, badName, badName, badName, badName ] ,
[ badPwd, badName, badPwd, badPwd, badPwd, badPwd, badPwd, badPwd, badPwd ] ,
[ cantAuth, badName, badPwd, cantAuth, cantAuth, cantAuth, cantAuth, cantAuth, cantAuth ] ,
[ userOK, badName, badPwd, cantAuth, userOK, allDown, someEmpty, allEmpty, notEmpty ] ,
[ allDown, badName, badPwd, cantAuth, allDown, allDown, someEmpty, someEmpty, notEmpty ] ,
[ someEmpty, badName, badPwd, cantAuth, someEmpty, someEmpty, someEmpty, someEmpty, notEmpty ] ,
[ allEmpty, badName, badPwd, cantAuth, allEmpty, someEmpty, someEmpty, allEmpty, notEmpty ] ,
[ notEmpty, badName, badPwd, cantAuth, notEmpty, notEmpty, notEmpty, notEmpty, notEmpty ]
];
MergeStates: PROC [state, new: MBXState] RETURNS [combined: MBXState] ~ {
combined ¬ stateCombiningTable[state][new];
};
END.