-- Transport Mechanism Mail Server - Mailbox management --
-- [Indigo]<Grapevine>MS>MailboxAlloc.mesa
-- Andrew Birrell September 14, 1982 2:14 pm
-- Randy Gobbel 19-May-81 20:47:16
-- Mark Johnson 19-May-81 13:43:58
DIRECTORY
Ascii USING[ CR, TAB ],
BitMapDefs USING[ Map, FindFree, Clear, Test, Set ],
BodyDefs USING[ ItemHeader, ItemLength, maxRNameLength, oldestTime,
PackedTime, RName, RNameSize, Timestamp],
BTreeDefs USING[ BTreeHandle, Call, Delete, EnumerateFrom, Insert,
Lookup ],
EnquiryDefs USING[ Handle ],
HeapDefs USING[ GetReaderOffset, HeapAbandonWrite, HeapEndRead,
HeapEndWrite,
HeapReadData, HeapReadRName, HeapStartRead,
HeapStartWrite, HeapWriteData, HeapWriteRName,
ObjectNumber, ReaderHandle, ReadItemHeader, SendObj,
SetReaderOffset, WriterHandle ],
Inline USING[ COPY ],
LogDefs USING[ DisplayNumber, WriteChar, WriteLogEntry,
WriteString ],
MailboxDefs,
ObjectDirDefs USING[ noObject, FreeObject, UseObject ],
PolicyDefs USING[ ArchiverPause, EndOperation, WaitOperation ],
Process USING[ InitializeMonitor ],
ProtocolDefs USING[ AppendTimestamp, Handle, Remark, SendItemHeader,
SendTimestamp ],
ReturnDefs USING[ CopyItem ],
SLDefs USING[ SLHeader, SLWrite ],
SpillDefs USING[ AddBody, ArchReader, CopyBody,
CopyText, Delete, DeleteEntry, EndWrite, EndReading,
OpenToRead, RecoverBody, ServerCrash,
StartWrite, TestDeletion ],
String USING[ AppendDecimal, AppendString, LowerCase ],
Storage USING[ Node ],
Time USING[ Append, Current, Unpack ],
VMDefs USING[ Page, ReadPage, UsePage, PageNumber,
PageIndex, Release, FileHandle, MarkStartWait,
LookAheadCount ];
MailboxAlloc: MONITOR
IMPORTS BitMapDefs, BodyDefs, BTreeDefs, HeapDefs, Inline, LogDefs,
ObjectDirDefs, PolicyDefs, Process, ProtocolDefs,
ReturnDefs, SLDefs, SpillDefs,
String, Storage, Time, VMDefs
EXPORTS EnquiryDefs, MailboxDefs
SHARES MailboxDefs =
BEGIN
Allocate: PROCEDURE[CARDINAL]RETURNS[POINTER] = Storage.Node;
MBXName: TYPE = VMDefs.PageNumber;
MBXHandle: PUBLIC TYPE = POINTER TO MBXData;
-- representation of state of mailbox reading --
MBXData: TYPE = MONITORED RECORD[
lock: MBXName, -- page number for mailbox interlock bit --
latest: MBXName, --address of latest page of mbx--
where: MBXName, --address of this page--
current: CARDINAL, --number of next page to be read--
messages: DESCRIPTOR FOR ARRAY OF HeapDefs.ObjectNumber, --messages in this page--
nextMsg: CARDINAL, -- index into array of messages --
object: HeapDefs.ObjectNumber, -- current element of "messages" --
bodyObj: HeapDefs.ObjectNumber, --"object" without TOC indirection --
archObj: HeapDefs.ObjectNumber, -- current "archived" object --
archCount: CARDINAL, -- count relative to start of archive file --
archFile: SpillDefs.ArchReader,
archOpen: BOOLEAN,
remainder: CARDINAL, -- number of messages left in the mailbox --
next: MBXHandle, -- for free chain of 'MBXData's--
page: VMDefs.Page --current page buffer--];
-- header in disk representation of each mailbox page --
MBXHeader: TYPE = RECORD[
chain: MBXName, --previous MBX page of this MBX--
first: VMDefs.PageIndex, --first entry in this page--
free: VMDefs.PageIndex,
number: CARDINAL --page number within this MBX-- ];
MBXEnd: MBXHandle = NIL;
MBXChain: MBXHandle ← MBXEnd;
handle: VMDefs.FileHandle;
lookAhead: VMDefs.LookAheadCount = 0;
pageMap: BitMapDefs.Map;
mailboxes: CARDINAL ← 0;
-- punning for R-Names --
RNameDesc: PROCEDURE[ name: BodyDefs.RName ]
RETURNS[ DESCRIPTOR FOR ARRAY OF WORD ] =
BEGIN
index: CARDINAL;
FOR index IN [0 .. name.length)
DO name[index] ← String.LowerCase[name[index]] ENDLOOP;
IF name.length MOD 2 # 0 THEN name[name.length] ← '@;
RETURN[ DESCRIPTOR[ @(name.text), (1+name.length)/2 ] ]
END;
-- Management of Btree entries --
tree: BTreeDefs.BTreeHandle;
TreeRec: TYPE = RECORD[SELECT t: * FROM
found => [where, lock: MBXName,
oldest: BodyDefs.Timestamp],
empty => [last: BodyDefs.Timestamp],
ENDCASE];
FindInTree: INTERNAL PROCEDURE[ who: BodyDefs.RName ] RETURNS[ TreeRec ] =
BEGIN
value: TreeRec;
length:CARDINAL = BTreeDefs.Lookup[tree,
RNameDesc[who],
DESCRIPTOR[@value,SIZE[TreeRec]] ];
IF length=177777B
THEN -- not in tree --
RETURN[ [empty[BodyDefs.oldestTime]] ]
ELSE RETURN[value]
END;
ChangeInTree: INTERNAL PROCEDURE[ who: BodyDefs.RName,
where, lock: MBXName,
oldest: BodyDefs.Timestamp ] =
BEGIN
value: TreeRec ← [found[where:where, lock:lock, oldest:oldest]];
BTreeDefs.Insert[tree,
RNameDesc[who],
DESCRIPTOR[@value,SIZE[TreeRec]] ];
END;
EmptyInTree: ENTRY PROCEDURE[ who: BodyDefs.RName,
last: BodyDefs.Timestamp ] =
BEGIN
value: TreeRec ← [empty[last]];
BTreeDefs.Insert[tree,
RNameDesc[who],
DESCRIPTOR[@value,SIZE[TreeRec]] ];
mailboxes ← mailboxes - 1;
END;
PurgeFromTree: ENTRY PROCEDURE[ who: BodyDefs.RName] =
BEGIN
value: TreeRec = FindInTree[who];
WITH value SELECT FROM
empty => BTreeDefs.Delete[tree, RNameDesc[who] ];
ENDCASE => NULL -- someone else may have reinstated it --;
END;
EnumerateTree: ENTRY PROC[ work: PROC[BodyDefs.RName,found TreeRec] ] =
BEGIN
-- beware: calls "work" with the monitor locked --
Action: INTERNAL BTreeDefs.Call =
BEGIN
value: POINTER TO TreeRec = LOOPHOLE[BASE[v]];
name: BodyDefs.RName = [BodyDefs.maxRNameLength];
more ← TRUE; dirty ← FALSE; -- results of "Action" --
IF LENGTH[k] = 0 THEN RETURN;
name.length ← 2 * LENGTH[k];
Inline.COPY[from:BASE[k], to:@(name.text), nwords:LENGTH[k]];
IF name.length > 0 AND name[name.length-1] = '@
THEN name.length ← name.length-1 -- undo padding kludge --;
WITH res: value SELECT FROM
found => work[name, res];
ENDCASE => NULL;
END;
BTreeDefs.EnumerateFrom[tree, DESCRIPTOR[NIL,0], Action !
UNWIND => NULL];
END;
-- Interlocks on mailboxes --
-- the lock map is used for single writer/multiple reader synchronization
-- Any potential writer tests the lock; readers claim it. Both always
-- have the monitor lock while doing this.
lockMap: BitMapDefs.Map;
conflictMap: BitMapDefs.Map;
MBXFree: CONDITION;
AcquireMBX: INTERNAL PROCEDURE[ who: BodyDefs.RName ]
RETURNS[ found: BOOLEAN, mbx, lock: MBXName ] =
BEGIN
DO value: TreeRec = FindInTree[who];
WITH res: value SELECT FROM
empty => { found ← FALSE; EXIT };
found =>
IF LockedMBX[res.lock]
THEN WAIT MBXFree
ELSE BEGIN
found←TRUE; mbx←res.where; lock ← res.lock;
BitMapDefs.Set[lockMap, lock];
EXIT
END;
ENDCASE => ERROR;
ENDLOOP;
END;
LockedMBX: INTERNAL PROCEDURE[ lock: MBXName ] RETURNS[locked: BOOLEAN] =
BEGIN
locked ← BitMapDefs.Test[lockMap, lock];
IF locked THEN BitMapDefs.Set[conflictMap, lock];
END;
FreeMBX: INTERNAL PROCEDURE[ lock: MBXName ] =
BEGIN
BitMapDefs.Clear[lockMap, lock];
IF BitMapDefs.Test[conflictMap, lock]
THEN { BitMapDefs.Clear[conflictMap, lock]; NoteUnlocked[] };
BROADCAST MBXFree;
END;
unlockedMBX: BOOLEAN ← TRUE;
unlockedMBXCond: CONDITION;
WaitForUnlocked: PUBLIC ENTRY PROC =
BEGIN
UNTIL unlockedMBX DO WAIT unlockedMBXCond ENDLOOP;
unlockedMBX ← FALSE;
END;
NoteUnlocked: INTERNAL PROC = INLINE
{ unlockedMBX ← TRUE; NOTIFY unlockedMBXCond };
-- Access to mailboxes --
nextVirginPage: VMDefs.PageNumber; -- size of mailbox file --
WrongNewMBXPage: ERROR = CODE;
mailboxContents: LONG CARDINAL ← 0;
MBXWrite: PUBLIC ENTRY PROCEDURE[ who: BodyDefs.RName,
obj: HeapDefs.ObjectNumber,
postmark: BodyDefs.Timestamp ]
RETURNS[ done: BOOLEAN ] =
BEGIN
ENABLE UNWIND => NULL;
addPage: BOOLEAN ← FALSE;
page: VMDefs.Page;
header: POINTER TO MBXHeader;
number: CARDINAL; -- number of a new page within this mailbox --
mbx: TreeRec = FindInTree[who: who];
WITH tree:mbx SELECT FROM
empty =>
BEGIN
IF tree.last = postmark
THEN { LogDefs.WriteChar['E]; LogDefs.WriteChar['!];
RETURN[TRUE] --duplicate-- };
number ← 0; addPage ← TRUE;
-- no interlock to check --
END;
found =>
BEGIN
page ← VMDefs.ReadPage[[handle,tree.where], lookAhead ];
header ← LOOPHOLE[page,POINTER]+FIRST[VMDefs.PageIndex];
IF header.first # header.free
THEN -- test for duplicate elimination --
BEGIN
x: POINTER TO HeapDefs.ObjectNumber = LOOPHOLE[page,POINTER] +
header.free-SIZE[HeapDefs.ObjectNumber];
IF x↑ = obj
THEN BEGIN
VMDefs.Release[page];
LogDefs.WriteChar['E];
RETURN[TRUE] --duplicate--
END;
END;
IF LockedMBX[tree.lock]
THEN BEGIN
VMDefs.Release[page];
RETURN[FALSE]
END
--ELSE we are protected by our monitor lock --;
IF header.free+SIZE[HeapDefs.ObjectNumber] > LAST[VMDefs.PageIndex]
THEN -- will need to expand to another page --
BEGIN
number ← header.number + 1;
VMDefs.Release[page];
addPage ← TRUE;
END;
IF tree.oldest = BodyDefs.oldestTime AND NOT addPage
THEN ChangeInTree[who: who,
where: tree.where, lock: tree.lock,
oldest: postmark];
END;
ENDCASE => ERROR;
IF addPage
THEN BEGIN -- create and initialise new page of mailbox --
desc: DESCRIPTOR FOR ARRAY OF WORD =
DESCRIPTOR[who, BodyDefs.RNameSize[who] ];
new: MBXName = BitMapDefs.FindFree[pageMap];
IF new >= nextVirginPage
THEN IF new > nextVirginPage
THEN ERROR WrongNewMBXPage[]
ELSE nextVirginPage ← nextVirginPage+1;
BitMapDefs.Set[pageMap,new];
WITH tree:mbx SELECT FROM
empty => BEGIN
ChangeInTree[who: who,
where: new, lock: new,
oldest: postmark];
mailboxes ← mailboxes + 1;
END;
found => ChangeInTree[who: who,
where: new, lock: tree.lock,
oldest: IF tree.oldest = BodyDefs.oldestTime
THEN postmark ELSE tree.oldest];
ENDCASE => ERROR;
page ← VMDefs.UsePage[[handle,new]];
header ← LOOPHOLE[page,POINTER]+FIRST[VMDefs.PageIndex];
header.free ← FIRST[VMDefs.PageIndex] + SIZE[MBXHeader];
Inline.COPY[BASE[desc],LENGTH[desc],page+header.free];
header.first ← header.free ← header.free+LENGTH[desc];
header.chain ← WITH tree:mbx SELECT FROM found=>tree.where,
ENDCASE=>new -- end-of-chain --;
header.number ← number;
END;
BEGIN
x: POINTER TO HeapDefs.ObjectNumber =
LOOPHOLE[page,POINTER]+header.free;
x↑ ← obj;
END;
header.free ← header.free + SIZE[HeapDefs.ObjectNumber];
ObjectDirDefs.UseObject[obj];
mailboxContents ← mailboxContents + 1; -- global count --
VMDefs.MarkStartWait[ page ];
VMDefs.Release[ page ];
RETURN[TRUE]
END;
FreeMBXPage: ENTRY PROC[page: MBXName] =
{ BitMapDefs.Clear[pageMap, page] };
Poll: PUBLIC ENTRY PROCEDURE[ who: BodyDefs.RName ]
RETURNS[found: BOOLEAN ] =
BEGIN
value: TreeRec = FindInTree[who];
found ← WITH value SELECT FROM found => TRUE, ENDCASE => FALSE;
END;
Open: PUBLIC ENTRY PROCEDURE[ who: BodyDefs.RName ]
RETURNS[found: BOOLEAN, count: CARDINAL,
mbx: MBXHandle] =
BEGIN
IF MBXChain = MBXEnd
THEN mbx ← Allocate[SIZE[MBXData]]
ELSE BEGIN mbx ← MBXChain; MBXChain ← MBXChain.next END;
[found, mbx.latest, mbx.lock] ← AcquireMBX[who: who];
IF found
THEN BEGIN
Process.InitializeMonitor[@mbx.LOCK]; SetupMBX[mbx];
count ← mbx.remainder;
END
ELSE BEGIN
LogAction[who, nothing];
mbx.next ← MBXChain; MBXChain ← mbx;
count ← 0; mbx ← NIL;
END;
END;
Destroy: ENTRY PROC[mbx: MBXHandle] =
BEGIN
VMDefs.Release[mbx.page];
FreeMBX[mbx.lock];
mbx.next ← MBXChain; MBXChain ← mbx;
END;
RestartMBX: PROC[mbx: MBXHandle] =
BEGIN
-- re-positions to start of mailbox without releasing lock --
CloseArch[mbx];
VMDefs.Release[mbx.page];
SetupMBX[mbx];
END;
SetupMBX: PROC[mbx: MBXHandle] =
BEGIN
mbx.current ← 0;
mbx.page ← VMDefs.ReadPage[[handle,mbx.where←mbx.latest],lookAhead];
mbx.remainder ← GetPage[mbx];
mbx.archObj ← ObjectDirDefs.noObject;
mbx.archOpen ← FALSE;
END;
GetPage: PROCEDURE[ mbx: MBXHandle ] RETURNS[ count: CARDINAL ] =
BEGIN
header: POINTER TO MBXHeader;
count ← 0;
IF mbx.where # mbx.latest
THEN BEGIN -- finish with previous page --
VMDefs.Release[mbx.page];
mbx.page ←
VMDefs.ReadPage[[handle,mbx.where←mbx.latest],lookAhead];
END;
DO BEGIN
header ← LOOPHOLE[mbx.page,POINTER] + FIRST[VMDefs.PageIndex];
count ← count + (header.free-header.first)/SIZE[HeapDefs.ObjectNumber];
IF header.number = mbx.current THEN EXIT;
BEGIN
next: MBXName = header.chain; -- that store is about to go --
VMDefs.Release[mbx.page];
mbx.where ← next;
END;
mbx.page ← VMDefs.ReadPage[ [handle,mbx.where], lookAhead ];
END;
ENDLOOP;
mbx.messages ← DESCRIPTOR[mbx.page+header.first,
(header.free-header.first)/SIZE[HeapDefs.ObjectNumber] ];
mbx.nextMsg ← 0; mbx.current ← mbx.current+1;
END;
NextMessage: PUBLIC PROC[ mbx: MBXHandle ]
RETURNS[ msgExists, archived, deleted: BOOLEAN ] =
{ [msgExists, archived, deleted] ← RealNextMessage[mbx, yes] };
RealNextMessage: PROC[ mbx: MBXHandle, testArchDeletion: {yes, no} ]
RETURNS[ msgExists, archived, deleted: BOOLEAN ] =
BEGIN
IF mbx.remainder = 0 THEN RETURN[ FALSE, FALSE, FALSE ];
IF mbx.nextMsg = LENGTH[mbx.messages] THEN [] ← GetPage[mbx];
IF LENGTH[mbx.messages] = 0 THEN ERROR;
mbx.nextMsg ← mbx.nextMsg + 1;
mbx.remainder ← mbx.remainder - 1;
mbx.object ← mbx.messages[mbx.nextMsg-1];
mbx.bodyObj ← GetBodyObj[mbx.object];
archived ← (mbx.bodyObj.type = archived);
IF archived
THEN BEGIN
ENABLE
BEGIN
SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
UNWIND => mbx.archOpen ← FALSE;
END;
IF mbx.bodyObj = mbx.archObj
THEN mbx.archCount ← mbx.archCount + 1
ELSE { CloseArch[mbx]; mbx.archObj ← mbx.bodyObj;
mbx.archCount ← 0 };
IF testArchDeletion = yes
THEN BEGIN
OpenArch[mbx]; -- for deletion test! --
deleted ← SpillDefs.TestDeletion[mbx.archFile, mbx.archCount];
END
ELSE deleted ← FALSE --don't care--
END
ELSE BEGIN
deleted ← (mbx.bodyObj = ObjectDirDefs.noObject);
IF NOT deleted -- deleted msgs were skipped when archiving --
THEN { CloseArch[mbx]; mbx.archObj ← ObjectDirDefs.noObject };
END;
msgExists ← TRUE;
END;
ReadTOC: PUBLIC PROC[ mbx: MBXHandle, text: ProtocolDefs.Remark ] =
BEGIN
IF mbx.object.type # TOC
THEN text.length ← 0
ELSE BEGIN
reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[mbx.object];
obj: HeapDefs.ObjectNumber;
[] ← HeapDefs.HeapReadData[reader,
[@obj,SIZE[HeapDefs.ObjectNumber] ] ];
--CHEAT-- [] ← HeapDefs.HeapReadRName[reader, text];
HeapDefs.HeapEndRead[reader];
END;
END;
GetBodyObj: PROC[given: HeapDefs.ObjectNumber]
RETURNS[body: HeapDefs.ObjectNumber] =
BEGIN
IF given.type = TOC
THEN BEGIN
tocReader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[given];
[] ← HeapDefs.HeapReadData[tocReader,
[@body,SIZE[HeapDefs.ObjectNumber] ] ];
HeapDefs.HeapEndRead[tocReader];
END
ELSE body ← given;
END;
InaccessibleArchive: PUBLIC ERROR = CODE;
SendBody: PUBLIC PROC[ mbx: MBXHandle, str: ProtocolDefs.Handle ] =
BEGIN
IF mbx.bodyObj.type = archived
THEN BEGIN
ENABLE
BEGIN
SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
UNWIND => mbx.archOpen ← FALSE;
END;
OpenArch[mbx];
SpillDefs.CopyBody[mbx.archFile, mbx.archCount, str];
CountArchived[];
END
ELSE BEGIN
reader: HeapDefs.ReaderHandle =
HeapDefs.HeapStartRead[mbx.bodyObj];
header: BodyDefs.ItemHeader = HeapDefs.ReadItemHeader[reader];
postmark: BodyDefs.Timestamp;
IF header.type # PostMark THEN ERROR;
[] ← HeapDefs.HeapReadData[reader,
[@postmark,SIZE[BodyDefs.Timestamp]]];
ConsiderDelay[postmark];
ProtocolDefs.SendItemHeader[str, header];
ProtocolDefs.SendTimestamp[str, postmark];
HeapDefs.SendObj[reader, str];
END;
END;
SendText: PUBLIC PROC[ mbx: MBXHandle,
sendLength: PROC[BodyDefs.ItemLength],
str: UNSPECIFIED,
sendBytes: PROC[UNSPECIFIED,POINTER,CARDINAL] ] =
BEGIN
IF mbx.bodyObj.type = archived
THEN BEGIN
ENABLE
BEGIN
SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
UNWIND => mbx.archOpen ← FALSE;
END;
OpenArch[mbx];
SpillDefs.CopyText[mbx.archFile, mbx.archCount,
sendLength, str, sendBytes];
CountArchived[];
END
ELSE BEGIN
reader: HeapDefs.ReaderHandle =
HeapDefs.HeapStartRead[mbx.bodyObj];
DO ENABLE UNWIND => HeapDefs.HeapEndRead[reader];
header: BodyDefs.ItemHeader = HeapDefs.ReadItemHeader[reader];
SELECT header.type FROM
PostMark =>
BEGIN
postmark: BodyDefs.Timestamp;
[] ← HeapDefs.HeapReadData[reader,
[@postmark,SIZE[BodyDefs.Timestamp]]];
ConsiderDelay[postmark];
END;
Text =>
BEGIN
sendLength[header.length];
ReturnDefs.CopyItem[reader, header.length, sendBytes, str];
EXIT
END;
LastItem => EXIT --no text--;
ENDCASE => HeapDefs.SetReaderOffset[reader,
HeapDefs.GetReaderOffset[reader] + (header.length+1)/2 ];
ENDLOOP;
HeapDefs.HeapEndRead[reader];
END;
END;
OpenArch: PROC[ mbx: MBXHandle ] =
BEGIN
IF NOT mbx.archOpen
THEN BEGIN
mbx.archFile ← SpillDefs.OpenToRead[mbx.archObj];
mbx.archOpen ← TRUE;
END;
END;
CloseArch: PROC[ mbx: MBXHandle ] =
BEGIN
IF mbx.archOpen
THEN SpillDefs.EndReading[mbx.archFile !
SpillDefs.ServerCrash => CONTINUE];
mbx.archOpen ← FALSE;
END;
WriteTOC: PUBLIC PROC[ mbx: MBXHandle, text: ProtocolDefs.Remark ] =
BEGIN
Accept: PROC[obj: HeapDefs.ObjectNumber] =
BEGIN
ObjectDirDefs.UseObject[obj];
mbx.messages[mbx.nextMsg-1] ← obj;
VMDefs.MarkStartWait[mbx.page];
IF mbx.object.type = TOC THEN ObjectDirDefs.FreeObject[mbx.object];
mbx.object ← obj;
END;
body: HeapDefs.ObjectNumber ← mbx.bodyObj;
IF text.length = 0
THEN BEGIN
-- no TOC required --
IF mbx.object.type = TOC
THEN { Accept[body]; ObjectDirDefs.FreeObject[body] };
END
ELSE BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[TOC];
HeapDefs.HeapWriteData[writer, [@body,SIZE[HeapDefs.ObjectNumber] ] ];
--CHEAT-- HeapDefs.HeapWriteRName[writer, text];
HeapDefs.HeapEndWrite[writer, Accept];
END;
END;
DeleteMessage: PUBLIC PROC[ mbx: MBXHandle ] =
BEGIN
IF mbx.bodyObj.type=archived
THEN BEGIN
ENABLE
BEGIN
SpillDefs.ServerCrash => ERROR InaccessibleArchive[];
UNWIND => mbx.archOpen ← FALSE;
END;
IF mbx.object.type = TOC
THEN BEGIN
mbx.messages[mbx.nextMsg-1] ← mbx.bodyObj;
VMDefs.MarkStartWait[mbx.page];
END;
OpenArch[mbx];
SpillDefs.DeleteEntry[mbx.archFile, mbx.archCount];
END
ELSE BEGIN
mbx.messages[mbx.nextMsg-1] ← ObjectDirDefs.noObject;
VMDefs.MarkStartWait[mbx.page];
ObjectDirDefs.FreeObject[mbx.bodyObj];
mbx.bodyObj ← ObjectDirDefs.noObject;
END;
IF mbx.object.type = TOC
THEN BEGIN
ObjectDirDefs.FreeObject[mbx.object];
mbx.object ← mbx.bodyObj;
END;
END;
Close: PUBLIC PROCEDURE[ mbx: MBXHandle ] =
BEGIN
LogAction[LOOPHOLE[mbx.page,POINTER]+
FIRST[VMDefs.PageIndex]+SIZE[MBXHeader], no];
InnerClose[mbx];
END;
InnerClose: PROC[ mbx: MBXHandle ] =
BEGIN
CloseArch[mbx];
Destroy[mbx];
END;
ReadPostmark: PROC[body: HeapDefs.ObjectNumber]
RETURNS[postmark: BodyDefs.Timestamp] =
BEGIN
reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[body];
header: BodyDefs.ItemHeader = HeapDefs.ReadItemHeader[reader];
IF header.type # PostMark THEN ERROR;
[] ← HeapDefs.HeapReadData[reader, [@postmark,SIZE[BodyDefs.Timestamp]]];
HeapDefs.HeapEndRead[reader];
END;
FlushAndClose: PUBLIC PROCEDURE[ mbx: MBXHandle ] =
BEGIN
-- Beware: this procedure works without the monitor lock, because there
-- may be unbounded delays while we delete archive files. The order of
-- events is quite important! We must also take care that everything
-- will look ok if we crash in the middle of flushing a multi-page
-- mailbox.
buffer: DESCRIPTOR FOR ARRAY OF HeapDefs.ObjectNumber;
base: VMDefs.PageIndex = FIRST[VMDefs.PageIndex];
header: POINTER TO MBXHeader ← LOOPHOLE[mbx.page,POINTER]+base;
msgCount: CARDINAL ← 0;
archiveFailure: BOOLEAN ← FALSE;
lastPost: BodyDefs.Timestamp ← BodyDefs.oldestTime;
-- postmark of latest message --
DeleteArch: PROC = -- delete archive file --
BEGIN
IF mbx.archObj # ObjectDirDefs.noObject
THEN BEGIN
SpillDefs.Delete[mbx.archObj ! SpillDefs.ServerCrash =>
{ archiveFailure←TRUE; CONTINUE } ];
ObjectDirDefs.FreeObject[mbx.archObj];
mbx.archObj ← ObjectDirDefs.noObject;
END;
END;
IF mbx.where # mbx.latest
THEN BEGIN -- find first page --
VMDefs.Release[mbx.page];
mbx.page ←
VMDefs.ReadPage[[handle,mbx.where←mbx.latest],lookAhead];
END;
CloseArch[mbx]; mbx.archObj ← ObjectDirDefs.noObject;
DO who: BodyDefs.RName = LOOPHOLE[mbx.page,POINTER]+base+SIZE[MBXHeader];
header ← LOOPHOLE[mbx.page,POINTER]+base;
buffer ← DESCRIPTOR[mbx.page+header.first,
(header.free-header.first)/SIZE[HeapDefs.ObjectNumber] ];
msgCount ← msgCount + LENGTH[buffer];
BEGIN -- write MBX to disk as empty, in case of crash --
header.free ← header.first;
VMDefs.MarkStartWait[ mbx.page ];
END;
IF mbx.where = mbx.latest
THEN BEGIN
-- this mbx page contains last mbx message --
lastObj: HeapDefs.ObjectNumber = buffer[LENGTH[buffer]-1];
IF lastObj # ObjectDirDefs.noObject
THEN BEGIN
body: HeapDefs.ObjectNumber = GetBodyObj[lastObj];
IF body.type # archived
THEN lastPost ← ReadPostmark[body]
-- ELSE lastPost is irrelevant! --;
END;
END;
-- decrement reference counts --
FOR index: CARDINAL DECREASING IN [0..LENGTH[buffer])
DO obj: HeapDefs.ObjectNumber = buffer[index];
IF obj # ObjectDirDefs.noObject
THEN BEGIN
body: HeapDefs.ObjectNumber = GetBodyObj[obj];
IF obj.type = TOC THEN ObjectDirDefs.FreeObject[obj];
IF body # mbx.archObj
THEN BEGIN
DeleteArch[];
IF body.type=archived -- record for later deletion --
THEN{ mbx.archObj ← body; ObjectDirDefs.UseObject[body]};
END;
ObjectDirDefs.FreeObject[body];
END;
mailboxContents ← mailboxContents-1;
ENDLOOP;
-- Clearing bit in pageMap allows page to be re-used --
IF header.number = 0 -- we're at the end of the earliest page --
THEN BEGIN
EmptyInTree[who, lastPost];
FreeMBXPage[mbx.where]; -- must not access page after here --
EXIT
END;
BEGIN
next: MBXName = header.chain; --that store is about to go--
FreeMBXPage[mbx.where]; -- must not access page after here --
VMDefs.Release[mbx.page];
mbx.where ← next;
mbx.page ← VMDefs.ReadPage[[handle,mbx.where],lookAhead];
END;
ENDLOOP;
DeleteArch[];
IF archiveFailure
THEN LogDefs.WriteLogEntry["Failed to delete mailbox archive file"L];
LogAction[LOOPHOLE[mbx.page,POINTER]+base+SIZE[MBXHeader],
yes, msgCount];
Destroy[mbx];
END;
AdjustOldest: ENTRY PROC[who: BodyDefs.RName, time: BodyDefs.Timestamp]=
BEGIN
-- alter "oldest" stamp after archiving --
prev: TreeRec = FindInTree[who: who];
WITH tree: prev SELECT FROM
empty => ERROR; -- silly: we have an interlock on it! --
found => ChangeInTree[who: who,
where: tree.where, lock: tree.lock,
oldest: time];
ENDCASE => ERROR;
END;
Archive: PUBLIC PROC[who: BodyDefs.RName, keep: CARDINAL] =
BEGIN
mbx: MBXHandle;
contents: CARDINAL;
found: BOOLEAN;
[found, contents, mbx] ← Open[who];
IF found AND contents > keep
THEN BEGIN
ENABLE UNWIND => Close[mbx];
msgExists, archived, deleted: BOOLEAN;
archStart: CARDINAL ← 0;
WHILE archStart < contents-keep -- skip to non-archived message --
DO [msgExists, archived, deleted] ← RealNextMessage[mbx,no];
IF NOT msgExists THEN ERROR;
IF NOT archived AND NOT deleted THEN EXIT;
archStart ← archStart+1;
ENDLOOP;
IF archStart < contents-keep
THEN BEGIN
spillCount: CARDINAL = (contents-keep)-archStart;
archObj: HeapDefs.ObjectNumber;
Backup: PROC =
BEGIN
RestartMBX[mbx];
THROUGH [0..archStart]
DO [msgExists, archived, deleted] ← RealNextMessage[mbx,no];
ENDLOOP;
END;
BEGIN
ENABLE SpillDefs.ServerCrash =>
{ ObjectDirDefs.FreeObject[archObj]; Backup[]; RETRY };
archObj ← SpillDefs.StartWrite[who, spillCount !
SpillDefs.ServerCrash => ERROR InaccessibleArchive[] ];
THROUGH [0.. spillCount)
DO IF NOT msgExists OR archived THEN ERROR;
IF NOT deleted
THEN SpillDefs.AddBody[mbx.bodyObj];
[msgExists, archived, deleted] ← NextMessage[mbx];
ENDLOOP;
SpillDefs.EndWrite[];
END;
Backup[];
THROUGH [0..spillCount)
DO IF NOT deleted
THEN BEGIN
mbx.messages[mbx.nextMsg-1] ← archObj;
ObjectDirDefs.UseObject[archObj];
VMDefs.MarkStartWait[mbx.page];
IF mbx.object.type = TOC
THEN ObjectDirDefs.FreeObject[mbx.object];
ObjectDirDefs.FreeObject[mbx.bodyObj];
END;
[msgExists, archived, deleted] ← NextMessage[mbx];
ENDLOOP;
AdjustOldest[who, IF msgExists
THEN ReadPostmark[mbx.bodyObj]
ELSE BodyDefs.oldestTime];
ObjectDirDefs.FreeObject[archObj];
LogAction[who, arch, spillCount];
END;
END;
IF found THEN InnerClose[mbx];
END;
defaultDays: CARDINAL = 7;
archiveDays: CARDINAL ← defaultDays;
ReadArchiveDays: ENTRY PROC RETURNS[days: CARDINAL] = INLINE
{ days ← archiveDays; archiveDays ← defaultDays };
SetArchiveDays: PUBLIC ENTRY PROC[days: CARDINAL] =
{ archiveDays ← days };
Archiver: PROC =
BEGIN
DO PolicyDefs.ArchiverPause[];
PolicyDefs.WaitOperation[archiver];
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[temp];
now: BodyDefs.PackedTime = Time.Current[];
old: BodyDefs.PackedTime = now -
LONG[ReadArchiveDays[]] * 24 * 60 * 60;
count: CARDINAL ← 0;
Work: PROC[who: BodyDefs.RName, tree: found TreeRec] =
BEGIN
IF tree.oldest # BodyDefs.oldestTime
AND tree.oldest.time < old
THEN { HeapDefs.HeapWriteRName[writer, who]; count←count+1 };
END;
EnumerateTree[Work];
IF count = 0
THEN HeapDefs.HeapAbandonWrite[writer]
ELSE BEGIN
reader: HeapDefs.ReaderHandle;
GetReader: PROC[obj: HeapDefs.ObjectNumber] =
{ reader ← HeapDefs.HeapStartRead[obj] };
HeapDefs.HeapEndWrite[writer, GetReader];
THROUGH [ 1..count ]
DO who: BodyDefs.RName = [BodyDefs.maxRNameLength];
BEGIN
[] ← HeapDefs.HeapReadRName[reader, who];
Archive[who, 0 ! InaccessibleArchive => GOTO failed];
EXITS
failed => { LogAction[who, archFail]; EXIT };
END;
ENDLOOP;
HeapDefs.HeapEndRead[reader];
END;
END;
PolicyDefs.EndOperation[archiver];
ENDLOOP;
END;
Remail: PUBLIC PROC[who: BodyDefs.RName, valid: BOOLEAN] =
BEGIN
RemailMessage: PROC[body: HeapDefs.ObjectNumber] =
BEGIN
log: STRING = [64];
slHeader: SLDefs.SLHeader;
slHeader.created ← ReadPostmark[body];
slHeader.received ← [0,0,Time.Current[]];
String.AppendString[log, "Remailing "L];
ProtocolDefs.AppendTimestamp[log, slHeader.created];
String.AppendString[log, " as "L];
slHeader.created.time ← slHeader.received.time;
ProtocolDefs.AppendTimestamp[log, slHeader.created];
LogDefs.WriteLogEntry[log];
slHeader.server ← NIL;
BEGIN -- write steering list --
sl: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[SLinput];
HeapDefs.HeapWriteData[sl, [@slHeader, SIZE[SLDefs.SLHeader]] ];
HeapDefs.HeapWriteRName[sl, who];
SLDefs.SLWrite[body: body, SL: sl, queue: input];
END;
END;
found: BOOLEAN;
count: CARDINAL;
mbx: MBXHandle;
[found, count, mbx] ← Open[who];
IF found
THEN BEGIN
IF valid
THEN BEGIN
ENABLE UNWIND => Close[mbx];
LogAction[who, remail];
THROUGH [1..count]
DO msgExists, archived, deleted: BOOLEAN;
[msgExists, archived, deleted] ← NextMessage[mbx];
IF NOT msgExists THEN ERROR;
IF deleted THEN LOOP;
BEGIN
ENABLE UNWIND => PolicyDefs.EndOperation[remailing];
PolicyDefs.WaitOperation[remailing];
IF mbx.bodyObj.type = archived
THEN BEGIN
ENABLE SpillDefs.ServerCrash =>
{ mbx.archOpen ← FALSE; GOTO inaccessible };
OpenArch[mbx];
HeapDefs.HeapEndWrite[
SpillDefs.RecoverBody[mbx.archFile,mbx.archCount],
RemailMessage];
EXITS inaccessible =>
{ ERROR InaccessibleArchive[] };
END
ELSE RemailMessage[mbx.bodyObj];
DeleteMessage[mbx];
PolicyDefs.EndOperation[remailing];
END;
ENDLOOP;
END
ELSE LogAction[who,dead];
FlushAndClose[mbx];
END;
PurgeFromTree[who];
END;
s: STRING = "Birrell.pa"; --for use from the debugger--
LogAction: PROCEDURE[who: BodyDefs.RName,
action: {yes,no,nothing,arch,archFail,remail,dead},
data: CARDINAL ← 0] =
BEGIN
log: STRING = [128];
String.AppendString[log, "Mailbox "L];
String.AppendString[log, who];
String.AppendString[log, SELECT action FROM
nothing => ": already empty"L,
no => ": abandoned reading"L,
yes => ": emptied, "L,
arch => ": archived "L,
archFail => ": archive failed"L,
remail => ": remailing"L,
dead => ": dead"L,
ENDCASE => ERROR];
SELECT action FROM
yes, arch =>
BEGIN
String.AppendDecimal[log, data];
String.AppendString[log, " messages"L];
END;
ENDCASE => NULL;
LogDefs.WriteLogEntry[log];
IF action = remail
THEN { LogDefs.WriteString[" Remail "L]; LogDefs.WriteString[who] };
END;
MailboxCount: PUBLIC PROC[str: EnquiryDefs.Handle] =
BEGIN
OPEN str;
encountered: LONG CARDINAL ← 0;
freePageCount: CARDINAL ← 0;
WriteChar[Ascii.CR];
FOR pageNumber: CARDINAL IN [0..nextVirginPage)
DO page: VMDefs.Page = VMDefs.ReadPage[ [handle,pageNumber], 0];
BEGIN
ENABLE UNWIND => VMDefs.Release[page];
header: POINTER TO MBXHeader = LOOPHOLE[page];
IF header.first = header.free
THEN freePageCount ← freePageCount+1
ELSE BEGIN
name: BodyDefs.RName = LOOPHOLE[page,POINTER]+SIZE[MBXHeader];
count: CARDINAL =
(header.free-header.first)/SIZE[HeapDefs.ObjectNumber];
objects: DESCRIPTOR FOR ARRAY OF HeapDefs.ObjectNumber =
DESCRIPTOR[ LOOPHOLE[page,POINTER]+header.first, count];
tocCount: CARDINAL ← 0;
delCount: CARDINAL ← 0;
archCount: CARDINAL ← 0;
WriteString[name];
WriteChar['(]; WriteDecimal[header.number]; WriteChar[')];
WriteString[": "L]; WriteDecimal[count];
encountered ← encountered + count;
WriteString[" messages"L];
FOR this: CARDINAL IN [0..count)
DO SELECT objects[this].type FROM
TOC => tocCount ← tocCount+1;
archived => archCount ← archCount+1;
gap => delCount ← delCount+1;
ENDCASE => NULL;
ENDLOOP;
IF tocCount # 0
THEN{ WriteString["; "L];
WriteDecimal[tocCount]; WriteString[" TOC's"L] };
IF delCount#0
THEN{ WriteString["; "L];
WriteDecimal[delCount]; WriteString[" deleted"L] };
IF archCount#0
THEN{ WriteString["; "L];
WriteDecimal[archCount]; WriteString[" archived"L] };
IF header.number = 0
THEN BEGIN
LookInTree: ENTRY PROC RETURNS[TreeRec] = INLINE
{ RETURN[FindInTree[name]] };
mbx: TreeRec = LookInTree[];
WriteString["; "L];
WITH tree:mbx SELECT FROM
empty => WriteString[" *** not in tree!"L];
found =>
IF tree.oldest = BodyDefs.oldestTime
THEN WriteString["no date"L]
ELSE BEGIN
t: STRING = [18];-- 29-Feb-99 24:23:22 --
Time.Append[t,
Time.Unpack[LOOPHOLE[tree.oldest.time]] ];
WriteString[t];
END;
ENDCASE => WriteString[" *** illegal tree entry"L];
END;
WriteChar[Ascii.CR];
END;
END;
VMDefs.Release[page];
IF DelTyped[] THEN GOTO del;
ENDLOOP;
WriteDecimal[freePageCount]; WriteString[" empty pages"L];
WriteChar[Ascii.CR];
WriteString["mailboxContents = "L];
WriteLongDecimal[mailboxContents]; WriteChar[Ascii.CR];
-- WriteString["encountered = "L];
-- WriteLongDecimal[encountered]; WriteChar[Ascii.CR];
EXITS del => { str.Flush[]; str.WriteString[" XXX"L] };
END;
HistBox: TYPE =
{ min17, min53, min160, hr8, day1, day3, day9, longer, archived};
histInterval: ARRAY HistBox OF CARDINAL =
[ (8*60)/27, (8*60)/9, (8*60)/3, 8*60, 3*8*60, 9*8*60, 27*8*60,
LAST[CARDINAL], LAST[CARDINAL] ];
histCount: ARRAY HistBox OF CARDINAL ← ALL[0];
histTotal: LONG CARDINAL ← 0;
ConsiderDelay: ENTRY PROC[postmark: BodyDefs.Timestamp] =
BEGIN
now: LONG CARDINAL = Time.Current[];
FOR box: HistBox IN [FIRST[HistBox]..longer)
DO limit: LONG CARDINAL = now - LONG[60] * histInterval[box];
IF postmark.time > limit
THEN { histCount[box] ← histCount[box] + 1; EXIT };
REPEAT
FINISHED => histCount[longer] ← histCount[longer] + 1
ENDLOOP;
histTotal ← histTotal + 1;
END;
CountArchived: ENTRY PROC = INLINE
{ histCount[archived] ← histCount[archived] + 1;
histTotal ← histTotal + 1 };
Histograms: PUBLIC PROC[str: EnquiryDefs.Handle] =
BEGIN
OPEN str;
histCaption: ARRAY HistBox OF STRING =
[ "17 min: "L,
"53 min: "L,
"2.7 hr: "L,
"8 hrs: "L,
"24 hrs: "L,
"3 days: "L,
"9 days: "L,
"longer: "L,
"archiv: "L ];
WriteChar[Ascii.CR];
WriteString["Mail retrieval delays"L];
WriteChar[Ascii.CR];
FOR box: HistBox IN HistBox
DO WriteString[histCaption[box]]; WriteDecimal[histCount[box]];
WriteChar[Ascii.TAB];
IF histTotal = 0
THEN WriteChar['?]
ELSE WriteLongDecimal[(histCount[box]*LONG[100])/histTotal];
WriteChar['%];
WriteChar[Ascii.CR];
ENDLOOP;
WriteString["total: "L]; WriteLongDecimal[histTotal];
END;
LogDefs.DisplayNumber["Mailboxes"L, [short[@mailboxes]] ];
END.