-- File: PupDirServerNoDisk.mesa - last edit:
-- WIrish               7-Feb-88 19:29:02
-- AOF                  3-Feb-88 14:32:58
-- HGM                  9-May-86 16:14:21
-- Copyright (C) 1984, 1988 by Xerox Corporation. All rights reserved. 

-- We don't have a copy of the file, but we keep a BIG cache of things we find
-- on other servers so we can pass the service on to clients on adjacent nets.
-- This module watches the directory version on the net (and on the NameServer
--  Helpers), and flushes the cache so it will get reloaded with current information.
-- It also "forwards" netDirVersion requests aka the Pup boot servers to keep IFSs happy.

DIRECTORY
  Ascii USING [CR],
  CmFile USING [Handle, TableError],
  Heap USING [systemZone],
  Process USING [Detach, SetTimeout, MsecToTicks],
  Put USING [Text],
  String USING [AppendChar, AppendNumber, AppendString, AppendDecimal],
  StringLookUp USING [noMatch],
  Time USING [AppendCurrent],
  Token USING [FreeTokenString, Item, Octal],
  Indirect USING [Close, NextValue, OpenSection],
  MiscServerDefs USING [PupMiscServerOn, SetDirectoryServer],
  NameServerDefs USING [
    lockDirRequest, lockDirReply, unlockDirRequest, unlockDirReply,
    FlushWholeCache, PupNameServerOn, BumpCacheSize],
  PupDefs USING [
    AppendHostName, Body, GetPupAddress, GetPupContentsBytes, PupBuffer, PupNameTrouble,
    PupRouterBroadcastThis, PupRouterSendThis, PupSocket, PupSocketDestroy, PupSocketID,
    PupSocketMake, SecondsToTocks, SetPupContentsWords,
    ReturnPup, UniqueLocalPupSocketID,
    AccessHandle, DestroyPool, GetBuffer, MakePool, ReturnBuffer],
  PupRouterDefs USING [NetworkContext],
  PupTypes USING [fillInPupAddress, miscSrvSoc, PupAddress, PupNetID],
  Stats USING [StatCounterIndex, StatIncr];

PupDirServerNoDisk: MONITOR
  IMPORTS
    CmFile, Heap, Process, Put, String, Time, Token,
    Indirect, MiscServerDefs, NameServerDefs, PupDefs, Stats
  EXPORTS NameServerDefs =
  BEGIN OPEN Stats, NameServerDefs, PupDefs;


  z: UNCOUNTED ZONE = Heap.systemZone;
  remote: Chain ¬ NIL;
  helpers: HelperChain ¬ NIL;
  
  Chain: TYPE = LONG POINTER TO ChainSlot;
  ChainSlot: TYPE = RECORD [
    next: Chain,
    source: PupTypes.PupNetID,
    dest: PupTypes.PupAddress,
    target: LONG STRING];

  HelperChain: TYPE = LONG POINTER TO HelperChainSlot;
  HelperChainSlot: TYPE = RECORD [
    next: HelperChain,
    dest: PupTypes.PupAddress,
    target: LONG STRING];
  
  dirRunning, probing, sending: PUBLIC BOOLEAN ¬ FALSE;
  useCount: CARDINAL ¬ 0;
  pleaseStop: BOOLEAN ¬ FALSE;
  probePeriod: CARDINAL ¬ 30;  -- in minutes
  tries: CARDINAL ¬ 0;
  delay: CONDITION;
  lock: BOOLEAN ¬ FALSE;
  verbose: BOOLEAN = TRUE;
  currentVersion: CARDINAL ¬ 0;
  oldVersionAround: BOOLEAN ¬ TRUE;

  fileName: STRING = "Pup-network.directory";

  statVers, statSend: PUBLIC StatCounterIndex;

  GetNewDirectoryVersion, GetOldDirectoryVersion: PUBLIC PROCEDURE RETURNS [CARDINAL, BOOLEAN] =
    BEGIN RETURN[currentVersion, FALSE]; END;

  PupDirServerOn: PUBLIC PROCEDURE =
    BEGIN
    IF (useCount ¬ useCount + 1) = 1 THEN
      BEGIN
      dirRunning ¬ TRUE;
      Starter[];
      END;
    END;

  Starter: PROCEDURE =
    BEGIN
    pleaseStop ¬ FALSE;
    MiscServerDefs.PupMiscServerOn[];
    ScanParameterFile[];
    MiscServerDefs.SetDirectoryServer[PupDirServer];
    Process.Detach[FORK ProbeGovenor[]];
    END;


  CountTries: ENTRY PROCEDURE = BEGIN tries ¬ tries + 1; END;

  KickProber: PUBLIC ENTRY PROCEDURE =
    BEGIN IF tries > 3 THEN RETURN; StartProbing[]; END;

  StartProbingForDirectory: PUBLIC ENTRY PROCEDURE = BEGIN StartProbing[]; END;

  StartProbing: INTERNAL PROCEDURE =
    BEGIN
    IF pleaseStop OR probing THEN RETURN;
    probing ¬ TRUE;
    Process.Detach[FORK Probe[]];
    END;

  ProbeGovenor: ENTRY PROCEDURE =
    BEGIN
    n: CARDINAL ¬ 1;  -- probe 1 min after startup
    Process.SetTimeout[@delay, Process.MsecToTicks[60000]];
    UNTIL pleaseStop DO
      WAIT delay;  -- one minute
      IF probing THEN BEGIN n ¬ probePeriod; LOOP; END;
      IF (n ¬ n - 1) = 0 THEN
        BEGIN
        tries ¬ 0;
        StartProbing[];
        WHILE probing DO WAIT delay; ENDLOOP;
        n ¬ probePeriod;
        END;
      ENDLOOP;
    END;

  Probe: PROCEDURE =
    BEGIN
    b: PupBuffer;
    from: PupSocketID ¬ UniqueLocalPupSocketID[];
    pool: PupDefs.AccessHandle ¬ PupDefs.MakePool[send: 1, receive: 10];
    soc: PupSocket;
    bestSoFar: CARDINAL ¬ currentVersion;
    where: PupTypes.PupAddress;
    who: PupTypes.PupAddress ¬ PupTypes.fillInPupAddress;
    sawOldVersion: BOOLEAN ¬ FALSE;
    body: PupDefs.Body;
    helper: HelperChain ¬ helpers;
    tryBroadcast: BOOLEAN ¬ FALSE;
    try: CARDINAL ¬ 2;
    -- Check the NameServer Helpers first, then try local broadcasts...
    soc ¬ PupSocketMake[from, who, SecondsToTocks[5]];
    IF helper # NIL
      THEN who ¬ helper.dest
      ELSE tryBroadcast ¬ TRUE;
    UNTIL (bestSoFar > currentVersion) OR (tryBroadcast AND try = 0) DO
      IF try = 0 THEN
        BEGIN
        IF helper # NIL THEN helper ¬ helper.next;
	IF helper # NIL
	  THEN who ¬ helper.dest
	  ELSE tryBroadcast ¬ TRUE;
        try ¬ 2;
        END;
      try ¬ try - 1;
      b ¬ PupDefs.GetBuffer[pool, send];
      body ¬ b.pup;
      body.dest ¬ who;
      body.source ¬ soc.getLocalAddress[];
      body.source.socket ¬ from;
      body.dest.socket ¬ PupTypes.miscSrvSoc;
      body.pupType ¬ netDirVersion;
      body.pupWords[0] ¬ 0;
      body.pupWords[1] ¬ 0;
      SetPupContentsWords[b, 2];
      IF tryBroadcast
        THEN PupRouterBroadcastThis[b]
        ELSE PupRouterSendThis[b];
      DO
	b ¬ soc.get[];
	IF b = NIL THEN EXIT;
	IF b.pup.pupType = netDirVersion THEN
	  BEGIN
	  SELECT b.pup.pupWords[0] FROM
	    > bestSoFar =>
	      BEGIN bestSoFar ¬ b.pup.pupWords[0]; where ¬ b.pup.source; END;
	    < currentVersion => sawOldVersion ¬ TRUE;
	    ENDCASE => NULL;
	  IF GetPupContentsBytes[b] > 2 THEN
	    BEGIN
	    SELECT b.pup.pupWords[1] FROM
	      > bestSoFar =>
		BEGIN bestSoFar ¬ b.pup.pupWords[0]; where ¬ b.pup.source; END;
	      < currentVersion => sawOldVersion ¬ TRUE;
	      ENDCASE => NULL;
	    END;
	  END;
	PupDefs.ReturnBuffer[b];
	ENDLOOP;
      ENDLOOP;
    PupSocketDestroy[soc];
    PupDefs.DestroyPool[pool];
    IF bestSoFar > currentVersion THEN
      BEGIN
      IF verbose THEN
        BEGIN OPEN String;
        text: STRING = [100];
        Time.AppendCurrent[text];
        AppendString[text, "  Saw "L];
        AppendString[text, fileName];
        AppendString[text, "!"L];
        AppendDecimal[text, bestSoFar];
        AppendString[text, " on "L];
        AppendHostName[text, where];
        LogString[text];
        END;
      FlushWholeCache[];
      currentVersion ¬ bestSoFar;
      probing ¬ FALSE;
      RETURN;
      END;
    IF sawOldVersion OR oldVersionAround THEN
      BEGIN
      oldVersionAround ¬ sawOldVersion;
      FlushWholeCache[];
      END;
    probing ¬ FALSE;
    END;

  PupDirServer: PUBLIC PROCEDURE [b: PupBuffer] =
    BEGIN
    IF ~(lock OR pleaseStop) OR b.pup.pupType = unlockDirRequest THEN
      SELECT b.pup.pupType FROM
        netDirVersion =>
          BEGIN
          StatIncr[statVers];
          SELECT b.pup.pupWords[0] FROM
            = currentVersion => NULL;  -- we have the same ones
            > currentVersion => KickProber[];  -- he has a newer one
            < currentVersion => NULL; -- Don't respond since we can't send it
            ENDCASE => ERROR;
	  MaybeForwardThisOne[b];
	  RETURN;
          END;
        sendNetDir => NULL;
        lockDirRequest =>
          BEGIN
          lock ¬ TRUE;
          ReturnPup[b, lockDirReply, 0];
          FlushWholeCache[];
          RETURN;
          END;
        unlockDirRequest =>
          BEGIN
          wasLocked: BOOLEAN ¬ lock;
          lock ¬ FALSE;
          ReturnPup[b, unlockDirReply, 0];
          tries ¬ 0;
          KickProber[];
          RETURN;
          END;
        ENDCASE;
    PupDefs.ReturnBuffer[b];
    END;

  MaybeForwardThisOne: PROCEDURE [b: PupDefs.PupBuffer] =
    BEGIN
    context: PupRouterDefs.NetworkContext = b.fo.context;
    IF b.pup.source.net = 0 THEN b.pup.source.net ¬ [context.pupNetNumber];
    FOR finger: Chain ¬ remote, finger.next UNTIL finger = NIL DO
      IF context.pupNetNumber = finger.source THEN
        BEGIN
	IF finger.dest = PupTypes.fillInPupAddress THEN EXIT;
	b.pup.dest.net ¬ finger.dest.net;
	b.pup.dest.host ¬ finger.dest.host;
	PupDefs.PupRouterSendThis[b];
	RETURN;
	END;
      ENDLOOP;
    PupDefs.ReturnBuffer[b];
    END;

 ScanParameterFile: PROCEDURE =
    BEGIN
    cmFile: CmFile.Handle;
    Option: TYPE = {remote};
    NextValue: PROCEDURE [
      h: CmFile.Handle, table: LONG DESCRIPTOR FOR ARRAY Option OF LONG STRING]
      RETURNS [Option] = LOOPHOLE[Indirect.NextValue];
    optionTable: ARRAY Option OF LONG STRING ¬ [remote: "Remote"L];
    cmFile ¬ Indirect.OpenSection["PupDirServer"L];
    IF cmFile = NIL THEN RETURN;
    DO
      option: Option;
      option ¬ NextValue[
        cmFile, DESCRIPTOR[optionTable] !
        CmFile.TableError =>
          BEGIN
	  IF name[0] # '; THEN Message["Unrecognized parameter: ", name];
	  RETRY;
	  END];
      SELECT option FROM
        LOOPHOLE[StringLookUp.noMatch] => EXIT;
        remote =>
	  BEGIN
	  source: PupTypes.PupNetID = [Token.Octal[cmFile]];
	  temp: LONG STRING ¬ Token.Item[cmFile, FALSE];
	  new: Chain ¬ z.NEW[ChainSlot];
	  new­ ¬ [NIL, source, PupTypes.fillInPupAddress, z.NEW[StringBody[temp.length]]];
	  String.AppendString[new.target, temp];
	  [] ¬ Token.FreeTokenString[temp];
	  PupDefs.GetPupAddress[@new.dest, new.target ! PupDefs.PupNameTrouble => CONTINUE];
	  IF remote = NIL THEN remote ¬ new
	  ELSE
	    BEGIN
	    FOR finger: Chain ¬ remote, finger.next DO
	      IF finger.next = NIL THEN
	        BEGIN
		finger.next ¬ new;
		EXIT;
		END;
	      ENDLOOP;
	    END;
          MessageNet["Forwarding Pup NetDirVersion requests from net "L, new.source, " to "L, new.target];
	  END;
        ENDCASE => ERROR;
      ENDLOOP;
    Indirect.Close[cmFile];
    ScanParameterFileForNameServerHelpers[];
    END;

  -- We also have to check the NameServer Helpers...
  ScanParameterFileForNameServerHelpers: PROCEDURE =
    BEGIN
    cmFile: CmFile.Handle;
    Option: TYPE = {helper};
    NextValue: PROCEDURE [
      h: CmFile.Handle, table: LONG DESCRIPTOR FOR ARRAY Option OF LONG STRING]
      RETURNS [Option] = LOOPHOLE[Indirect.NextValue];
    optionTable: ARRAY Option OF LONG STRING ¬ [helper: "Helper"L];
    cmFile ¬ Indirect.OpenSection["NameServer"L];
    IF cmFile = NIL THEN RETURN;
    DO
      option: Option;
      option ¬ NextValue[
        cmFile, DESCRIPTOR[optionTable] !
        CmFile.TableError =>
          BEGIN
	  IF name[0] # '; THEN Message["Unrecognized parameter: ", name];
	  RETRY;
	  END];
      SELECT option FROM
        LOOPHOLE[StringLookUp.noMatch] => EXIT;
        helper =>
	  BEGIN
	  text: STRING = [20];
	  temp: LONG STRING ¬ Token.Item[cmFile, FALSE];
	  new: HelperChain ¬ z.NEW[HelperChainSlot];
	  new­ ¬ [NIL, PupTypes.fillInPupAddress, z.NEW[StringBody[temp.length]]];
	  String.AppendString[new.target, temp];
	  [] ¬ Token.FreeTokenString[temp];
	  PupDefs.GetPupAddress[@new.dest, new.target ! PupDefs.PupNameTrouble => CONTINUE];
	  IF helpers = NIL THEN helpers ¬ new
	  ELSE
	    BEGIN
	    FOR finger: HelperChain ¬ helpers, finger.next DO
	      IF finger.next = NIL THEN
	        BEGIN
		finger.next ¬ new;
		EXIT;
		END;
	      ENDLOOP;
	    END;
	  END;
        ENDCASE => ERROR;
      ENDLOOP;
    Indirect.Close[cmFile];
    END;

  MessageNet: PROCEDURE [one: LONG STRING, net: CARDINAL, three, four: LONG STRING] =
    BEGIN
    two: STRING = [20];
    String.AppendNumber[two, net, 8];
    Message[one, two, three, four];
    END;

  Message: PROCEDURE [one, two, three, four: LONG STRING ¬ NIL] =
    BEGIN
    text: STRING = [200];
    String.AppendString[text, one];
    IF two # NIL THEN String.AppendString[text, two];
    IF three # NIL THEN String.AppendString[text, three];
    IF four # NIL THEN String.AppendString[text, four];
    LogString[text];
    END;

  LogString: PROCEDURE [text: LONG STRING] =
    BEGIN
    String.AppendChar[text, '.];
    String.AppendChar[text, Ascii.CR];
    Put.Text[NIL, text];
    END;

  -- initialization
  PupDirServerOn[];
  NameServerDefs.PupNameServerOn[];
  NameServerDefs.BumpCacheSize[2000];
  END.