<> <> <> DIRECTORY Atom USING [GetPName], Basics USING [FWORD], BasicTime USING [GetClockPulses, GMT, Now, Pulses, PulsesToMicroseconds], Buttons USING [Button, ButtonProc, Create, SetDisplayStyle], Commander USING [CommandProc, Register], Containers USING [ChildXBound, ChildYBound, Create], IO USING [Close, Flush, PutF, PutRope, STREAM, Value], Labels USING [Create], Loader USING [BCDBuildTime], Process USING [priorityForeground, SetPriority], Pup USING [Address, nullAddress], PupBuffer USING [Buffer, RoutingInfoResponse], PupHop USING [GetRouting, RoutingTableEntry, unreachable], PupName USING [AddressToRope, Error, HisName, NameLookup], PupSocket USING [AllocBuffer, CreateEphemeral, Destroy, ExtractErrorRope, FreeBuffer, Get, GetUniqueID, GetUserBytes, GetUserSize, Put, SetUserBytes, Socket], PupType USING [], PupWKS USING [gatewayInfo], Rope USING [ROPE], Rules USING [Create], TypeScript USING [ChangeLooks, Create], VFonts USING [FontHeight, StringWidth], ViewerClasses USING [Viewer], ViewerEvents USING [EventProc, RegisterEventProc], ViewerIO USING [CreateViewerStreams], ViewerOps USING [AddProp, ComputeColumn, CreateViewer, FetchProp, MoveViewer, OpenIcon, SetOpenHeight], ViewerTools USING [GetContents, MakeNewTextViewer, SetContents, SetSelection]; PupRouterTool: CEDAR MONITOR IMPORTS Atom, BasicTime, Buttons, Commander, Containers, IO, Labels, Loader, Process, PupHop, PupName, PupSocket, Rules, TypeScript, VFonts, ViewerEvents, ViewerIO, ViewerOps, ViewerTools = BEGIN BYTE: TYPE = [0..100H); ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Viewer: TYPE = ViewerClasses.Viewer; <> buttonHeight: INT _ VFonts.FontHeight[] + 3; buttonWidth: INT _ VFonts.StringWidth["Remote"] + 2*3; ClientData: TYPE = REF ClientDataRep; ClientDataRep: TYPE = RECORD [ log: STREAM _ NIL, in: STREAM _ NIL, target: Viewer _ NIL, where: Pup.Address _ Pup.nullAddress ]; global: ClientData _ NIL; -- debugging Create: Commander.CommandProc = { viewer, buttons, log: Viewer _ NIL; data: ClientData _ NEW[ClientDataRep _ []]; global _ data; viewer _ ViewerOps.CreateViewer [ flavor: $Container, info: [name: "PupRouterTool", column: left, iconic: TRUE, scrollable: FALSE]]; [] _ ViewerEvents.RegisterEventProc[Poof, destroy, viewer, TRUE]; ViewerOps.AddProp[viewer, $PupRouterTool, data]; log _ TypeScript.Create[ [name: "PupRouterTool.log", wy: 27+4, parent: viewer, border: FALSE], FALSE]; [data.in, data.log] _ ViewerIO.CreateViewerStreams [ name: "PupRouterTool.log", backingFile: "///Temp/PupRouterTool.log", viewer: log, editedStream: FALSE]; Containers.ChildXBound[viewer, log]; Containers.ChildYBound[viewer, log]; CreateButtons[data, viewer, log]; TypeScript.ChangeLooks[log, 'f]; IO.PutF[data.log, "PupRouterTool of %G.\n", [time[Loader.BCDBuildTime[Create]]]]; ViewerOps.OpenIcon[viewer]; }; CreateButtons: ENTRY PROC[data: ClientData, parent, log: Viewer] = { child: Viewer _ NIL; kids: Viewer = Containers.Create[ info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ]; Containers.ChildXBound[parent, kids]; child _ MakeRule[kids, child]; child _ data.target _ MakeLabeledText[ parent: kids, sibling: child, name: "Target:", data: "
Target", width: VFonts.StringWidth["Big long name ................................."], prev: data.target ]; child _ MakeRule[kids, child]; child _ MakeLabel[kids, child, "What: "]; child _ MakeButton[kids, child, data, "Remote", RemoteProc]; child _ MakeButton[kids, child, data, "Local", LocalProc]; child _ MakeRule[kids, child]; { kidsY: INTEGER = 2; kidsH: INTEGER = child.wy + child.wh + 2; ViewerOps.MoveViewer[viewer: log, x: 0, y: kidsY + kidsH, w: log.ww, h: parent.ch - (kids.wy + kidsH), paint: FALSE]; ViewerOps.SetOpenHeight[parent, kidsY + kidsH + 12 * buttonHeight]; IF ~parent.iconic THEN ViewerOps.ComputeColumn[parent.column]; ViewerOps.MoveViewer[viewer: kids, x: kids.wx, y: kidsY, w: kids.ww, h: kidsH]; }; }; Poof: ViewerEvents.EventProc = { <<[viewer: ViewerClasses.Viewer, event: ViewerEvent, before: BOOL]>> <> data: ClientData _ NARROW[ViewerOps.FetchProp[viewer, $PupRouterTool]]; IF event # destroy OR before # TRUE THEN ERROR; IO.Close[data.log]; IO.Close[data.in]; }; LocalProc: Buttons.ButtonProc = { <> data: ClientData _ NARROW[clientData]; Local[data]; }; Local: PROC [data: ClientData] = { PrintOne: PROC [net: BYTE] = { rte: PupHop.RoutingTableEntry _ PupHop.GetRouting[[net]]; IF rte.hop = PupHop.unreachable THEN RETURN; nets _ nets + 1; IF k = 0 THEN IO.PutF[data.log, "|"]; IO.PutF[data.log, "%3B%4B#%3B#%4D |", [integer[net]], [integer[rte.immediate.net]], [integer[rte.immediate.host]], [integer[rte.hop]] ]; IF (k _ k + 1) = 4 THEN { IO.PutF[data.log, "\n"]; k _ 0; }; }; k, nets: INT _ 0; IO.PutF[data.log, "\n%G\n", [time[BasicTime.Now[]]] ]; IO.PutF[data.log, "Local Pup Routing Table.\n"]; IO.PutF[data.log, "| Net Via Hops | Net Via Hops | Net Via Hops | Net Via Hops |\n"]; IO.PutF[data.log, "|-----------------|-----------------|-----------------|-----------------|\n"]; FOR net: BYTE IN BYTE DO PrintOne[net]; ENDLOOP; IF k # 0 THEN IO.PutF[data.log, "\n"]; IF nets > 1 THEN IO.PutF[data.log, "There are %D active networks.\n", [integer[nets]]]; }; RemoteProc: Buttons.ButtonProc = { <> data: ClientData _ NARROW[clientData]; target: ROPE = ViewerTools.GetContents[data.target]; Remote[data, target]; }; Remote: PROC [data: ClientData, target: ROPE] = { PrintOne: PROC [info: PupBuffer.RoutingInfoResponse] = { nets _ nets + 1; IF k = 0 THEN IO.PutF[data.log, "|"]; IO.PutF[data.log, "%3B%4B#%3B#%4D |", [integer[info.net]], [integer[info.viaNet]], [integer[info.viaHost]], [integer[info.hop]] ]; IF (k _ k + 1) = 4 THEN { IO.PutF[data.log, "\n"]; k _ 0; }; }; k, nets: INT _ 0; id: Basics.FWORD = PupSocket.GetUniqueID[]; b: PupBuffer.Buffer; socket: PupSocket.Socket; hit: INT _ 0; start: BasicTime.Pulses; buffersToCollect: NAT = 100; buffers: ARRAY [0..buffersToCollect) OF PupBuffer.Buffer _ ALL[NIL]; stop: ARRAY [0..buffersToCollect) OF BasicTime.Pulses; now: ARRAY [0..buffersToCollect) OF BasicTime.GMT; IO.PutF[data.log, "\nGetting Routing info from %G", [rope[target]]]; IF ~FindPath[data, target] THEN RETURN; Process.SetPriority[Process.priorityForeground]; socket _ PupSocket.CreateEphemeral[ remote: data.where, recvBuffers: 25, getTimeout: 5000]; b _ PupSocket.AllocBuffer[socket]; b.id _ id; b.type _ gatewayRequest; PupSocket.SetUserBytes[b, 0]; start _ BasicTime.GetClockPulses[]; PupSocket.Put[socket, b]; FOR i: NAT IN [0..buffersToCollect) DO b _ PupSocket.Get[socket]; IF b = NIL THEN EXIT; buffers[i] _ b; stop[i] _ BasicTime.GetClockPulses[]; now[i] _ BasicTime.Now[]; ENDLOOP; FOR i: NAT IN [0..buffersToCollect) DO b _ buffers[i]; IF b = NIL THEN EXIT; SELECT TRUE FROM (b.type = error) => PrintErrorPup[data, b]; (b.type # gatewayInfo) => IO.PutRope[data.log, "%"]; (b.id # id) => IO.PutRope[data.log, "#"]; ENDCASE => { microseconds: LONG CARDINAL _ BasicTime.PulsesToMicroseconds[stop[i]-start]; entries: NAT = PupSocket.GetUserSize[b]/SIZE[PupBuffer.RoutingInfoResponse]; hit _ hit.SUCC; IO.PutF[data.log, "Response %G from %G in %G microseconds.\n", [integer[hit]], [rope[PupName.HisName[b.source]]], [integer[microseconds]] ]; k _ nets _ 0; FOR i: CARDINAL IN [0..entries) DO PrintOne[b.routing[i]]; ENDLOOP; IF k # 0 THEN IO.PutF[data.log, "\n"]; IF nets > 1 THEN IO.PutF[data.log, "There were %D networks.\n", [integer[nets]]]; IO.PutRope[data.log, "\n"]; }; PupSocket.FreeBuffer[b]; ENDLOOP; PupSocket.Destroy[socket]; IO.Flush[data.log]; }; <<>> PrintErrorPup: PROC [data: ClientData, b: PupBuffer.Buffer] = { length: CARDINAL _ PupSocket.GetUserBytes[b]; IO.PutRope[data.log, "Error Pup from "]; IO.PutRope[data.log, PupName.HisName[b.source]]; IO.PutRope[data.log, ": "]; IO.PutRope[data.log, PupSocket.ExtractErrorRope[b]]; IO.PutRope[data.log, "\n"]; }; FindPath: PROC [data: ClientData, target: ROPE] RETURNS [BOOLEAN] = { rte: PupHop.RoutingTableEntry; data.where _ PupName.NameLookup[target, PupWKS.gatewayInfo ! PupName.Error => { IO.PutF[data.log, " Oops: %G.\n", [rope[text]]]; GOTO Trouble; }]; IO.PutF[data.log, " = %G", [rope[PupName.AddressToRope[data.where]]]]; rte _ PupHop.GetRouting[[data.where.net]]; IF rte.hop # 0 THEN IO.PutF[data.log, " which is %G hops via %G", [integer[rte.hop]], [rope[PupName.AddressToRope[rte.immediate]]] ]; IO.PutRope[data.log, ".\n"]; RETURN[TRUE]; EXITS Trouble => RETURN[FALSE]; }; MakeRule: PROC [parent, sibling: Viewer] RETURNS [child: Viewer] = { child _ Rules.Create[ info: [parent: parent, border: FALSE, wy: IF sibling = NIL THEN 0 ELSE sibling.wy + sibling.wh + 2, wx: 0, ww: parent.ww, wh: 1], paint: FALSE ]; Containers.ChildXBound[parent, child]; }; MakeButton: PROC [parent, sibling: Viewer, data: REF ANY, name: ROPE, proc: Buttons.ButtonProc] RETURNS[child: Viewer] = { child _ Buttons.Create[ info: [name: name, parent: parent, border: TRUE, wy: sibling.wy, wx: sibling.wx + sibling.ww - 1, ww: buttonWidth], proc: proc, clientData: data, fork: TRUE, paint: FALSE]; }; SelectorProc: TYPE = PROC [parent: Viewer, clientData: REF, value: ATOM]; Selector: TYPE = REF SelectorRec; SelectorRec: TYPE = RECORD [ value: REF ATOM, change: PROC [parent: Viewer, clientData: REF, value: ATOM], clientData: REF, buttons: LIST OF Buttons.Button, values: LIST OF ATOM ]; MakeSelector: PROC [name: ROPE, values: LIST OF ATOM, init: REF ATOM _ NIL, change: SelectorProc _ NIL, clientData: REF _ NIL, parent: Viewer, x, y: INTEGER] RETURNS [child: Viewer] = { selector: Selector _ NEW [SelectorRec _ [ value: IF init # NIL THEN init ELSE NEW [ATOM _ values.first], change: change, clientData: clientData, buttons: NIL, values: values ] ]; last: LIST OF Buttons.Button _ NIL; child _ Labels.Create[info: [name: name, parent: parent, border: FALSE, wx: x, wy: y] ]; FOR a: LIST OF ATOM _ values, a.rest UNTIL a = NIL DO child _ Buttons.Create[ info: [name: Atom.GetPName[a.first], parent: parent, border: TRUE, wx: child.wx + child.ww + 2, wy: child.wy], proc: SelectorHelper, clientData: selector, fork: TRUE, paint: TRUE]; IF last = NIL THEN last _ selector.buttons _ CONS[first: child, rest: NIL] ELSE { last.rest _ CONS[first: child, rest: NIL]; last _ last.rest }; IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack]; ENDLOOP; }; SelectorHelper: Buttons.ButtonProc = { <> self: Buttons.Button = NARROW[parent]; selector: Selector = NARROW[clientData]; buttons: LIST OF Buttons.Button _ selector.buttons; FOR a: LIST OF ATOM _ selector.values, a.rest UNTIL a = NIL DO IF self = buttons.first THEN { selector.value^ _ a.first; IF selector.change # NIL THEN selector.change[self.parent, selector.clientData, a.first]; Buttons.SetDisplayStyle[buttons.first, $WhiteOnBlack]; } ELSE Buttons.SetDisplayStyle[buttons.first, $BlackOnWhite]; buttons _ buttons.rest; ENDLOOP; }; BoolProc: TYPE = PROC [parent: Viewer, clientData: REF, value: BOOL]; Bool: TYPE = REF BoolRec; BoolRec: TYPE = RECORD [ value: REF BOOL, change: BoolProc, clientData: REF, button: Viewer ]; MakeBool: PROC [name: ROPE, init: REF BOOL, change: BoolProc _ NIL, clientData: REF _ NIL, parent: Viewer, x, y: INTEGER] RETURNS [child: Viewer] = { bool: Bool _ NEW [BoolRec _ [ value: IF init # NIL THEN init ELSE NEW [BOOL _ TRUE], change: change, clientData: clientData, button: NIL ] ]; child _ Buttons.Create[ info: [name: name, parent: parent, border: TRUE, wx: x, wy: y], proc: BoolHelper, clientData: bool, fork: TRUE, paint: TRUE]; bool.button _ child; IF bool.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack]; }; BoolHelper: Buttons.ButtonProc = { <> self: Buttons.Button = NARROW[parent]; bool: Bool = NARROW[clientData]; bool.value^ _ ~bool.value^; IF bool.value^ THEN Buttons.SetDisplayStyle[bool.button, $WhiteOnBlack] ELSE Buttons.SetDisplayStyle[bool.button, $BlackOnWhite]; IF bool.change # NIL THEN bool.change[self.parent, bool.clientData, bool.value^]; }; MakeLabel: PROC [parent, sibling: Viewer, name: ROPE] RETURNS [child: Viewer] = { child _ Labels.Create[ info: [name: name, parent: parent, border: FALSE, wy: sibling.wy + sibling.wh + (IF sibling.class.flavor = $Button THEN -1 ELSE 2), wx: 2, ww: VFonts.StringWidth[name] + 2*3 + 2], paint: FALSE ]; }; MakeLabeledText: PROC [ parent, sibling: Viewer, name, data: ROPE, prev: Viewer, width: INT, newline: BOOL _ TRUE] RETURNS [child: Viewer] = { buttonWidth: INT _ VFonts.StringWidth[name] + 2*3; x: INTEGER = IF newline THEN 2 ELSE sibling.wx + sibling.ww + 10; y: INTEGER = IF newline THEN sibling.wy + sibling.wh + 1 ELSE sibling.wy; child _ ViewerTools.MakeNewTextViewer[ info: [ parent: parent, wh: buttonHeight, ww: width+10, data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev], border: FALSE, wx: x + buttonWidth + 2, wy: y, scrollable: FALSE ], paint: FALSE ]; [] _ Buttons.Create[ info: [name: name, parent: parent, wh: buttonHeight, border: FALSE, wx: x, wy: y], proc: LabeledTextProc, clientData: child, fork: FALSE, paint: FALSE]; RETURN[child]; }; LabeledTextProc: Buttons.ButtonProc = { <> text: Viewer = NARROW[clientData]; SELECT mouseButton FROM red => ViewerTools.SetSelection[text, NIL]; yellow => NULL; blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] }; ENDCASE => ERROR; }; Commander.Register["PupRouterTool", Create, "Poke Pup Gateways."]; END.