-- Copyright (C) 1984, 1985, 1987  by Xerox Corporation. All rights reserved. 
-- PhantomCHS.mesa, WIrish, 30-Oct-87 17:40:07

DIRECTORY
  AddressTranslation USING [Error, PrintError, StringToNetworkAddress],
  Ascii USING [CR],
  CmFile USING [Handle, TableError],
  Format USING [NetworkAddress, NetworkNumber, StringProc],
  Heap USING [systemZone],
  Process USING [Detach],
  Put USING [Text],
  String USING [AppendChar, AppendString],
  StringLookUp USING [noMatch],
  System USING [
    NetworkAddress, NetworkNumber, nullNetworkAddress, nullSocketNumber, SocketNumber],
  Token USING [FreeTokenString, Item, NetworkNumber],
  Unformat USING [Error, NetworkAddress],
  Buffer USING [NSBuffer, ReturnBuffer],
  Driver USING [Network],
  Indirect USING [Close, OpenSection, NextValue],
  NSConstants USING [newClearinghouseSocket],
  RouterInternal USING [SendPacket],
  RoutingTable USING [NetworkContext],
  Socket USING [
    ChannelHandle, Create,
    GetPacket,
    SetDestination, SetWaitTime, TimeOut];

PhantomCHS: MONITOR
  IMPORTS
    CmFile, Format, Heap, Indirect, Process, Put,
    String, Token, Unformat,
    AddressTranslation, Buffer, RouterInternal, Socket
  EXPORTS Buffer =
  BEGIN

  Network: PUBLIC TYPE = Driver.Network;

  pleaseStop: BOOLEAN ¬ FALSE;
  remote: Chain ¬ NIL;
  
  z: UNCOUNTED ZONE = Heap.systemZone;

  Chain: TYPE = LONG POINTER TO ChainSlot;
  ChainSlot: TYPE = RECORD [
    next: Chain,
    source: System.NetworkNumber,
    dest: System.NetworkAddress,
    target: LONG STRING];


  ActivateServer: PUBLIC ENTRY PROCEDURE =
    BEGIN
    ScanParameterFile[];
    IF remote = NIL THEN RETURN;
    pleaseStop ¬ FALSE;
    Process.Detach[FORK Server[]];
    END;

  Server: PROCEDURE =
    BEGIN
    soc: Socket.ChannelHandle;
    b: Buffer.NSBuffer;
    soc ¬ Socket.Create[NSConstants.newClearinghouseSocket, 0, 2];
    Socket.SetWaitTime[soc, 10000--ms--];
    DO
      b ¬ NIL;
      b ¬ Socket.GetPacket[soc ! Socket.TimeOut => CONTINUE];
      IF b = NIL THEN LOOP;
      IF b.ns.packetType = packetExchange
        AND b.ns.exchangeType = clearinghouseService
	THEN
        BEGIN
        context: RoutingTable.NetworkContext = b.context;
        FOR finger: Chain ¬ remote, finger.next UNTIL finger = NIL DO
          IF context.netNumber = finger.source THEN
            BEGIN
	    IF finger.dest = System.nullNetworkAddress THEN GOTO Reject;
	    Socket.SetDestination[b, finger.dest];
	    EXIT;
	    END;
	  REPEAT FINISHED => GOTO Reject;
          ENDLOOP;
	RouterInternal.SendPacket[b];  -- Socket.PutPacket smashes b.ns.source
	b ¬ NIL;
	EXITS Reject => NULL;
        END;
      IF b # NIL THEN Buffer.ReturnBuffer[b];
      ENDLOOP;
    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["PhantomCHS"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: System.NetworkNumber = Token.NetworkNumber[cmFile];
	  temp: LONG STRING ¬ Token.Item[cmFile, FALSE];
	  new: Chain ¬ z.NEW[ChainSlot];
	  new­ ¬ [NIL, source, System.nullNetworkAddress, z.NEW[StringBody[temp.length]]];
	  String.AppendString[new.target, temp];
	  [] ¬ Token.FreeTokenString[temp];
	  new.dest ¬ GetAddress[new.target, NSConstants.newClearinghouseSocket ! Trouble => 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[new];
	  END;
        ENDCASE => ERROR;
      ENDLOOP;
    Indirect.Close[cmFile];
    END;

  ForgetParameters: PROCEDURE =
    BEGIN
    UNTIL remote = NIL DO
      temp: Chain ¬ remote;
      remote ¬ remote.next;
      z.FREE[@temp.target];
      z.FREE[@temp];
      ENDLOOP;
    END;

  MessageNet: PROCEDURE [new: Chain] =
    BEGIN
    text: STRING = [200];
    String.AppendString[text, "Forwarding ClearingHouse probes from "L];
    AppendNetNumber[text, new.source];
    String.AppendString[text, " to "L];
    String.AppendString[text, new.target];
    String.AppendString[text, " ("L];
    AppendNetworkAddress[text, new.dest];
    String.AppendString[text, ")"L];
    LogString[text];
    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;

  AppendNetNumber: PROCEDURE [string: LONG STRING, net: System.NetworkNumber] =
    BEGIN
    Append: PROCEDURE [s: LONG STRING, clientData: LONG POINTER] =
      BEGIN String.AppendString[string, s]; END;
    Format.NetworkNumber[Append, net, productSoftware];
    END;

  AppendNetworkAddress: PROCEDURE [string: LONG STRING, addr: System.NetworkAddress] =
    BEGIN
    Append: PROCEDURE [s: LONG STRING, clientData: LONG POINTER] =
      BEGIN String.AppendString[string, s]; END;
    Format.NetworkAddress[Append, addr, productSoftware];
    END;

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

	
  Trouble: ERROR [reason: LONG STRING] = CODE;
  GetAddress: PROCEDURE [host: LONG STRING, socket: System.SocketNumber]
    RETURNS [addr: System.NetworkAddress] =
    BEGIN
    localFailed: BOOLEAN ¬ FALSE;
    IF host = NIL THEN ERROR Trouble ["NIL => Address Fault"L];
    addr ¬ Unformat.NetworkAddress[host, octal !
      Unformat.Error => BEGIN localFailed ¬ TRUE; CONTINUE; END ];
    IF localFailed THEN
      BEGIN
      addr ¬ AddressTranslation.StringToNetworkAddress[host !
        AddressTranslation.Error =>
	  BEGIN
	  temp: STRING = [200];
	  proc: Format.StringProc = {String.AppendString[temp, s]};
	  AddressTranslation.PrintError[errorRecord, proc];
	  ERROR Trouble[temp];
	  END].addr;
        addr.socket ¬ socket;  -- CH returns trash in socket
      END;
    IF addr.socket = System.nullSocketNumber THEN addr.socket ¬ socket;
    END;

  ActivateServer[];
  END.