-- Grapevine: Name Lookup Server cache --

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

-- Andrew Birrell,   4-Mar-82 15:37:12 

DIRECTORY
BTreeDefs	USING[ BTreeHandle, CreateAndInitializeBTree, Insert,
		       KeyNotFound, Lookup, ReleaseBTree, TestKeys ],
Inline		USING[ COPY ],
LogDefs		USING[ WriteChar, WriteLogEntry ],
Process		USING[ Detach, Pause, SecondsToTicks ],
PupDefs		USING[ GetBufferParms, GetFreePupBuffer,
		       GetPupContentsBytes, PupAddress, PupBuffer,
		       PupRouterBroadcastThis, PupSocket,
		       PupSocketDestroy, PupSocketMake,
		       ReturnFreePupBuffer, 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, 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.pupWords[0] _ 0;
      PupDefs.SetPupContentsWords[b, 1];
      b.source _ local;
      b.dest.socket _ PupTypes.miscSrvSoc;
      b.pupType _ netDirVersion;
      b.pupID _ [0,0];
      PupDefs.PupRouterBroadcastThis[b];
      UNTIL (b _ nlsSoc.get[]) = NIL -- UNTIL timeout --
      DO SELECT b.pupType FROM
           netDirVersion =>
             IF PupDefs.GetPupContentsBytes[b] = 2
             AND b.pupWords[0] >= maxDirVersion
             THEN BEGIN
                  b.pupID _ [a:0, b:b.pupWords[0]];
                  Inline.COPY[from: @(keyBuffer.pupChars),
                              to: @(b.pupWords),
                              nwords: (1+keyLength)/2];
                  PupDefs.ReturnPup[b, nameLookup, keyLength];
                  END
             ELSE PupDefs.ReturnFreePupBuffer[b];
           nameIs =>
             IF b.pupID.b >= maxDirVersion
             THEN BEGIN
                  length: CARDINAL=PupDefs.GetPupContentsBytes[b]/2;
                  key: Key = DESCRIPTOR[@(keyBuffer.pupChars),
                                        keyLength];
                  IF SameVersion[b.pupID.b]
                  AND keyBuffer # NIL
                  AND Interesting[key, local,
                                 DESCRIPTOR[@(b.pupWords),
                                          length/SIZE[PupDefs.PupAddress]]]
                  THEN BEGIN
                       Insert[key, DESCRIPTOR[@(b.pupWords),length]];
                       LogChar['C];
                       END
                  ELSE LogChar['I];
                  GOTO done
                  END
             ELSE PupDefs.ReturnFreePupBuffer[b];
           nameError =>
             IF b.pupID.b >= maxDirVersion
             THEN BEGIN
                  IF SameVersion[b.pupID.b]
                  AND keyBuffer # NIL
                  THEN LogChar['E] --bad name--;
                  GOTO done
                  END
             ELSE PupDefs.ReturnFreePupBuffer[b];
         ENDCASE => PupDefs.ReturnFreePupBuffer[b] -- ignore --;
      ENDLOOP;
      LogChar['?] --timeout: re-try--;
   REPEAT
      done =>
        DO PupDefs.ReturnFreePupBuffer[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 PupDefs.ReturnFreePupBuffer[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 PupDefs.ReturnFreePupBuffer[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.pupType FROM
             nameLookup =>
               BEGIN
               key: Key = DESCRIPTOR[@(b.pupChars),
                                PupDefs.GetPupContentsBytes[b]];
               length: CARDINAL =
                          Lookup[key, DESCRIPTOR[@(b.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.ReturnFreePupBuffer[b];
      IF lastTime + 120 < Time.Current[]
      THEN -- check current net directory version --
           { PossibleLoadCache[NIL, 0] };
   ENDLOOP;
   END;

NameLookupProcess: PROCESS = FORK NameLookupMain[];

END.