DIRECTORY
Atom USING [GetPName],
BasicTime USING [GetClockPulses, GMT, Now, Pulses, PulsesToMicroseconds],
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, ChildYBound, Create],
Endian USING [FWORD],
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;
Viewer layout parameters
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: "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]
RETURNS[abort: BOOL ← FALSE]
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 = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
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 = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
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: Endian.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 = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
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 = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
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 = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
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.