-- Copyright (C) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.
-- SiteCache.mesa, Transport Mechanism - mailbox and R-Server site cache --
-- HGM, 15-Sep-85 8:02:25
-- Andrew Birrell 4-Mar-82 15:24:41 --
-- Mike Schroeder 26-Jan-83 10:05:32 --
DIRECTORY
BodyDefs USING [maxRNameLength, oldestTime, RName, Timestamp],
BTreeDefs USING [
BTreeHandle, Call, CreateAndInitializeBTree, Delete, EnumerateFrom, Insert,
KeyNotFound, Lookup, TestKeys],
HeapDefs USING [HeapEndRead],
NameInfoDefs USING [CheckStamp, Close, Enumerate, Expand, ExpandInfo],
ServerDefs USING [ServerHandle, ServerIsLocal, GetServer, ServerUp],
SiteCacheDefs USING [RecipientInfo, RemailInfo],
VMDefs USING [OpenFile];
SiteCache: MONITOR
IMPORTS BTreeDefs, HeapDefs, NameInfoDefs, ServerDefs, VMDefs
EXPORTS SiteCacheDefs =
BEGIN
tree: BTreeDefs.BTreeHandle ← LOOPHOLE[LONG[NIL]];
-- Management of Btree entries --
LowerCase: PROCEDURE [c: CHARACTER] RETURNS [CHARACTER] = INLINE {
RETURN[IF c IN ['A..'Z] THEN c - 'A + 'a ELSE c]};
IsFirstGE: BTreeDefs.TestKeys =
BEGIN
-- parameters a,b: DESC FOR ARRAY OF WORD returns[ BOOLEAN]--
aC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
FOR i: CARDINAL IN [0..2 * MIN[LENGTH[a], LENGTH[b]]) DO
IF LowerCase[aC[i]] < LowerCase[bC[i]] THEN RETURN[FALSE];
IF LowerCase[aC[i]] > LowerCase[bC[i]] THEN RETURN[TRUE];
ENDLOOP;
RETURN[LENGTH[a] >= LENGTH[b]];
END;
AreTheyEq: BTreeDefs.TestKeys =
BEGIN
aC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: LONG POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[b]];
IF LENGTH[a] = LENGTH[b] THEN
FOR i: CARDINAL IN [0..2 * LENGTH[a]) DO
IF LowerCase[aC[i]] # LowerCase[bC[i]] THEN EXIT;
REPEAT FINISHED => RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;
RNameDesc: PROCEDURE [name: BodyDefs.RName]
RETURNS [LONG DESCRIPTOR FOR ARRAY OF WORD] =
BEGIN
IF name.length MOD 2 # 0 THEN name[name.length] ← '@;
RETURN[DESCRIPTOR[@(name.text), (1 + name.length) / 2]]
END;
TreeData: TYPE = RECORD [
visibility: {visible, gone} --internal to BTree-- ,
primary: BOOLEAN,
var: SELECT type: * FROM
found => [server: ServerDefs.ServerHandle],
allDown => [stamp: BodyDefs.Timestamp],
valid => NULL --name ok, but we don't know details-- ,
notInTree => NULL --doesn't appear in BTree-- ,
ENDCASE];
FindInTree: ENTRY PROCEDURE [who: BodyDefs.RName] RETURNS [data: TreeData] =
BEGIN
desc: LONG DESCRIPTOR FOR ARRAY OF WORD = RNameDesc[who];
length: CARDINAL = BTreeDefs.Lookup[
tree, desc, DESCRIPTOR[@data, SIZE[TreeData]]];
IF length # BTreeDefs.KeyNotFound THEN
IF data.visibility = visible THEN RETURN
ELSE
BEGIN
BTreeDefs.Delete[tree, desc];
RETURN[[visible, TRUE, notInTree[]]]
END
ELSE RETURN[[visible, TRUE, notInTree[]]]
END;
ChangeInTree: ENTRY PROCEDURE [who: BodyDefs.RName, data: TreeData] =
BEGIN
prev: TreeData;
desc: LONG DESCRIPTOR FOR ARRAY OF WORD = RNameDesc[who];
IF BTreeDefs.Lookup[tree, desc, DESCRIPTOR[@prev, SIZE[TreeData]]] #
BTreeDefs.KeyNotFound THEN BTreeDefs.Delete[tree, desc];
IF data.type # notInTree THEN
BEGIN
data.visibility ← visible;
BTreeDefs.Insert[
tree, desc, DESCRIPTOR[
@data,
SELECT data.type FROM
found => SIZE[found TreeData],
allDown => SIZE[allDown TreeData],
valid => SIZE[valid TreeData],
ENDCASE => ERROR]];
END;
END;
SingleFlush: PUBLIC PROCEDURE [who: BodyDefs.RName] =
BEGIN
foreign: BodyDefs.RName = [BodyDefs.maxRNameLength];
ChangeInTree[who, [, , notInTree[]]];
[] ← MakeRNameBeForeign[who, foreign];
ChangeInTree[foreign, [, , notInTree[]]];
END;
SelectiveFlush: PUBLIC ENTRY PROCEDURE [given: ServerDefs.ServerHandle] =
BEGIN
-- Flushes from the site cache those entries which are non-primary and
-- indicate a server other than the given one. That is, the only entries
-- not flushed are those which are primary and those which are for the
-- given server. This is called by UpServer.
Action: BTreeDefs.Call =
BEGIN
record: LONG POINTER TO TreeData = LOOPHOLE[BASE[v]];
more ← TRUE;
dirty ← FALSE;
IF LENGTH[k] = 0 THEN RETURN;
WITH record SELECT FROM
found =>
IF server # given AND NOT primary AND record.visibility = visible THEN {
record.visibility ← gone; dirty ← TRUE};
allDown, valid =>
IF record.visibility = visible THEN {
record.visibility ← gone; dirty ← TRUE};
ENDCASE => ERROR;
END;
BTreeDefs.EnumerateFrom[tree, DESCRIPTOR[NIL, 0], Action];
END;
-- R-Name lookup --
SubMBXSite: PROCEDURE [who, really: BodyDefs.RName]
RETURNS [SiteCacheDefs.RecipientInfo] =
BEGIN
-- Finds MBX site or distribution list contents, using cache if possible --
-- BEWARE: If "who" describes a distribution list, this procedure starts
-- a reader for it. In particular, to discriminate on the variant record
-- returned, do not write "WITH FindMBXSite[....] SELECT", since each
-- access to the opened fields of the record causes "FindMBXSite[....]" to
-- be re-evaluated, causing another reader to be started!
found: BOOLEAN ← FALSE;
isLocal: BOOLEAN ← FALSE;
primary: BOOLEAN ← TRUE;
server: ServerDefs.ServerHandle;
treeData: TreeData = FindInTree[who];
stamp: BodyDefs.Timestamp ← BodyDefs.oldestTime;
WITH t: treeData SELECT FROM
found =>
BEGIN
isLocal ← ServerDefs.ServerIsLocal[server ← t.server];
found ← isLocal OR ServerDefs.ServerUp[server];
END;
allDown => stamp ← t.stamp;
notInTree, valid => NULL;
ENDCASE => ERROR;
IF NOT found THEN -- ask registration server --
BEGIN
info: NameInfoDefs.ExpandInfo =
-- should just call Expand, but at present that always causes a
-- reader to be opened in the R-Server, so use CheckStamp first.
IF treeData.type = allDown
AND NameInfoDefs.CheckStamp[who, stamp] = noChange THEN [noChange[]]
ELSE NameInfoDefs.Expand[who, stamp];
WITH i: info SELECT FROM
notFound =>
BEGIN
IF treeData.type # notInTree THEN ChangeInTree[who, [, , notInTree[]]];
RETURN[[notFound[]]];
END;
allDown, noChange => NULL;
group =>
BEGIN
IF treeData.type # valid THEN ChangeInTree[who, [, , valid[]]];
RETURN[[dl[i.members]]];
END;
individual =>
BEGIN
--scan list of mailbox sites--
hasNoSites: BOOLEAN ← TRUE;
Work: PROC [site: BodyDefs.RName] RETURNS [done: BOOLEAN] =
BEGIN
hasNoSites ← FALSE;
server ← ServerDefs.GetServer[[rName[site]]];
isLocal ← ServerDefs.ServerIsLocal[server];
--If network is broken, ServerIsLocal may call DownServer--
--So we get more predictable results by calling it early--
IF ServerDefs.ServerUp[server] THEN {found ← done ← TRUE; }
ELSE {primary ← FALSE; done ← FALSE};
END;
stamp ← i.stamp;
NameInfoDefs.Enumerate[i.sites, Work];
NameInfoDefs.Close[i.sites];
IF hasNoSites THEN RETURN[[notFound[]]];
IF found THEN ChangeInTree[who, [, primary, found[server]]];
END;
ENDCASE => ERROR;
END;
IF found THEN
BEGIN
-- the server may, of course, go down after we find it --
IF who # really THEN ChangeInTree[really, [, primary, found[server]]];
RETURN[IF isLocal THEN [local[]] ELSE [found[server]]]
END
ELSE
BEGIN
IF treeData.type # allDown THEN ChangeInTree[who, [, , allDown[stamp]]];
RETURN[[allDown[]]]
END
END;
NeedToRemail: PUBLIC PROCEDURE [who: BodyDefs.RName]
RETURNS [SiteCacheDefs.RemailInfo] =
BEGIN
info: NameInfoDefs.ExpandInfo ← NameInfoDefs.Expand[who];
WITH i: info SELECT FROM
notFound =>
BEGIN
-- Note that we always remail if foreign registry exists --
foreign: BodyDefs.RName = [BodyDefs.maxRNameLength];
[] ← MakeRNameBeForeign[who, foreign];
info ← NameInfoDefs.Expand[foreign];
WITH i: info SELECT FROM
notFound => RETURN[invalid];
allDown, noChange => NULL;
group => NameInfoDefs.Close[i.members];
individual => NameInfoDefs.Close[i.sites];
ENDCASE => ERROR;
RETURN[remail];
END;
allDown, noChange => RETURN[remail];
group => {NameInfoDefs.Close[i.members]; RETURN[remail]};
individual =>
BEGIN
--scan list of mailbox sites--
rI: SiteCacheDefs.RemailInfo ← invalid;
Work: PROC [site: BodyDefs.RName] RETURNS [done: BOOLEAN] =
BEGIN
server: ServerDefs.ServerHandle = ServerDefs.GetServer[[rName[site]]];
IF ServerDefs.ServerIsLocal[server] THEN {rI ← stillLocal; done ← TRUE}
ELSE {rI ← remail; done ← FALSE};
END;
NameInfoDefs.Enumerate[i.sites, Work];
NameInfoDefs.Close[i.sites];
RETURN[rI];
END;
ENDCASE => ERROR;
END;
FindMBXSite: PUBLIC PROCEDURE [who: BodyDefs.RName]
RETURNS [info: SiteCacheDefs.RecipientInfo] =
BEGIN
info ← SubMBXSite[who, who];
IF info.type = notFound THEN
BEGIN
foreign: BodyDefs.RName = [BodyDefs.maxRNameLength];
[] ← MakeRNameBeForeign[who, foreign];
info ← SubMBXSite[foreign, who];
END;
END;
MakeRNameBeForeign: PROC [sname, destination: BodyDefs.RName]
RETURNS [upArrow: BOOLEAN] = {
RETURN[MakeRNameHaveNA["Foreign"L, sname, destination]]};
MakeRNameHaveNA: PROC [nname, sname, destination: BodyDefs.RName]
RETURNS [upArrow: BOOLEAN] =
BEGIN
-- nname is of the form "NA" or "NA.something"
-- sname is of form "something.SN" or "SN"
-- assumes that SN and NA do not contain '.
-- constructs "SN.NA", truncating NA if needed
SNstart: CARDINAL;
sep: CHARACTER = '.;
destination.length ← 0;
SNstart ← sname.length;
UNTIL SNstart = 0 OR sname[SNstart - 1] = sep DO
SNstart ← SNstart - 1; ENDLOOP;
upArrow ← (SNstart > 1 AND sname[SNstart - 2] = '↑);
FOR index: CARDINAL IN [SNstart..sname.length) DO
IF destination.length = destination.maxlength THEN ERROR;
destination[destination.length] ← sname[index];
destination.length ← destination.length + 1;
ENDLOOP;
IF destination.length = destination.maxlength THEN RETURN;
destination[destination.length] ← sep;
destination.length ← destination.length + 1;
FOR index: CARDINAL IN [0..nname.length) WHILE nname[index] # sep DO
IF destination.length = destination.maxlength THEN EXIT;
destination[destination.length] ← nname[index];
destination.length ← destination.length + 1;
ENDLOOP;
END;
ValidateRName: PUBLIC PROCEDURE [who: BodyDefs.RName] RETURNS [ok: BOOLEAN] =
BEGIN
treeData: TreeData = FindInTree[who];
IF treeData.type # notInTree THEN ok ← TRUE
ELSE
SELECT NameInfoDefs.CheckStamp[who] FROM
notFound =>
BEGIN
foreign: BodyDefs.RName = [BodyDefs.maxRNameLength];
upArrow: BOOLEAN = MakeRNameBeForeign[who, foreign];
fInfo: SiteCacheDefs.RecipientInfo = SubMBXSite[
foreign, IF upArrow THEN foreign ELSE who];
ok ← fInfo.type # notFound;
IF ok AND upArrow THEN ChangeInTree[who, [, , valid[]]];
END;
group => BEGIN ok ← TRUE; ChangeInTree[who, [, , valid[]]]; END;
ENDCASE => -- includes "individual" and silly replies --
BEGIN
info: SiteCacheDefs.RecipientInfo = SubMBXSite[who, who];
WITH i: info SELECT FROM
allDown => ok ← TRUE;
notFound => ok ← FALSE;
dl => {ok ← TRUE; NameInfoDefs.Close[i.members]};
foreign => {ok ← TRUE; HeapDefs.HeapEndRead[i.members]};
local, found => ok ← TRUE;
ENDCASE => ERROR;
END;
END;
CheckPrimary: PUBLIC PROC [who: BodyDefs.RName, server: ServerDefs.ServerHandle]
RETURNS [BOOLEAN] =
BEGIN
-- in case of doubt, it's safe to return FALSE --
SingleFlush[who];
IF ValidateRName[who] THEN
BEGIN
treeData: TreeData = FindInTree[who];
WITH t: treeData SELECT FROM
found => RETURN[t.primary AND t.server = server];
ENDCASE --may possibly include notInTree!-- => RETURN[FALSE]
END
ELSE RETURN[FALSE]
END;
Init: ENTRY PROCEDURE =
BEGIN
tree ← BTreeDefs.CreateAndInitializeBTree[
fileH: LOOPHOLE[VMDefs.OpenFile[
options: oldOrNew, name: "SiteCache.BTree", cacheFraction: 10]],
initializeFile: TRUE, useDefaultOrderingRoutines: FALSE,
isFirstGreaterOrEqual: IsFirstGE, areTheyEqual: AreTheyEq];
END;
Init[];
END.