-- File: NameLookupTool.mesa - last edit:
-- AOF                  3-Feb-88 18:55:23
-- WIrish               5-Feb-88 12:19:58
-- HGM                 25-Jun-85  3:36:16
-- Copyright (C) 1984, 1985, 1988 by Xerox Corporation. All rights reserved. 

DIRECTORY
  FormSW USING [
    ClientItemsProcType, ProcType, AllocateItemDescriptor, newLine, CommandItem,
    StringItem],
  Heap USING [systemZone],
  MsgSW USING [Post],
  Put USING [Char, CR, Text, Line, LongDecimal],
  Runtime USING [GetBcdTime],
  String USING [AppendString, AppendNumber, WordsForString],
  Time USING [Append, AppendCurrent, Unpack],
  Tool USING [
    Create, MakeSWsProc, MakeMsgSW, MakeFormSW, MakeFileSW, UnusedLogName],
  ToolWindow USING [TransitionProcType],
  Window USING [Handle],

  NameServerDefs USING [
    nameStatsRequest, nameStatsReply, NameStatsEntry,
    nameToCacheRequest, addressToCacheRequest, hereIsCacheEntry],
  PupWireFormat USING [BcplToMesaLongNumber],
  PupDefs USING [
    PupPackageMake, PupPackageDestroy, Body,
    PupBuffer, PupSocket, PupSocketDestroy, PupSocketMake, SecondsToTocks,
    GetPupContentsBytes, SetPupContentsWords, MoveStringBodyToPupBuffer,
    AppendPupAddress, AppendErrorPup, GetPupAddress, PupNameTrouble,
    AccessHandle, DestroyPool, GetBuffer, MakePool, ReturnBuffer],
  PupTypes USING [PupAddress, fillInNetID, fillInSocketID, allHosts, miscSrvSoc];

NameLookupTool: PROGRAM
  IMPORTS
    FormSW, Heap, MsgSW, Put, Runtime, String, Time, Tool, PupWireFormat, PupDefs =
  BEGIN OPEN PupDefs, PupTypes;

  z: UNCOUNTED ZONE = Heap.systemZone;

  msg, form, log: Window.Handle;

  data: LONG POINTER TO Data ← NIL;

  Data: TYPE = RECORD [
    where: PupAddress,
    target: LONG STRING,
    name: LONG STRING,
    address: LONG STRING];

  Stats: FormSW.ProcType =
    BEGIN
    pool: PupDefs.AccessHandle;
    soc: PupSocket;
    b: PupBuffer;
    body: PupDefs.Body;
    hit: BOOLEAN ← FALSE;
    WriteCR[];
    WriteCurrentDateAndTime[];
    WriteString["  Pup Name Server Statistics "L];
    IF ~FindPath[] THEN RETURN;
    pool ← PupDefs.MakePool[send: 1, receive: 2];
    soc ← PupSocketMake[PupTypes.fillInSocketID, data.where, SecondsToTocks[2]];
    THROUGH [0..10) UNTIL hit DO
      b ← PupDefs.GetBuffer[pool, send];
      body ← b.pup;
      body.pupType ← NameServerDefs.nameStatsRequest;
      body.pupID ← [0, 0];
      body.pupWords[0] ← 0;
      SetPupContentsWords[b, 0];
      soc.put[b];
      UNTIL (b ← soc.get[]) = NIL DO
        body ← b.pup;
        IF data.where # body.source THEN
          BEGIN
          WriteString["Reply from: "L];
          PrintPupAddress[@body.source];
          WriteCR[];
          END;
        SELECT body.pupType FROM
          NameServerDefs.nameStatsReply =>
            BEGIN
            nse: LONG POINTER TO NameServerDefs.NameStatsEntry;
            hit ← TRUE;
            nse ← LOOPHOLE[@body.pupWords];
            PrintInfo[
              "Requests"L, PupWireFormat.BcplToMesaLongNumber[nse.nameRequests]];
            PrintInfo[
              "Directories sent"L, PupWireFormat.BcplToMesaLongNumber[
              nse.directoriesSend]];
            PrintInfo[
              "Cache hits"L, PupWireFormat.BcplToMesaLongNumber[nse.cacheHits]];
            PrintInfo[
              "Cache misses"L, PupWireFormat.BcplToMesaLongNumber[
              nse.cacheMisses]];
            END;
          ENDCASE => PrintErrorPup[b];
        WriteCR[];
        PupDefs.ReturnBuffer[b];
        ENDLOOP;
      IF ~hit THEN MsgSW.Post[msg, "No Response that try."L];
      ENDLOOP;
    PupSocketDestroy[soc];
    PupDefs.DestroyPool[pool];
    END;

  Version: FormSW.ProcType =
    BEGIN
    pool: PupDefs.AccessHandle;
    soc: PupSocket;
    b: PupBuffer;
    body: PupDefs.Body;
    hit: BOOLEAN ← FALSE;
    WriteCR[];
    WriteCurrentDateAndTime[];
    WriteString["  Pup Network Directory Version "L];
    IF ~FindPath[] THEN RETURN;
    pool ← PupDefs.MakePool[send: 1, receive: 2];
    soc ← PupSocketMake[PupTypes.fillInSocketID, data.where, SecondsToTocks[2]];
    THROUGH [0..10) UNTIL hit DO
      b ← PupDefs.GetBuffer[pool, send];
      body ← b.pup;
      body.pupType ← netDirVersion;
      body.pupID ← [0, 0];
      body.pupWords[0] ← 0;
      SetPupContentsWords[b, 1];
      soc.put[b];
      UNTIL (b ← soc.get[]) = NIL DO
        body ← b.pup;
        IF data.where # body.source THEN
          BEGIN
          WriteString["Reply from: "L];
          PrintPupAddress[@body.source];
          WriteCR[];
          END;
        SELECT body.pupType FROM
          netDirVersion =>
            BEGIN
            hit ← TRUE;
            WriteString["Pup-network.directory version is "L];
            WriteDecimal[body.pupWords[0]];
	    IF GetPupContentsBytes[b] > 2 THEN
	      BEGIN
	      WriteLine["."L];
              WriteString["Pup-network.big version is "L];
              WriteDecimal[body.pupWords[1]];
	      END;
            END;
          ENDCASE => PrintErrorPup[b];
        WriteLine["."L];
        PupDefs.ReturnBuffer[b];
        ENDLOOP;
      IF ~hit THEN MsgSW.Post[msg, "No Response that try."L];
      ENDLOOP;
    PupSocketDestroy[soc];
    PupDefs.DestroyPool[pool];
    END;

  NameToAddress: FormSW.ProcType =
    BEGIN
    pool: PupDefs.AccessHandle;
    soc: PupSocket;
    b: PupBuffer;
    body: PupDefs.Body;
    hit: BOOLEAN ← FALSE;
    IF data.name = NIL OR data.name.length = 0 THEN
      BEGIN MsgSW.Post[msg, "Name needed"L]; RETURN; END;
    WriteCR[];
    WriteCurrentDateAndTime[];
    WriteString["  Name=>Address "L];
    IF ~FindPath[] THEN RETURN;
    pool ← PupDefs.MakePool[send: 1, receive: 2];
    soc ← PupSocketMake[PupTypes.fillInSocketID, data.where, SecondsToTocks[2]];
    THROUGH [0..10) UNTIL hit DO
      b ← PupDefs.GetBuffer[pool, send];
      body ← b.pup;
      body.pupType ← nameLookup;
      MoveStringBodyToPupBuffer[b, data.name];
      body.pupID ← [0, 0];
      soc.put[b];
      UNTIL (b ← soc.get[]) = NIL DO
        body ← b.pup;
        IF data.where # body.source THEN
          BEGIN
          WriteString["Reply from: "L];
          PrintPupAddress[@body.source];
          WriteCR[];
          END;
        SELECT body.pupType FROM
          nameIs =>
            BEGIN
            i, n: CARDINAL;
            addresses: LONG POINTER TO ARRAY [0..0) OF PupAddress ←
              LOOPHOLE[@body.pupBody];
            hit ← TRUE;
            WriteString[data.name];
            WriteString[" => "L];
            n ← GetPupContentsBytes[b]/(2*SIZE[PupAddress]);
            FOR i IN [0..n) DO
              IF i # 0 THEN WriteString[", "L];
              PrintPupAddress[@addresses[i]];
              ENDLOOP;
            END;
          nameError =>
            BEGIN
            hit ← TRUE;
            WriteString[data.name];
            WriteString[" => ERROR: "L];
            PrintBodyAsText[b];
            END;
          ENDCASE => PrintErrorPup[b];
        WriteCR[];
        PupDefs.ReturnBuffer[b];
        ENDLOOP;
      IF ~hit THEN MsgSW.Post[msg, "No Response that try."L];
      ENDLOOP;
    PupSocketDestroy[soc];
    PupDefs.DestroyPool[pool];
    END;

  NameToCache: FormSW.ProcType =
    BEGIN
    pool: PupDefs.AccessHandle;
    soc: PupSocket;
    b: PupBuffer;
    body: PupDefs.Body;
    hit: BOOLEAN ← FALSE;
    IF data.name = NIL OR data.name.length = 0 THEN
      BEGIN MsgSW.Post[msg, "Name needed"L]; RETURN; END;
    WriteCR[];
    WriteCurrentDateAndTime[];
    WriteString["  Name=>CacheEntry "L];
    IF ~FindPath[] THEN RETURN;
    pool ← PupDefs.MakePool[send: 1, receive: 2];
    soc ← PupSocketMake[PupTypes.fillInSocketID, data.where, SecondsToTocks[2]];
    THROUGH [0..10) UNTIL hit DO
      b ← PupDefs.GetBuffer[pool, send];
      body ← b.pup;
      body.pupType ← NameServerDefs.nameToCacheRequest;
      MoveStringBodyToPupBuffer[b, data.name];
      body.pupID ← [0, 0];
      soc.put[b];
      UNTIL (b ← soc.get[]) = NIL DO
        body ← b.pup;
        IF data.where # body.source THEN
          BEGIN
          WriteString["Reply from: "L];
          PrintPupAddress[@body.source];
          WriteCR[];
          END;
        SELECT body.pupType FROM
          NameServerDefs.hereIsCacheEntry =>
            BEGIN
            hit ← TRUE;
	    PrintCacheEntry[b];
            END;
          nameError =>
            BEGIN
            hit ← TRUE;
            WriteString[data.name];
            WriteString[" => ERROR: "L];
            PrintBodyAsText[b];
            END;
          ENDCASE => PrintErrorPup[b];
        WriteCR[];
        PupDefs.ReturnBuffer[b];
        ENDLOOP;
      IF ~hit THEN MsgSW.Post[msg, "No Response that try."L];
      ENDLOOP;
    PupSocketDestroy[soc];
    PupDefs.DestroyPool[pool];
    END;

  AddressToName: FormSW.ProcType =
    BEGIN
    pool: PupDefs.AccessHandle;
    soc: PupSocket;
    b: PupBuffer;
    body: PupDefs.Body;
    a: PupAddress ← [, , [0, 0]];
    hit: BOOLEAN ← FALSE;
    IF data.address = NIL OR data.address.length = 0 THEN
      BEGIN MsgSW.Post[msg, "Address needed"L]; RETURN; END;
    GetPupAddress[
      @a, data.address !
      PupNameTrouble =>
        BEGIN MsgSW.Post[msg, e]; WriteLine[e]; GOTO Trouble; END];
    WriteCR[];
    WriteCurrentDateAndTime[];
    WriteString["  Address=>Name "L];
    IF ~FindPath[] THEN RETURN;
    pool ← PupDefs.MakePool[send: 1, receive: 10];
    soc ← PupSocketMake[PupTypes.fillInSocketID, data.where, SecondsToTocks[2]];
    THROUGH [0..10) UNTIL hit DO
      b ← PupDefs.GetBuffer[pool, send];
      body ← b.pup;
      body.pupType ← addressLookup;
      body.pupID ← [0, 0];
      body.address ← a;
      SetPupContentsWords[b, SIZE[PupAddress]];
      soc.put[b];
      UNTIL (b ← soc.get[]) = NIL DO
        body ← b.pup;
        IF data.where # body.source THEN
          BEGIN
          WriteString["Reply from: "L];
          PrintPupAddress[@body.source];
          WriteCR[];
          END;
        SELECT body.pupType FROM
          addressIs =>
            BEGIN
            hit ← TRUE;
            WriteString[data.address];
            WriteString[" => "L];
            PrintBodyAsText[b];
            END;
          nameError =>
            BEGIN
            hit ← TRUE;
            WriteString[data.address];
            WriteString[" => ERROR: "L];
            PrintBodyAsText[b];
            END;
          ENDCASE => PrintErrorPup[b];
        WriteLine["."L];
        PupDefs.ReturnBuffer[b];
        ENDLOOP;
      IF ~hit THEN MsgSW.Post[msg, "No Response that try."L];
      ENDLOOP;
    PupSocketDestroy[soc];
    PupDefs.DestroyPool[pool];
    EXITS Trouble => NULL;
    END;

  AddressToCache: FormSW.ProcType =
    BEGIN
    pool: PupDefs.AccessHandle;
    soc: PupSocket;
    b: PupBuffer;
    body: PupDefs.Body;
    a: PupAddress ← [, , [0, 0]];
    hit: BOOLEAN ← FALSE;
    IF data.address = NIL OR data.address.length = 0 THEN
      BEGIN MsgSW.Post[msg, "Address needed"L]; RETURN; END;
    GetPupAddress[
      @a, data.address !
      PupNameTrouble =>
        BEGIN MsgSW.Post[msg, e]; WriteLine[e]; GOTO Trouble; END];
    WriteCR[];
    WriteCurrentDateAndTime[];
    WriteString["  Address=>CacheEntry "L];
    IF ~FindPath[] THEN RETURN;
    pool ← PupDefs.MakePool[send: 1, receive: 2];
    soc ← PupSocketMake[PupTypes.fillInSocketID, data.where, SecondsToTocks[2]];
    THROUGH [0..10) UNTIL hit DO
      b ← PupDefs.GetBuffer[pool, send];
      body ← b.pup;
      body.pupType ← NameServerDefs.addressToCacheRequest;
      body.pupID ← [0, 0];
      body.address ← a;
      SetPupContentsWords[b, SIZE[PupAddress]];
      soc.put[b];
      UNTIL (b ← soc.get[]) = NIL DO
        body ← b.pup;
        IF data.where # body.source THEN
          BEGIN
          WriteString["Reply from: "L];
          PrintPupAddress[@body.source];
          WriteCR[];
          END;
        SELECT body.pupType FROM
          NameServerDefs.hereIsCacheEntry =>
            BEGIN
            hit ← TRUE;
            PrintCacheEntry[b];
            END;
          nameError =>
            BEGIN
            hit ← TRUE;
            WriteString[data.address];
            WriteString[" => ERROR: "L];
            PrintBodyAsText[b];
            END;
          ENDCASE => PrintErrorPup[b];
        WriteLine["."L];
        PupDefs.ReturnBuffer[b];
        ENDLOOP;
      IF ~hit THEN MsgSW.Post[msg, "No Response that try."L];
      ENDLOOP;
    PupSocketDestroy[soc];
    PupDefs.DestroyPool[pool];
    EXITS Trouble => NULL;
    END;

  FindPath: PROCEDURE RETURNS [BOOLEAN] =
    BEGIN OPEN data;
    data.where ← [fillInNetID, allHosts, miscSrvSoc];
    IF data.target = NIL OR data.target.length = 0 THEN
      BEGIN WriteLine["via broadcasting on local net(s)."L]; RETURN[TRUE]; END
    ELSE BEGIN WriteString["from "L]; END;
    WriteString[target];
    WriteChar['=];
    GetPupAddress[
      @where, target !
      PupNameTrouble =>
        BEGIN MsgSW.Post[msg, e]; WriteLine[e]; GOTO Trouble; END];
    PrintPupAddress[@where];
    WriteLine["."L];
    RETURN[TRUE];
    EXITS Trouble => RETURN[FALSE];
    END;

  -- IO things

  WriteChar: PROCEDURE [c: CHARACTER] = BEGIN Put.Char[log, c]; END;

  WriteCR: PROCEDURE = BEGIN Put.CR[log]; END;

  WriteString: PROCEDURE [s: LONG STRING] = BEGIN Put.Text[log, s]; END;

  WriteLine: PROCEDURE [s: LONG STRING] = BEGIN Put.Line[log, s]; END;

  WriteDecimal: PROCEDURE [n: CARDINAL] = INLINE BEGIN WriteNumber[n, 10, 0]; END;

  WriteOctal: PROCEDURE [n: CARDINAL] = INLINE BEGIN WriteNumber[n, 8, 0]; END;

  WriteNumber: PROCEDURE [n, radix, width: CARDINAL] = INLINE
    BEGIN
    temp: STRING = [25];
    String.AppendNumber[temp, n, radix];
    THROUGH [temp.length..width) DO WriteChar[' ]; ENDLOOP;
    WriteString[temp];
    END;

  WriteLongDecimal: PROCEDURE [n: LONG CARDINAL] = INLINE
    BEGIN Put.LongDecimal[log, n]; END;

  D8: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 10, 8]; END;

  O3: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 8, 3]; END;

  O3Z: PROCEDURE [n: CARDINAL] =
    BEGIN
    temp: STRING = [25];
    String.AppendNumber[temp, n, 8];
    THROUGH [temp.length..3) DO WriteChar['0]; ENDLOOP;
    WriteString[temp];
    END;

  O4: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 8, 4]; END;

  O6: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 8, 3]; END;

  O9: PROCEDURE [n: CARDINAL] = BEGIN WriteNumber[n, 8, 9]; END;

  WriteCurrentDateAndTime: PROCEDURE =
    BEGIN temp: STRING = [20]; Time.AppendCurrent[temp]; WriteString[temp]; END;

  PrintInfo: PROCEDURE [s: LONG STRING, n: LONG CARDINAL] =
    BEGIN
    IF n = 0 THEN RETURN;
    WriteString[s];
    WriteString[" = "L];
    WriteLongDecimal[n];
    WriteLine["."L];
    END;

  PrintPupAddress: PROCEDURE [a: LONG POINTER TO PupAddress] =
    BEGIN temp: STRING = [40]; AppendPupAddress[temp, a↑]; WriteString[temp]; END;

  PrintErrorPup: PROCEDURE [b: PupBuffer] =
    BEGIN temp: STRING = [200]; AppendErrorPup[temp, b]; WriteString[temp]; END;

  PrintBodyAsText: PROCEDURE [b: PupBuffer] =
    BEGIN
    FOR i: CARDINAL IN [0..GetPupContentsBytes[b]) DO
      WriteChar[b.pup.pupChars[i]]; ENDLOOP;
    END;

  PrintCacheEntry: PROCEDURE [b: PupBuffer] =
    BEGIN
    p: LONG POINTER ← @b.pup.pupWords;
    n: CARDINAL ← 0;
    version: CARDINAL;
    names: CARDINAL;
    addrs: CARDINAL;
    version ← (p+n)↑;  -- File version number
    n ← n + SIZE[CARDINAL];
    names ← (p+n)↑;
    n ← n + SIZE[CARDINAL];
    IF names = 0 THEN WriteString["??"L];
    FOR i: CARDINAL IN [0..names) DO
      s: LONG STRING = LOOPHOLE[p+n];
      words: CARDINAL ← String.WordsForString[s.length];
      IF i # 0 THEN WriteString[", "L];
      WriteString[s];
      n ← n + words;
      ENDLOOP;
    WriteString[" <=> "L];
    addrs ← (p+n)↑;
    n ← n + SIZE[CARDINAL];
    IF addrs = 0 THEN WriteString["??"L];
    FOR i: CARDINAL IN [0..addrs) DO
      a: LONG POINTER TO PupAddress ← LOOPHOLE[(p+n)];
      IF i # 0 THEN WriteString[", "L];
      PrintPupAddress[a];
      n ← n + SIZE[PupAddress];
      ENDLOOP;
    END;

  Init: PROCEDURE =
    BEGIN
    herald: LONG STRING = [100];
    String.AppendString[herald, "Name Lookup of "L];
    Time.Append[herald, Time.Unpack[Runtime.GetBcdTime[]]];
    [] ← Tool.Create[
      name: herald, makeSWsProc: MakeSWs, clientTransition: ClientTransition];
    END;

  MakeSWs: Tool.MakeSWsProc =
    BEGIN
    logFileName: STRING = [40];
    msg ← Tool.MakeMsgSW[window: window, lines: 5];
    form ← Tool.MakeFormSW[window: window, formProc: MakeForm];
    Tool.UnusedLogName[logFileName, "NameLookup.log$"L];
    log ← Tool.MakeFileSW[window: window, name: logFileName, allowTypeIn: FALSE];
    END;

  MakeForm: FormSW.ClientItemsProcType =
    BEGIN
    i: INTEGER ← -1;
    nParams: CARDINAL = 9;
    items ← FormSW.AllocateItemDescriptor[nParams];
    items[i ← i + 1] ← FormSW.CommandItem[tag: "Stats"L, proc: Stats, place: FormSW.newLine];
    items[i ← i + 1] ← FormSW.CommandItem[tag: "Version"L, proc: Version];
    items[i ← i + 1] ← FormSW.StringItem[tag: "Target"L, string: @data.target, inHeap: TRUE];
    items[i ← i + 1] ← FormSW.CommandItem[
      tag: "NameToAddress"L, proc: NameToAddress, place: FormSW.newLine];
    items[i ← i + 1] ← FormSW.CommandItem[tag: "NameToCache"L, proc: NameToCache];
    items[i ← i + 1] ← FormSW.StringItem[tag: "Name"L, string: @data.name, inHeap: TRUE];
    items[i ← i + 1] ← FormSW.CommandItem[
      tag: "AddressToName"L, proc: AddressToName, place: FormSW.newLine];
    items[i ← i + 1] ← FormSW.CommandItem[tag: "AddressToCache"L, proc: AddressToCache];
    items[i ← i + 1] ← FormSW.StringItem[tag: "Address"L, string: @data.address, inHeap: TRUE];
    RETURN[items, TRUE];
    END;

  AlreadyActive: ERROR = CODE;
  NotActive: ERROR = CODE;

  ClientTransition: ToolWindow.TransitionProcType =
    BEGIN
    SELECT TRUE FROM
      old = inactive =>
        BEGIN
        IF data # NIL THEN ERROR AlreadyActive;
        data ← z.NEW[Data];
        data↑ ← [
          where:, target: z.NEW[StringBody[20]], name: z.NEW[StringBody[20]],
          address: z.NEW[StringBody[20]] ];
        String.AppendString[data.target, "ME"L];
        [] ← PupDefs.PupPackageMake[];
        END;
      new = inactive =>
        BEGIN
        IF data = NIL THEN ERROR NotActive;
        PupDefs.PupPackageDestroy[];
        z.FREE[@data.target];
        z.FREE[@data.name];
        z.FREE[@data.address];
        z.FREE[@data];
        END;
      ENDCASE;
    END;

  -- Main Body
  Init[];
  END.