-- 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.