-- Copyright (C) 1982, 1984  by Xerox Corporation. All rights reserved. 
-- Grapevine: Name Lookup Server cache --

-- [Juniper]<Grapevine>MS>NameLookup.mesa

-- HGM, 17-Nov-84 20:27:08 
-- Andrew Birrell,   4-Mar-82 15:37:12 

DIRECTORY
  BTreeDefs USING [
    BTreeHandle, CreateAndInitializeBTree, Insert, KeyNotFound, Lookup,
    ReleaseBTree, TestKeys],
  Buffer USING [ReturnBuffer],
  Inline USING [COPY],
  LogDefs USING [WriteChar, WriteLogEntry],
  Process USING [Detach, Pause, SecondsToTicks],
  PupDefs USING [
    GetBufferParms, GetFreePupBuffer, GetPupContentsBytes, PupAddress, PupBuffer,
    PupRouterBroadcastThis, PupSocket, PupSocketDestroy, PupSocketMake,
    ReturnPup, SecondsToTocks, SetPupContentsWords],
  PupTypes USING [fillInSocketID, mailSoc, miscSrvSoc],
  String USING [AppendString, AppendDecimal],
  Time USING [Current, Packed],
  VMDefs USING [AbandonFile, FileHandle, GetFileLength, OpenFile, SetFileLength];

NameLookup: MONITOR
  IMPORTS BTreeDefs, Buffer, Inline, LogDefs, Process, PupDefs, String, Time, VMDefs =

  BEGIN

  LogChar: PROC [c: CHARACTER] = {LogDefs.WriteChar['n]; LogDefs.WriteChar[c]};


  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;

  Key: TYPE = DESCRIPTOR FOR PACKED ARRAY OF CHARACTER;

  Desc: PROCEDURE [name: Key] RETURNS [DESCRIPTOR FOR ARRAY OF WORD] = INLINE
    BEGIN
    IF LENGTH[name] MOD 2 # 0 THEN name[LENGTH[name]] ¬ '@;
    RETURN[DESCRIPTOR[BASE[name], (1 + LENGTH[name]) / 2]]
    END;

  tree: BTreeDefs.BTreeHandle;
  treeFile: VMDefs.FileHandle;

  hitCount: LONG CARDINAL ¬ 0;
  missCount: LONG CARDINAL ¬ 0;
  entryCount: CARDINAL ¬ 0;

  roysBuggingFlag: BOOLEAN ¬ FALSE;  -- TRUE to provoke a VM bug --

  OpenTree: INTERNAL PROC =
    BEGIN
    treeFile ¬ VMDefs.OpenFile[
      name: "NameLookup.BTree$"L, options: oldOrNew, cacheFraction: 5];
    IF roysBuggingFlag THEN VMDefs.SetFileLength[treeFile, [0, 0]];
    tree ¬ BTreeDefs.CreateAndInitializeBTree[
      fileH: LOOPHOLE[treeFile], initializeFile: TRUE,
      useDefaultOrderingRoutines: FALSE, isFirstGreaterOrEqual: IsFirstGE,
      areTheyEqual: AreTheyEq];
    entryCount ¬ 0;
    hitCount ¬ missCount ¬ 0;
    END;

  CloseTree: INTERNAL PROC = {
    VMDefs.AbandonFile[LOOPHOLE[BTreeDefs.ReleaseBTree[tree]]]};

  maxDirVersion: CARDINAL ¬ 0;

  InitTree: ENTRY PROC = {OpenTree[]};

  FlushTree: ENTRY PROC =
    BEGIN
    log: STRING = [40];
    String.AppendString[log, "Found NLS version "L];
    String.AppendDecimal[log, maxDirVersion];
    LogDefs.WriteLogEntry[log];
    LogDefs.WriteChar['V];
    CloseTree[];
    OpenTree[];
    END;

  Insert: ENTRY PROC [key: Key, value: DESCRIPTOR FOR ARRAY OF WORD] = INLINE
    BEGIN
    keyDesc: DESCRIPTOR FOR ARRAY OF WORD = Desc[key];
    IF LENGTH[keyDesc] < 32 AND (LENGTH[keyDesc] + LENGTH[value]) <= 80 THEN
      BEGIN
      BTreeDefs.Insert[tree, keyDesc, value];
      entryCount ¬ entryCount + 1;
      END;
    END;

  Lookup: ENTRY PROC [key: Key, value: DESCRIPTOR FOR ARRAY OF WORD]
    RETURNS [length: CARDINAL] = INLINE
    BEGIN
    length ¬ BTreeDefs.Lookup[tree, Desc[key], value];
    IF length = BTreeDefs.KeyNotFound THEN missCount ¬ missCount + 1
    ELSE hitCount ¬ hitCount + 1;
    END;



  Interesting: PROC [
    key: Key, local: PupDefs.PupAddress,
    value: DESCRIPTOR FOR ARRAY OF PupDefs.PupAddress] RETURNS [BOOLEAN] =
    BEGIN
    -- In order to limit the size of the cache (or, to avoid designing a
    -- replacement algorithm), not all names are cached.
    -- Names which are composite ones (with "+"), or are really just address
    -- constants are never cached.  Names which have a socket number which
    -- is MTP or one of the Grapevine sockets, or map to this host are
    -- cached.  Other names are cached if the BTree is small.
    -- I believe that in all normal environments an 8 page BTree will cache
    -- (almost) all names that occur.
    -- There is also a restriction on BTree key lengths
    FOR i: CARDINAL IN [0..LENGTH[key]) DO
      SELECT key[i] FROM
        IN ['a..'z], IN ['A..'Z], '- => NULL;
        ENDCASE => RETURN[FALSE];
      ENDLOOP;
    IF VMDefs.GetFileLength[treeFile].page < 8 THEN RETURN[TRUE];
    FOR j: CARDINAL IN [0..LENGTH[value]) DO
      SELECT value[j].socket.b FROM
        PupTypes.mailSoc.b, IN [50B..57B] => RETURN[TRUE];
        ENDCASE =>
          IF value[j].host = local.host
            AND (value[j].net = local.net OR value[j].net = 0) THEN RETURN[TRUE];
      ENDLOOP;
    RETURN[FALSE]
    END;

  LoadCache: PROC [keyBuffer: PupDefs.PupBuffer, keyLength: CARDINAL] =
    BEGIN
    nlsSoc: PupDefs.PupSocket = PupDefs.PupSocketMake[
      PupTypes.fillInSocketID, , PupDefs.SecondsToTocks[2]];
    local: PupDefs.PupAddress = nlsSoc.getLocalAddress[];
    b: PupDefs.PupBuffer ¬ NIL;
    newVersion: BOOLEAN ¬ FALSE;
    SameVersion: PROC [new: CARDINAL] RETURNS [BOOLEAN] =
      BEGIN
      IF new > maxDirVersion THEN
        BEGIN
        maxDirVersion ¬ new;
        newVersion ¬ TRUE;
        LogDefs.WriteLogEntry["Waiting for new NLS version"L];
        RETURN[FALSE]
        END
      ELSE RETURN[TRUE];
      END;
    -- The protocol is:
    --   us -> broadcast: NetDirVersion[0]
    --   nls -> us: NetDirVersion[his]
    --   us -> nls: NameLookup[key, pupID=hisVersion]
    --   nls -> us: NameIs[array of PupAddress, pupID=hisVersion]
    -- Because a particular nls has monotonic netDir versions, we know
    -- that the name value came from a netDir at least as recent as the
    -- version number he gave us.
    THROUGH [1..1]  -- re-tries for lost packets --
      DO
      b ¬ PupDefs.GetFreePupBuffer[];
      b.pup.pupWords[0] ¬ 0;
      PupDefs.SetPupContentsWords[b, 1];
      b.pup.source ¬ local;
      b.pup.dest.socket ¬ PupTypes.miscSrvSoc;
      b.pup.pupType ¬ netDirVersion;
      b.pup.pupID ¬ [0, 0];
      PupDefs.PupRouterBroadcastThis[b];
      UNTIL (b ¬ nlsSoc.get[]) = NIL  -- UNTIL timeout --
        DO
        SELECT b.pup.pupType FROM
          netDirVersion =>
            IF PupDefs.GetPupContentsBytes[b] = 2
              AND b.pup.pupWords[0] >= maxDirVersion THEN
              BEGIN
              b.pup.pupID ¬ [a: 0, b: b.pup.pupWords[0]];
              Inline.COPY[
                from: @(keyBuffer.pup.pupChars), to: @(b.pup.pupWords),
                nwords: (1 + keyLength) / 2];
              PupDefs.ReturnPup[b, nameLookup, keyLength];
              END
            ELSE Buffer.ReturnBuffer[b];
          nameIs =>
            IF b.pup.pupID.b >= maxDirVersion THEN
              BEGIN
              length: CARDINAL = PupDefs.GetPupContentsBytes[b] / 2;
              key: Key = DESCRIPTOR[@(keyBuffer.pup.pupChars), keyLength];
              IF SameVersion[b.pup.pupID.b] AND keyBuffer # NIL
                AND Interesting[
                  key, local, DESCRIPTOR[
                  @(b.pup.pupWords), length / SIZE[PupDefs.PupAddress]]] THEN
                BEGIN
                Insert[key, DESCRIPTOR[@(b.pup.pupWords), length]];
                LogChar['C];
                END
              ELSE LogChar['I];
              GOTO done
              END
            ELSE Buffer.ReturnBuffer[b];
          nameError =>
            IF b.pup.pupID.b >= maxDirVersion THEN
              BEGIN
              IF SameVersion[b.pup.pupID.b] AND keyBuffer # NIL THEN LogChar['E]
              --bad name-- ;
              GOTO done
              END
            ELSE Buffer.ReturnBuffer[b];
          ENDCASE => Buffer.ReturnBuffer[b] -- ignore -- ;
        ENDLOOP;
      LogChar['?] --timeout: re-try-- ;
      REPEAT
        done =>
          DO
            Buffer.ReturnBuffer[b];
            -- be polite: swallow extra replies! --
            IF (b ¬ nlsSoc.get[]) = NIL THEN EXIT;
            ENDLOOP;
        FINISHED => LogChar['X] --failed-- ;
      ENDLOOP;
    PupDefs.PupSocketDestroy[nlsSoc];
    IF keyBuffer # NIL THEN Buffer.ReturnBuffer[keyBuffer];
    IF newVersion  -- don't flush until NLS has settled down again! --
      THEN {Process.Pause[Process.SecondsToTicks[600]]; FlushTree[]};
    FinderEnded[];
    END;

  finderRunning: BOOLEAN ¬ FALSE;
  lastTime: Time.Packed ¬ [0];  -- time of last forced poll --

  PossibleLoadCache: ENTRY PROC [b: PupDefs.PupBuffer, length: CARDINAL] =
    BEGIN
    IF NOT finderRunning THEN {
      finderRunning ¬ TRUE;
      Process.Detach[FORK LoadCache[b, length]];
      lastTime ¬ Time.Current[]}
    ELSE IF b # NIL THEN Buffer.ReturnBuffer[b];
    END;

  FinderEnded: ENTRY PROC = INLINE {finderRunning ¬ FALSE};


  NameLookupMain: PROC =
    BEGIN
    soc: PupDefs.PupSocket = PupDefs.PupSocketMake[
      PupTypes.miscSrvSoc, , PupDefs.SecondsToTocks[120]];
    maxWords: CARDINAL = PupDefs.GetBufferParms[].bufferSize;
    InitTree[];
    DO
      b: PupDefs.PupBuffer = soc.get[];
      IF b # NIL THEN
        SELECT b.pup.pupType FROM
          nameLookup =>
            BEGIN
            key: Key = DESCRIPTOR[@(b.pup.pupChars), PupDefs.GetPupContentsBytes[b]];
            length: CARDINAL = Lookup[key, DESCRIPTOR[@(b.pup.pupWords), maxWords]];
            IF length # BTreeDefs.KeyNotFound THEN {
              LogChar['H]; PupDefs.ReturnPup[b, nameIs, length * 2]}
            ELSE {LogChar['M]; PossibleLoadCache[b, LENGTH[key]]};
            END;
          whereIsUser => PupDefs.ReturnPup[b, userIs, 0];
          ENDCASE => PupDefs.ReturnPupBuffer[b];
      IF lastTime + 120 < Time.Current[] THEN  -- check current net directory version --
        {PossibleLoadCache[NIL, 0]};
      ENDLOOP;
    END;

  NameLookupProcess: PROCESS = FORK NameLookupMain[];

  END.