-- Transport Mechanism - mailbox and R-Server site cache --
-- [Indigo]<Grapevine>MS>SiteCache.mesa
-- Andrew Birrell 4-Mar-82 15:24:41 --
-- Mike Schroeder 18-Nov-82 11:13:07 --
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[ ForeignDL, RecipientInfo, RemailInfo],
VMDefs USING[ OpenFile ];
SiteCache: MONITOR
IMPORTS BTreeDefs, HeapDefs, NameInfoDefs, ServerDefs, SiteCacheDefs,
VMDefs
EXPORTS SiteCacheDefs =
BEGIN
tree: BTreeDefs.BTreeHandle ← LOOPHOLE[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: POINTER TO PACKED ARRAY OF CHARACTER = LOOPHOLE[BASE[a]];
bC: 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: POINTER TO PACKED ARRAY OF CHARACTER =LOOPHOLE[BASE[a]];
bC: 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[ 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: 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: 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: 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]],mail];
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--
localSite: BOOLEAN ← FALSE;
Work: PROC[site: BodyDefs.RName] RETURNS[done: BOOLEAN] =
BEGIN
server: ServerDefs.ServerHandle =
ServerDefs.GetServer[[rName[site]],mail];
localSite ← ServerDefs.ServerIsLocal[server];
IF localSite THEN done ← TRUE ELSE done ← FALSE;
END;
NameInfoDefs.Enumerate[i.sites, Work];
NameInfoDefs.Close[i.sites];
RETURN[IF localSite THEN stillLocal ELSE remail];
END;
ENDCASE => ERROR;
END;
FindMBXSite: PUBLIC PROCEDURE[ who: BodyDefs.RName ]
RETURNS[ info: SiteCacheDefs.RecipientInfo ] =
BEGIN
-- this layer is for the MTP recipient kludge --
info ← SubMBXSite[who, who];
IF info.type = notFound
THEN BEGIN
foreign: BodyDefs.RName = [BodyDefs.maxRNameLength];
upArrow: BOOLEAN = MakeRNameBeForeign[who, foreign];
info ← SubMBXSite[foreign, IF upArrow THEN foreign ELSE who];
IF upArrow AND info.type = found
THEN info ← SiteCacheDefs.ForeignDL[who, info];
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.