
<< PupTool.mesa; >>
<<     By Steve Temple on August 27, 1982 9:39 am
    Adapted from PupHacks by Hal Murray
    Last edited by Steve Temple, November 11, 1982 2:41 pm
    Revised for Cedar 5.2 by Neil Gunther, February 27, 1985 3:40:54 pm PST

>>
DIRECTORY
   BasicTime: TYPE USING [Now],
   Buttons: TYPE USING [Button, ButtonProc, Create],
   Commander USING [CommandProc, Register],
   Containers: TYPE USING [ChildXBound, ChildYBound, Container, Create],
   Convert USING [RopeFromTime],
   ConvertUnsafe: TYPE USING [AppendRope],
   DriverDefs: TYPE USING [Network],
   IO,
   Labels: TYPE USING [Create, Label, Set, SetDisplayStyle],
   Menus: TYPE USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
   Process: TYPE USING [Pause, SecondsToTicks], 
   PupDefs: TYPE USING [DataWordsPerPupBuffer,
        GetFreePupBuffer, GetPupAddress, GetPupContentsBytes,
        MoveRopeToPupBuffer, ReturnFreePupBuffer, PupAddressToRope,
        PupBuffer, PupNameTrouble, PupPackageDestroy,
        PupPackageMake, PupRouterBroadcastThis, PupSocket,
        PupSocketDestroy, PupSocketMake, SecondsToTocks,
        SetPupContentsBytes],
   PupRouterDefs: TYPE USING [GetRoutingTable, GetRoutingTableEntry, 
        RoutingTableEntry, RoutingTable],
   PupTypes: TYPE USING [echoSoc, fillInPupAddress, fillInSocketID,
        maxDataWordsPerGatewayPup, miscSrvSoc, PupAddress, PupSocketID],
   Rope: TYPE USING [Concat, FromChar, Length, ROPE, Substr],
   TypeScript: TYPE USING [Create],
   VFonts: TYPE USING [CharWidth],
   ViewerClasses: TYPE USING [Viewer, ViewerClassRec],
   ViewerIO: TYPE USING [CreateViewerStreams],
   ViewerOps: TYPE USING [CreateViewer, DestroyViewer, PaintViewer],  
   ViewerTools: TYPE USING [GetContents, MakeNewTextViewer, SetSelection];


PupTool: MONITOR

IMPORTS 
    BasicTime, Buttons, Commander, Containers, Convert, ConvertUnsafe, IO,  Labels,  Menus,
    Process, PupDefs, 
    PupRouterDefs, Rope, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools = BEGIN

entryHeight: CARDINAL = 15;
entryVSpace: CARDINAL = 8;
entryHSpace: CARDINAL = 10;
 
-- a ToolHandle is a REF to the data for a particular instance of the tool.

ToolHandle: TYPE = REF ToolHandleRec;

ToolHandleRec: TYPE = RECORD [
    pleaseStop, echoInUse: BOOL _ FALSE,    -- useful flags
    viewer, root, msg: ViewerClasses.Viewer, -- viewer and parent 
    out: IO.STREAM,                            -- text stream
    echoThrough: CONDITION];                -- echo process is done
    
        
MakeTool: PROC = BEGIN

    handle: ToolHandle _ NEW[ToolHandleRec];
    promptButton, textBox: ViewerClasses.Viewer;
    menu: Menus.Menu _ Menus.CreateMenu[1];
    height: CARDINAL _ 0;
    charSize: INTEGER = VFonts.CharWidth['0];
    initData: Rope.ROPE = "ME";
    
    PupDefs.PupPackageMake[];
        
    handle.root _ Containers.Create[[
        name: "Pup Tool",
        iconic: FALSE,
        menu: menu,
        column: left,
        scrollable: FALSE
        ]];
        

    Menus.AppendMenuEntry[menu: menu, line: 0,
            entry: Menus.CreateEntry[clientData: handle, 
            name: "Destroy", proc: QuitProc, fork: FALSE]];
                
    Menus.AppendMenuEntry[menu: menu, line: 0,
            entry: Menus.CreateEntry[clientData: handle, 
            name: "EchoOn", proc: EchoProc, fork: TRUE]];
                            
    Menus.AppendMenuEntry[menu: menu,  line: 0,
            entry: Menus.CreateEntry[clientData: handle, 
            name: "EchoOff", proc: StopProc, fork: FALSE]];
            
    Menus.AppendMenuEntry[menu: menu, line: 0,
            entry: Menus.CreateEntry[clientData: handle, 
            name: "Route", proc: RouteProc, fork: FALSE]];
                
    Menus.AppendMenuEntry[menu: menu, line: 0,
            entry: Menus.CreateEntry[clientData: handle,
            name: "ToName", proc: ToNameProc, fork: FALSE]];
                
    Menus.AppendMenuEntry[menu: menu,  line: 0,
            entry: Menus.CreateEntry[clientData: handle,
            name: "ToAddress", proc: ToAddressProc, fork: FALSE]];        
    
    height _ height + entryVSpace;
            
    promptButton _ Buttons.Create[
        info: [name: "Name or Address", wy: height, wh: entryHeight, 
               wx: 10*charSize, parent: handle.root],
        proc: Prompt,
        clientData: handle];
                
    handle.viewer _ ViewerTools.MakeNewTextViewer[[
        parent: handle.root,
        wx: promptButton.wx + promptButton.ww + entryHSpace,
        wy: height+2,    -- (hack: add 2 to align text with button baseline)
        ww: 50*charSize,    -- 50 digits worth of width
        wh: entryHeight,
        data: initData,
        scrollable: FALSE,
        border: FALSE
        ]];
        
    height _ height + entryHeight + entryVSpace;
            
    handle.msg _ Labels.Create[[
        parent: handle.root,
        wx: 10*charSize,
        wy: height,
        ww: 80*charSize,    -- 80 digits worth of width
        wh: entryHeight,
        border: FALSE
        ]];
        
    height _ height + entryHeight + entryVSpace;    -- interline spacing
    
    textBox _ TypeScript.Create [[
    parent: handle.root,
    border: FALSE,
    wy: height
    ]];
   
   Containers.ChildXBound[handle.root, textBox]; 
   Containers.ChildYBound[handle.root, textBox];
    
   ViewerOps.PaintViewer[handle.root, all];

    [, handle.out]  _ ViewerIO.CreateViewerStreams[viewer: textBox, name: NIL];
    
   PrintHeaderLine[handle.out];
   END;


Prompt: Buttons.ButtonProc = TRUSTED BEGIN
    handle: ToolHandle _ NARROW[clientData];    -- get our data
    ViewerTools.SetSelection[handle.viewer];        -- force the selection
    END;

PrintHeaderLine: PROC[out: IO.STREAM] = BEGIN
    meID: PupTypes.PupSocketID _ [0,0];
    me: PupTypes.PupAddress _ [,,[0,0]];
--    time: IO.GreenwichMeanTime _ Runtime.GetBcdTime[];
    
     me _ PupDefs.GetPupAddress[meID, "ME"];
     IO.PutF[out, "PupTool of %s running on %s\n", 
           IO.rope[Convert.RopeFromTime[from: BasicTime.Now[]]],
           IO.rope[PupDefs.PupAddressToRope[me]]];
    END;

ErrorMsg: PROC[l: Labels.Label, r: Rope.ROPE _ NIL] = BEGIN
    IF Rope.Length[r] > 70 THEN r _ Rope.Substr[r, 0, 70];
    IF Rope.Length[r] < 62 THEN r _ Rope.Concat["ERROR > ", r];
    Labels.Set[l, r];
    Labels.SetDisplayStyle[l, $WhiteOnBlack];
    Process.Pause[Process.SecondsToTicks[1]];
    Labels.SetDisplayStyle[l, $BlackOnWhite];
    END;
    
ClearMsg: PROC[l: Labels.Label] = BEGIN
    Labels.Set[l, NIL];
    Labels.SetDisplayStyle[l, $BlackOnWhite];
    END;
    
InRope: PROC[v: ViewerClasses.Viewer] RETURNS [r: Rope.ROPE _ NIL] = BEGIN
    r _ ViewerTools.GetContents[v];
    END;
    
PutSep: PROC[out: IO.STREAM] = BEGIN
    IO.PutText[out, "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n"];
    END;
    
NewLine: PROC[out: IO.STREAM] = BEGIN
IO.PutChar[out, '\n];
END;

ErrorPupToRope: PROC[b: PupDefs.PupBuffer]  RETURNS[s: Rope.ROPE]=
    BEGIN
    source: PupTypes.PupAddress _ b.source;
    IF b.pupType=error THEN
        BEGIN
        len: CARDINAL = PupDefs.GetPupContentsBytes[b];
        s _ IO.PutFR["[Error Pup, code=%b, from: ", IO.card[LOOPHOLE[b.errorCode, CARDINAL]]];
        s _ Rope.Concat[s, PupDefs.PupAddressToRope[source]];
        s _ Rope.Concat[s, "] "];
        FOR i: CARDINAL IN [0..len-2*(10+1+1)) DO
              s _ Rope.Concat[s, Rope.FromChar[b.errorText[i]]]; ENDLOOP;
         END
    ELSE
       s _ IO.PutFR["## Funny PupType = %b ##\n ", IO.card[LOOPHOLE[b.pupType, CARDINAL]]];
   END; 


PupBodyToRope: PROC[b: PupDefs.PupBuffer] RETURNS[s: Rope.ROPE]=
  BEGIN
  s _ NIL;
  FOR i: CARDINAL IN [0..PupDefs.GetPupContentsBytes[b]) DO
    s _ Rope.Concat[s, Rope.FromChar[b.pupChars[i]]]; ENDLOOP;
  END;


EchoProc: Menus.MenuProc = TRUSTED
  BEGIN OPEN PupDefs, PupTypes;
  
  h: ToolHandle = NARROW[clientData];
  bytesPerBuffer: CARDINAL;
  funny, late, recv, sent, wrong: LONG CARDINAL _ 0;
  me, where: PupAddress _ [,,echoSoc];
  mySoc: PupSocket;
  mySocID: PupSocketID _ [0,0];
  packetNumber: CARDINAL _ 0;
  routing: PupRouterDefs.RoutingTableEntry;
  r: Rope.ROPE;
  fudge: STRING _ [40];

  IF EchoIsInUse[h] THEN RETURN;
  ClearMsg[h.msg]; 
  r _ InRope[h.viewer];
  IF Rope.Length[r] = 0 THEN { ErrorMsg[h.msg, "Name needed"]; GOTO GetOut};
  ConvertUnsafe.AppendRope[fudge, r];
  where _ GetPupAddress[mySocID, r ! PupNameTrouble =>
      {ErrorMsg[h.msg, e]; GOTO GetOut }];
  mySoc _ PupSocketMake[fillInSocketID, where, SecondsToTocks[2]];
  me _ mySoc.getLocalAddress[];
  
  PutSep[h.out];
  IO.PutF[h.out, "Echo to <%g> via [%g] => [", IO.rope[r], IO.rope[PupAddressToRope[me]]];
  routing _ PupRouterDefs.GetRoutingTableEntry[where.net];
  IF (routing.hop#0) AND (routing.network#NIL) THEN 
  IO.PutF[h.out, "%b#%b#] => [", 
       IO.card[LOOPHOLE[routing.network.netNumber.b, CARDINAL]], 
       IO.card[LOOPHOLE[routing.route, CARDINAL]]];    
  IO.PutF[h.out, "%g]\n", IO.rope[PupAddressToRope[where]]];
  
  bytesPerBuffer _
    2*MIN[DataWordsPerPupBuffer[], maxDataWordsPerGatewayPup];
  UNTIL EchoShouldStop[h] DO
    FOR len: CARDINAL IN [0..bytesPerBuffer] UNTIL EchoShouldStop[h] DO
      b: PupBuffer _ GetFreePupBuffer[];
      b.pupID.a _ b.pupID.b _ (packetNumber_packetNumber+1);
      b.pupType _ echoMe;
      SetPupContentsBytes[b,len];
      FOR i: CARDINAL IN [0..len) DO b.pupBytes[i] _ i MOD 400B; ENDLOOP;
      mySoc.put[b];
      sent _ sent+1;
        UNTIL (b_mySoc.get[])=NIL DO
        SELECT TRUE FROM
          (b.pupType#iAmEcho) =>
            { funny _ funny+1; ErrorMsg[h.msg, ErrorPupToRope[b]];
              IO.PutChar[h.out, 'x]; GOTO Wrong };
          ((b.pupID.a#packetNumber)
           OR (b.pupID.b#packetNumber)
           OR (len#GetPupContentsBytes[b])) =>
            { IO.PutChar[h.out, '#]; late _ late+1 };
          ENDCASE =>
            BEGIN
            FOR i: CARDINAL IN [0..len) DO
              IF b.pupBytes[i]#(i MOD 400B) THEN
                { wrong _ wrong+1; IO.PutChar[h.out, '~]; GOTO Wrong };
              ENDLOOP;
            IO.PutChar[h.out, '!];
            recv _ recv+1;
            EXIT;
            END;
        ReturnFreePupBuffer[b];
        REPEAT Wrong => NULL;
        ENDLOOP;
      IF b#NIL THEN ReturnFreePupBuffer[b] ELSE IO.PutChar[h.out, '?];
      ENDLOOP;
    NewLine[h.out];
    ENDLOOP;
  PupSocketDestroy[mySoc];
  IO.PutF[h.out, "Out: %d, In: %d (%d%%)\n", IO.card[sent], IO.card[recv], IO.card[(recv*100)/sent]];
  IF late#0    THEN IO.PutF[h.out, "Late: %d (%d%%)\n", IO.card[late], IO.card[(late*100)/sent]];
  IF funny#0 THEN IO.PutF[h.out, "%d funny\n", IO.card[funny]];
  IF wrong#0 THEN IO.PutF[h.out, "%d wrong data\n", IO.card[wrong]];
  EchoUserStopped[h];
  EXITS GetOut => {h: ToolHandle = NARROW[clientData]; EchoUserStopped[h]};
  END;
    
RouteProc: Menus.MenuProc = TRUSTED BEGIN
  pupRt: PupRouterDefs.RoutingTable;
  h: ToolHandle _ NARROW[clientData];
  k: CARDINAL _ 0;

  PutSep[h.out];
  ClearMsg[h.msg];
  IO.PutText[h.out, "Local PupRouting Table\n"];
  IO.PutText[h.out, "|  Net   Via   Hops |  Net   Via   Hops  |  Net   Via   Hops  |\n"];
  IO.PutText[h.out, "|-------------------|-------------------|-------------------|\n"];
  pupRt _ PupRouterDefs.GetRoutingTable[];
  
  FOR i: CARDINAL IN [0..pupRt.length] DO
    r: PupRouterDefs.RoutingTableEntry = @pupRt[i];
    network: DriverDefs.Network = r.network;
    IF network=NIL THEN LOOP;
    IF k=0 THEN IO.PutChar[h.out, '|];
    IO.PutF[h.out, "%4b%4b#", IO.card[i],
       IO.card[LOOPHOLE[network.netNumber.b, CARDINAL]]];
    
    IO.PutF[h.out, "%03b#%4b   |", 
       IO.card[IF r.hop#0 THEN r.route ELSE network.hostNumber], IO.card[r.hop]];
    IF (k_k+1)=3 THEN {NewLine[h.out]; k_0};
    ENDLOOP;
  IF k#0 THEN NewLine[h.out];
  END;

    
ToNameProc: Menus.MenuProc = TRUSTED
  BEGIN OPEN PupTypes, PupDefs;
  h: ToolHandle = NARROW[clientData];
  soc: PupSocket;
  b: PupBuffer;
  addrID: PupSocketID _ [0, 0];
  addr: PupAddress _ [, , [0, 0]];
  hit: BOOLEAN _ FALSE;
  r: Rope.ROPE;
  
  r _ InRope[h.viewer];
  ClearMsg[h.msg];
  IF Rope.Length[r] = 0 THEN BEGIN ErrorMsg[h.msg, "Address needed"]; RETURN; END;  
  addr _ GetPupAddress[addrID, r ! PupNameTrouble =>
                            BEGIN
                            ErrorMsg[h.msg, e];
                            GOTO NoName;
                            END];
  soc _ PupSocketMake[fillInSocketID, fillInPupAddress, SecondsToTocks[2]];
        
  THROUGH [0..10) UNTIL hit DO
    b _ GetFreePupBuffer[];
    b.pupType _ addressLookup;
    b.pupID _ [0, 0];
    b.dest.socket _ PupTypes.miscSrvSoc;
    b.source _ soc.getLocalAddress[];
    b.address _ addr;
    SetPupContentsBytes[b, 2*SIZE[PupAddress]];
    PupRouterBroadcastThis[b];
    UNTIL hit OR (b _ soc.get[]) = NIL DO
    SELECT b.pupType FROM
      addressIs =>
        BEGIN
        hit _ TRUE;
        PutSep[h.out];
        IO.PutF[h.out, "Name of <%g> is: %g\n", IO.rope[r], IO.rope[PupBodyToRope[b]]];
        END;
      nameError =>
        BEGIN
        hit _ TRUE;
        ErrorMsg[h.msg, PupBodyToRope[b]];
        END;
      ENDCASE => ErrorMsg[h.msg, ErrorPupToRope[b]];
    ReturnFreePupBuffer[b];
    ENDLOOP;
    IF ~hit THEN ErrorMsg[h.msg, "No Response that try"];
    ENDLOOP;
  PupSocketDestroy[soc];
  EXITS NoName => NULL;
  END;
    
        
ToAddressProc: Menus.MenuProc = TRUSTED
  BEGIN OPEN PupTypes, PupDefs;
  h: ToolHandle = NARROW[clientData];
  soc: PupSocket;
  b: PupBuffer;
  hit: BOOLEAN _ FALSE;
  r: Rope.ROPE;  
  
  r _ InRope[h.viewer];
  ClearMsg[h.msg];
  IF Rope.Length[r] = 0 THEN BEGIN ErrorMsg[h.msg, "Name needed"]; RETURN; END;  
  soc _ PupSocketMake[fillInSocketID, fillInPupAddress, SecondsToTocks[2]];
  THROUGH [0..10) UNTIL hit DO
    b _ GetFreePupBuffer[];
    b.pupType _ nameLookup;
    b.pupID _ [0, 0];
    b.dest.socket _ PupTypes.miscSrvSoc;
    b.source _ soc.getLocalAddress[];
    PupDefs.MoveRopeToPupBuffer[b, r];
    PupRouterBroadcastThis[b];
    UNTIL hit OR (b _ soc.get[]) = NIL DO
    SELECT b.pupType FROM
      nameIs =>
        BEGIN
        n: CARDINAL _ GetPupContentsBytes[b]/(2*SIZE[PupAddress]);
        addresses: LONG POINTER TO ARRAY [0..0) OF PupAddress _
          LOOPHOLE[@b.pupBody];
        hit _ TRUE;
        PutSep[h.out];
        IO.PutF[h.out, "Address of <%g> is: ", IO.rope[r]];
        FOR i: CARDINAL IN [0..n) DO
          IF i # 0 THEN IO.PutText[h.out, ", "];
          IO.PutRope[h.out, PupAddressToRope[addresses[i]]];
          ENDLOOP;
        NewLine[h.out];
        END;
      nameError =>
        BEGIN
        hit _ TRUE;
        ErrorMsg[h.msg, PupBodyToRope[b]];
        END;
      ENDCASE => ErrorMsg[h.msg, ErrorPupToRope[b]];
    ReturnFreePupBuffer[b];
    ENDLOOP;
   IF ~hit THEN ErrorMsg[h.msg, "No Response that try"];
   ENDLOOP;
  PupSocketDestroy[soc];
 END;
 
QuitProc: Menus.MenuProc = TRUSTED 
  BEGIN
    h: ToolHandle = NARROW[clientData];
    StopEchoUser[h];
    ViewerOps.DestroyViewer[h.root];
    PupDefs.PupPackageDestroy[];
    END;
 
StopProc: Menus.MenuProc = TRUSTED
  BEGIN
    h: ToolHandle = NARROW[clientData];
    StopEchoUser[h];
    END;

StopEchoUser: ENTRY PROC [h: ToolHandle] =
    BEGIN
    h.pleaseStop _ TRUE;
    UNTIL NOT h.echoInUse DO WAIT h.echoThrough ENDLOOP;
    h.pleaseStop _ FALSE;
    END;

EchoShouldStop: ENTRY PROC [h: ToolHandle] RETURNS[BOOLEAN] = INLINE
   {RETURN[h.pleaseStop]};

EchoUserStopped: ENTRY PROC [h: ToolHandle]  =
    {h.echoInUse _ FALSE; NOTIFY h.echoThrough};

EchoIsInUse: ENTRY PROC [h: ToolHandle] RETURNS [BOOLEAN] =
    {IF h.echoInUse THEN RETURN [TRUE]; h.echoInUse _ TRUE; RETURN[FALSE]};


DoIt: Commander.CommandProc = TRUSTED BEGIN
    MakeTool[]    
    END;

Commander.Register[key: "PupTool",  proc: DoIt,  doc: "Simple network interogation program"];

MakeTool[]

END.