-- Transport Mechanism - mailbox and R-Server site cache --

-- [Indigo]<Grapevine>MS>SiteCache.mesa

-- 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[ 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--
           rI: SiteCacheDefs.RemailInfo _ invalid;
           Work: PROC[site: BodyDefs.RName] RETURNS[done: BOOLEAN] =
              BEGIN
              server: ServerDefs.ServerHandle =
                ServerDefs.GetServer[[rName[site]],mail];
              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
   -- 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.