ArpaSpyTool.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Demers, April 19, 1988 4:21:31 pm PDT
John Larson, April 13, 1988 6:36:16 pm PDT
Tool to watch all Arpa packets received.
DIRECTORY
Arpa USING [Address, nullAddress],
ArpaBuf USING [Buffer, FragmentOffset, maxBodyHWords, maxBytes, minIHL],
ArpaExtras USING [IsBroadcast, MyAddress],
ArpaICMPBuf USING [Body, Buffer, hdrBytes, maxEchoDataBytes],
ArpaIP USING [GetUserBytes],
ArpaName USING [ReplyStatus, NameToAddress],
ArpaUDP USING [GetUserBytes],
ArpaUDPBuf USING [Buffer, maxBodyHWords],
Basics USING [Card32FromF, Card16FromH, FFromCard32, FWORD, HFromCard16, HWORD],
BasicTime USING [GetClockPulses, GMT, Now, Pulses, PulsesToMicroseconds],
Commander USING [CommandProc, Register],
CommBuffer USING [Overhead],
CommDriver USING [Buffer, BufferObject, CreateInterceptor, DestroyInterceptor, GetNetworkChain, Interceptor, Network, RecvInterceptor, SendInterceptor, Type],
CommDriverType USING [Encapsulation],
Convert USING [RopeFromCard, RopeFromPupHost, RopeFromXNSHost],
ConvertExtras USING [RopeFromArpaAddress],
GenericTool USING [ButtonProc, CreateInstance, PutMsgRope, ToolHandle],
IO USING [Error, PutChar, PutF, PutFR, STREAM],
Process USING [ConditionPointer, EnableAborts, Pause, PauseMsec, SecondsToTicks, SetTimeout],
Pup USING [Host],
Rope USING [Concat, FromChar, Length, ROPE],
ViewerClasses USING [Viewer],
XNS USING [Host];
ArpaSpyTool: CEDAR MONITOR
IMPORTS ArpaBuf, ArpaExtras, ArpaIP, ArpaName, ArpaUDP, Basics, BasicTime, Commander, CommDriver, Convert, ConvertExtras, GenericTool, IO, Process, Rope
~ BEGIN
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Viewer: TYPE ~ ViewerClasses.Viewer;
FWORD: TYPE ~ Basics.FWORD;
HWORD: TYPE ~ Basics.HWORD;
ToolHandle: TYPE ~ GenericTool.ToolHandle;
ButtonProc: TYPE ~ GenericTool.ButtonProc;
thisHost: Arpa.Address ← ArpaExtras.MyAddress[];
Utilities that belong in convert
RopeFromNetTime: PROC [netTime: FWORD] RETURNS [rope: ROPE] = {
seconds, fraction, ms: CARD;
ms ← CfF[netTime];
IF ms < 0 THEN RETURN["Unknown"];
seconds ← ms/1000;
fraction ← ms MOD 1000;
RETURN[IO.PutFR["%R.%03G", [integer[seconds]], [integer[fraction]] ]]; };
Tool Creation
toolName: ROPE ~ "ArpaSpyTool";
globalToolHandle: ToolHandle;
RunningType: TYPE ~ { none, watch, capture, dump, stats };
ControlHandle: TYPE ~ REF ControlObject;
ControlObject: TYPE ~ RECORD [
running: RunningType ← none,
stop: ButtonProc ← Stop,
watch: ButtonProc ← Watch,
capture: ButtonProc ← Capture,
dump: ButtonProc ← Dump,
stats: ButtonProc ← Stats,
putICMP: BOOLFALSE,
putUDP: BOOLFALSE,
putTCP: BOOLFALSE,
putBcst: BOOLFALSE, -- packets sent to IP broadcast address
putOther: BOOLFALSE,
shortFormat: BOOLFALSE,
etherAddrs: BOOLFALSE,
maxCapture: CARDINAL ← 30,
maxLength: CARDINAL ← ArpaBuf.maxBytes,
thisMachine: ROPE,
to: ROPE,
from: ROPE];
DataHandle: TYPE ~ REF DataObject;
DataObject: TYPE ~ RECORD [
interceptor: CommDriver.Interceptor ← NIL,
printQHead, printQTail, printQFree: PrintBuf,
printQNonempty: CONDITION,
nPrintQFree: CARDINAL ← 0,
mayAllocate: BOOLTRUE,
enqueueTimeInPulses: BasicTime.Pulses ← 0,
pleaseStop: BOOLFALSE,
promiscuous: BOOLFALSE,
fromHost: Arpa.Address ← Arpa.nullAddress,
toHost: Arpa.Address ← Arpa.nullAddress,
nTooLong: INT ← 0,
nICMP: INT ← 0,
nUDP: INT ← 0,
nTCP: INT ← 0,
nBcst: INT ← 0,
nOther: INT ← 0
];
Create: ENTRY PROC RETURNS [created: BOOL] ~ {
cH: ControlHandle;
dH: DataHandle;
IF globalToolHandle # NIL THEN RETURN [FALSE];
cH ← NEW[ControlObject ← [thisMachine~ConvertExtras.RopeFromArpaAddress[thisHost]]];
dH ← NEW[DataObject ← []];
TRUSTED { InitCond[@dH.printQNonempty] };
globalToolHandle ← GenericTool.CreateInstance[
toolName~toolName,
control~cH,
options~LIST[
["thisMachine", readonly[]],
["to", notify[GetFilterAddresses]],
["from", notify[GetFilterAddresses]]
],
data~dH,
preDestroy~PreDestroy
];
RETURN [TRUE];
};
InitCond: UNSAFE PROC [cP: Process.ConditionPointer] ~ UNCHECKED {
Process.EnableAborts[cP];
Process.SetTimeout[cP, Process.SecondsToTicks[1]];
};
Enter: ENTRY PROC [tH: ToolHandle, me: RunningType] RETURNS [entered: BOOL] ~ {
cH: ControlHandle ~ NARROW[tH.control];
IF cH.running # none THEN {
GenericTool.PutMsgRope[tH, "Tool is busy", TRUE];
RETURN [FALSE] };
cH.running ← me;
RETURN [TRUE];
};
Exit: PROC [tH: ToolHandle] ~ {
cH: ControlHandle ~ NARROW[tH.control];
cH.running ← none };
Stop: ButtonProc ~ {
cH: ControlHandle ~ NARROW[tH.control];
dH: DataHandle ~ NARROW[tH.data];
WHILE cH.running # none DO
dH.pleaseStop ← TRUE;
Process.Pause[ Process.SecondsToTicks[1] ];
ENDLOOP;
dH.pleaseStop ← FALSE;
};
PreDestroy: ButtonProc ~ {
Stop[tH];
globalToolHandle ← NIL };
GetFilterAddresses: ButtonProc ~ {
dH: DataHandle ~ NARROW[tH.data];
cH: ControlHandle ~ NARROW[tH.control];
gotTo, gotFrom: BOOL;
status: ArpaName.ReplyStatus;
source: Arpa.Address;
gotTo ← gotFrom ← FALSE;
dH.toHost ← dH.fromHost ← thisHost;
IF Rope.Length[cH.to] > 0 THEN {
[dH.toHost, status, source] ← ArpaName.NameToAddress[cH.to];
SELECT status FROM
bogus => GenericTool.PutMsgRope[tH,"Invalid name in To field.\n", TRUE];
down => GenericTool.PutMsgRope[tH,"Name servers not responding.\n", TRUE];
other => GenericTool.PutMsgRope[tH,"No address for To field name.\n", TRUE];
ENDCASE;
IF dH.toHost # Arpa.nullAddress THEN gotTo ← TRUE
ELSE GenericTool.PutMsgRope[tH, "Unable to load address for To field name.\n", TRUE];
};
IF Rope.Length[cH.from] > 0 THEN {
[dH.fromHost, status, source] ← ArpaName.NameToAddress[cH.from];
SELECT status FROM
bogus => GenericTool.PutMsgRope[tH, "Invalid name in From field.\n", TRUE];
down => GenericTool.PutMsgRope[tH, "Name servers not responding.\n", TRUE];
other => GenericTool.PutMsgRope[tH, "No address for From field name.\n", TRUE];
ENDCASE;
IF dH.fromHost # Arpa.nullAddress THEN gotFrom ← TRUE
ELSE GenericTool.PutMsgRope[tH, "Unable to load address for From field name.\n", TRUE]};
dH.promiscuous ← (gotTo OR gotFrom);
};
Stats: ButtonProc ~ {
dH: DataHandle ~ NARROW[tH.data];
cH: ControlHandle ~ NARROW[tH.control];
IF NOT Enter[tH, stats] THEN RETURN;
{ ENABLE IO.Error, ABORTED => CONTINUE;
IO.PutF[tH.out, "\n%7g ICMP\n%7g UDP\n%7g TCP\n%7g Other\n", [integer[dH.nICMP]], [integer[dH.nUDP]], [integer[dH.nTCP]], [integer[dH.nOther]] ];
IO.PutF[tH.out, "\n%7g dropped (too long)\n", [integer[dH.nTooLong]] ];
IO.PutF[tH.out, "\n%7g total\n\n", [integer[
dH.nICMP+dH.nUDP+dH.nTCP+dH.nOther]] ];
};
Exit[tH];
};
Print Utilities
HfC: PROC [c: CARDINAL] RETURNS [HWORD] ~ INLINE {
RETURN [Basics.HFromCard16[c]] };
FfC: PROC [c: LONG CARDINAL] RETURNS [FWORD] ~ INLINE {
RETURN [Basics.FFromCard32[c]] };
CfH: PROC [h: HWORD] RETURNS [CARDINAL] ~ INLINE {
RETURN [Basics.Card16FromH[h]] };
CfF: PROC [f: FWORD] RETURNS [LONG CARDINAL] ~ INLINE {
RETURN [Basics.Card32FromF[f]] };
Arpa Buffers
DisplayArpaBuf: PROC [s: STREAM, b: ArpaBuf.Buffer, heading: ROPE, bufBytes: NAT, when: BasicTime.GMT, whenPulses: BasicTime.Pulses, short: BOOL, etherAddrs: BOOL] ~ {
Print an Arpa buffer on s. No assumptions about encapsulation.
PutHdr: PROC [typeName: ROPE] ~ {
IO.PutF[s, "Arpa %g (%g) %g (%g):\n", [rope[heading]], [cardinal[bufBytes]], [time[when]], [cardinal[BasicTime.PulsesToMicroseconds[whenPulses]/1000]] ];
IF etherAddrs THEN {
type: CommDriver.Type ← NARROW[b.ovh.network, CommDriver.Network].type;
SELECT type FROM
ethernet => {
etherSrc, etherDst: XNS.Host;
TRUSTED {
p: LONG POINTER TO CommDriverType.Encapsulation ~ LOOPHOLE[@b.ovh.encap];
etherSrc ← p.ethernetSource;
etherDst ← p.ethernetDest;
};
IO.PutF[s, "%g->%g, ", [rope[Convert.RopeFromXNSHost[etherSrc, octal]]], [rope[Convert.RopeFromXNSHost[etherDst, octal]]]];
};
ethernetOne => {
src, dst: Pup.Host;
TRUSTED {
p: LONG POINTER TO CommDriverType.Encapsulation ~ LOOPHOLE[@b.ovh.encap];
src ← p.ethernetOneSource;
dst ← p.ethernetOneDest;
};
IO.PutF[s, "%g->%g, ", [rope[Convert.RopeFromPupHost[src]]], [rope[Convert.RopeFromPupHost[dst]]]];
};
ENDCASE;
};
IO.PutF[s, "%g->%g, ihl %g, len %g ttl %g", [rope[ConvertExtras.RopeFromArpaAddress[b.hdr1.source]]], [rope[ConvertExtras.RopeFromArpaAddress[b.hdr1.dest]]], [cardinal[b.hdr1.ihl]], [cardinal[CfH[b.hdr1.length]]], [cardinal[b.hdr1.timeToLive]] ];
IO.PutF[s, ", id %x, frag %x\n", [cardinal[CfH[b.hdr1.fragmentId]]], [cardinal[CfH[b.hdr1.fragmentCtl]]] ];
};
bodyBytes, optionsBytes: CARDINAL;
firstFragment, optionsPresent, simple: BOOL;
[bodyBytes, optionsBytes] ArpaIP.GetUserBytes[b];
firstFragment ← (ArpaBuf.FragmentOffset[b] = 0);
optionsPresent ← (optionsBytes # 0);
simple ← firstFragment AND (NOT optionsPresent);
SELECT b.hdr1.protocol FROM
icmp => {
PutHdr["ICMP"];
IF simple
THEN TRUSTED { PutICMPBuf[s, LOOPHOLE[b], bodyBytes, short] }
ELSE PutOtherBuf[s, b, bodyBytes, short];
};
udp => {
PutHdr["UDP"];
IF simple
THEN TRUSTED { PutUDPBuf[s, LOOPHOLE[b], bodyBytes, short] }
ELSE PutOtherBuf[s, b, bodyBytes, short];
};
tcp => {
PutHdr["TCP"];
IF simple
THEN TRUSTED { PutTCPBuf[s, LOOPHOLE[b], bodyBytes, short] }
ELSE PutOtherBuf[s, b, bodyBytes, short];
};
ENDCASE => {
PutHdr[Convert.RopeFromCard[ORD[b.hdr1.protocol], 16]];
PutOtherBuf[s, b, bodyBytes, short];
};
};
PutICMPBuf: PROC [s: STREAM, b: ArpaICMPBuf.Buffer, bytes: CARDINAL, short: BOOL] ~ {
SELECT b.hdr2.icmpType FROM
echoReply => PutEchoRequestOrReply[s, b, bytes, short, "echoReply"];
destUnreachable => PutReturnedData[s, b, bytes, short, "destUnreachable"];
sourceQuench => PutReturnedData[s, b, bytes, short, "sourceQuench"];
redirect => PutReturnedDataAndAddress[s, b, bytes, short, "redirect"];
echo => PutEchoRequestOrReply[s, b, bytes, short, "echo"];
timeExceeded => PutReturnedData[s, b, bytes, short, "timeExceeded"];
parameterProblem => PutReturnedDataAndPointer[s, b, bytes, short, "parameterProblem"];
timestamp => PutTimes[s, b, bytes, short, "timestamp"];
timestampReply => PutTimes[s, b, bytes, short, "timestampReply"];
infoRequest => PutInfoRequestOrReply[s, b, bytes, short, "infoRequest"];
infoReply => PutInfoRequestOrReply[s, b, bytes, short, "infoReply"];
ENDCASE => {
IO.PutF[s, "type %g code %g\n", [cardinal[b.hdr2.icmpType.ORD]], [cardinal[b.hdr2.icmpCode]] ];
};
};
PutEchoRequestOrReply: PROC [s: STREAM, b: ArpaICMPBuf.Buffer, bytes: CARDINAL, short: BOOL, title: ROPE] ~ {
i: CARDINAL;
IO.PutF[s, "%g code %g id %g seq %g\n", [rope[title]], [cardinal[b.hdr2.icmpCode]], [cardinal[CfH[b.body.echo.identifier]]], [cardinal[CfH[b.body.echo.sequenceNum]]] ];
bytes ← bytes - ArpaICMPBuf.hdrBytes - (BYTES[ArpaICMPBuf.Body.echo] - ArpaICMPBuf.maxEchoDataBytes);
i ← 0;
WHILE i < bytes DO
THROUGH [1..10] DO
IF i < ArpaICMPBuf.maxEchoDataBytes
THEN IO.PutF[s, "%4x ", [cardinal[b.body.echo.data[i]]] ];
i ← i + 1;
ENDLOOP;
IO.PutChar[s, '\n];
IF short THEN EXIT;
ENDLOOP;
};
PutOrigHdr: PROC [s: STREAM, b: ArpaICMPBuf.Buffer] ~ {
IO.PutF[s, "%g->%g, ihl %g, len %g ttl %g", [rope[ConvertExtras.RopeFromArpaAddress[b.body.destUnreachable.origHdr.source]]], [rope[ConvertExtras.RopeFromArpaAddress[b.body.destUnreachable.origHdr.dest]]], [cardinal[b.body.destUnreachable.origHdr.ihl]], [cardinal[CfH[b.body.destUnreachable.origHdr.length]]], [cardinal[b.body.destUnreachable.origHdr.timeToLive]] ];
IO.PutF[s, ", id %x, frag %x\n", [cardinal[CfH[b.body.destUnreachable.origHdr.fragmentId]]], [cardinal[CfH[b.body.destUnreachable.origHdr.fragmentCtl]]] ];
};
PutReturnedData: PROC [s: STREAM, b: ArpaICMPBuf.Buffer, bytes: CARDINAL, short: BOOL, title: ROPE] ~ {
IO.PutF[s, "%g code %g\n", [rope[title]], [cardinal[b.hdr2.icmpCode]] ];
PutOrigHdr[s, b];
};
PutReturnedDataAndAddress: PROC [s: STREAM, b: ArpaICMPBuf.Buffer, bytes: CARDINAL, short: BOOL, title: ROPE] ~ {
IO.PutF[s, "%g code %g adr %g\n", [rope[title]], [cardinal[b.hdr2.icmpCode]], [rope[ConvertExtras.RopeFromArpaAddress[b.body.redirect.address]]] ];
PutOrigHdr[s, b];
};
PutReturnedDataAndPointer: PROC [s: STREAM, b: ArpaICMPBuf.Buffer, bytes: CARDINAL, short: BOOL, title: ROPE] ~ {
IO.PutF[s, "%g code %g ptr %g\n", [rope[title]], [cardinal[b.hdr2.icmpCode]], [cardinal[b.body.parameterProblem.pointer]] ];
PutOrigHdr[s, b];
};
PutTimes: PROC [s: STREAM, b: ArpaICMPBuf.Buffer, bytes: CARDINAL, short: BOOL, title: ROPE] ~ {
IO.PutF[s, "%g code %g id %g seq %g\n", [rope[title]], [cardinal[b.hdr2.icmpCode]], [cardinal[CfH[b.body.timestamp.identifier]]], [cardinal[CfH[b.body.timestamp.sequenceNum]]] ];
IO.PutF[s, "orig %g revc %g send %g\n", [rope[RopeFromNetTime[b.body.timestamp.originateTimestamp]]], [rope[RopeFromNetTime[b.body.timestamp.receiveTimestamp]]], [rope[RopeFromNetTime[b.body.timestamp.transmitTimestamp]]] ];
};
PutInfoRequestOrReply: PROC [s: STREAM, b: ArpaICMPBuf.Buffer, bytes: CARDINAL, short: BOOL, title: ROPE] ~ {
IO.PutF[s, "%g code %g id %g seq %g\n", [rope[title]], [cardinal[b.hdr2.icmpCode]], [cardinal[CfH[b.body.infoRequest.identifier]]], [cardinal[CfH[b.body.infoRequest.sequenceNum]]] ];
};
PutUDPBuf: PROC [s: STREAM, b: ArpaUDPBuf.Buffer, bytes: CARDINAL, short: BOOL] ~ {
i, words: CARDINAL;
words ← MIN[((ArpaUDP.GetUserBytes[b]+BYTES[HWORD]-1) / BYTES[HWORD]), ArpaUDPBuf.maxBodyHWords];
IO.PutF[s, "ports %g->%g len %g\n", [cardinal[CfH[b.hdr2.sourcePort]]], [cardinal[CfH[b.hdr2.destPort]]], [cardinal[CfH[b.hdr2.length]]] ];
i ← 0;
WHILE i < words DO
THROUGH [1..10] WHILE i < words DO
IO.PutF[s, "%4x ", [cardinal[CfH[b.body.hWords[i]]]] ];
i ← i + 1;
ENDLOOP;
IO.PutChar[s, '\n];
IF short THEN EXIT;
ENDLOOP;
};
PutTCPBuf: PROC [s: STREAM, b: ArpaBuf.Buffer, bytes: CARDINAL, short: BOOL] ~ {
Print generic part of a TCP packet.
NOT YET IMPLEMENTED.
PutOtherBuf[s, b, bytes, short];
};
PutOtherBuf: PROC [s: STREAM, b: ArpaBuf.Buffer, bytes: CARDINAL, short: BOOL] ~ {
i: CARDINAL ← 0;
words: CARDINALMIN[((bytes+BYTES[HWORD]-1) / BYTES[HWORD]), ArpaBuf.maxBodyHWords];
WHILE i < words DO
THROUGH [1..10] WHILE i < words DO
IO.PutF[s, "%4x ", [cardinal[CfH[b.body.hWords[i]]]] ];
i ← i + 1;
ENDLOOP;
IO.PutChar[s, '\n];
IF short THEN EXIT;
ENDLOOP;
};
Send and Receive Interceptor Procs
Recv: CommDriver.RecvInterceptor
[recv: RecvType, data: REF ANY, network: Network, buffer: Buffer, bytes: NAT] RETURNS [kill: BOOLFALSE]
~ {
tH: ToolHandle;
dH: DataHandle;
cH: ControlHandle;
tH ← NARROW[data];
dH ← NARROW[tH.data];
cH ← NARROW[tH.control];
IF bytes > cH.maxLength THEN {
dH.nTooLong ← dH.nTooLong.SUCC;
RETURN };
SELECT recv FROM
arpa, arpaTranslate => {
b: ArpaBuf.Buffer;
TRUSTED { b ← LOOPHOLE[buffer] };
IF dH.promiscuous
THEN {
SELECT TRUE FROM
(b.hdr1.source = dH.fromHost) => {
PostPrintRequest[tH~tH, kind~arpa, buffer~buffer, direction~send, bytes~bytes] };
(b.hdr1.dest = dH.toHost) => {
PostPrintRequest[tH~tH, kind~arpa, buffer~buffer, direction~recv, bytes~bytes] };
(ArpaExtras.IsBroadcast[b.hdr1.dest]) => {
PostPrintRequest[tH~tH, kind~arpa, buffer~buffer, direction~recv, bytes~bytes] };
ENDCASE;
}
ELSE {
PostPrintRequest[tH~tH, kind~arpa, buffer~buffer, direction~recv, bytes~bytes];
};
};
ENDCASE => NULL;
};
Send: CommDriver.SendInterceptor
[send: SendType, data: REF ANY, network: Network, buffer: Buffer, bytes: NAT] RETURNS [kill: BOOLFALSE]]
~ {
tH: ToolHandle;
dH: DataHandle;
cH: ControlHandle;
tH ← NARROW[data];
dH ← NARROW[tH.data];
cH ← NARROW[tH.control];
IF dH.promiscuous THEN RETURN;
IF bytes > cH.maxLength THEN {
dH.nTooLong ← dH.nTooLong.SUCC;
RETURN };
SELECT send FROM
arpa, arpaReturn => {
b: ArpaBuf.Buffer;
TRUSTED { b ← LOOPHOLE[buffer] };
PostPrintRequest[tH~tH, kind~arpa, buffer~buffer, direction~send, bytes~bytes];
};
ENDCASE => NULL;
};
Install: ENTRY PROC [tH: ToolHandle] ~ {
dH: DataHandle ~ NARROW[tH.data];
network: CommDriver.Network ~ CommDriver.GetNetworkChain[];
IF dH.interceptor # NIL THEN RETURN;
IF network = NIL THEN RETURN;
dH.interceptor ← CommDriver.CreateInterceptor[
network~network,
sendMask~[arpa~TRUE, arpaReturn~TRUE, arpaTranslate~FALSE, xns~FALSE, xnsReturn~FALSE, xnsTranslate~FALSE, pup~FALSE, pupReturn~FALSE, pupTranslate~FALSE, other~FALSE, otherReturn~FALSE, otherTranslate~FALSE, raw~FALSE],
sendProc~Send,
recvMask~[arpa~TRUE, arpaTranslate~FALSE, xns~FALSE, xnsTranslate~FALSE, pup~FALSE, pupTranslate~FALSE, other~FALSE, otherTranslate~FALSE, error~FALSE],
recvProc~Recv,
data~tH,
promiscuous~dH.promiscuous];
};
UnInstall: ENTRY PROC [tH: ToolHandle] ~ {
dH: DataHandle ~ NARROW[tH.data];
IF dH.interceptor = NIL THEN RETURN;
CommDriver.DestroyInterceptor[dH.interceptor];
dH.interceptor ← NIL };
Print Daemon
The Daemon actually prints buffers that have been queued by Recv and Translate procs.
BufKind: TYPE ~ { arpa, unknown };
BufDirection: TYPE ~ { send, recv };
PrintBuf: TYPE ~ REF PrintBufObject;
PrintBufObject: TYPE ~ RECORD [
bufObject: CommDriver.BufferObject,
bytes: NAT,
time: BasicTime.GMT,
deltaT: CARD ← 0,
kind: BufKind,
direction: BufDirection,
next: PrintBuf];
FlushPrintQueue: ENTRY PROC [dH: DataHandle] ~ {
dH.printQHead ← dH.printQTail ← NIL;
};
EnqueuePrintBuf: ENTRY PROC [dH: DataHandle, b: PrintBuf] ~ {
now: BasicTime.Pulses ← BasicTime.GetClockPulses[];
IF dH.printQHead = NIL
THEN {
b.deltaT ← 0;
dH.printQHead ← dH.printQTail ← b;
NOTIFY dH.printQNonempty }
ELSE {
b.deltaT ← now - dH.enqueueTimeInPulses;
dH.printQTail.next ← b;
dH.printQTail ← b };
b.next ← NIL;
dH.enqueueTimeInPulses ← now;
};
DequeuePrintBuf: ENTRY PROC [dH: DataHandle] RETURNS [b: PrintBuf] ~ INLINE {
ENABLE UNWIND => NULL;
WHILE (b ← dH.printQHead) = NIL DO
IF dH.pleaseStop THEN RETURN;
WAIT dH.printQNonempty
ENDLOOP;
dH.printQHead ← b.next;
b.next ← NIL;
};
NewPrintBuf: PROC RETURNS [b: PrintBuf] ~ {
b ← NEW[PrintBufObject ← [bufObject~, bytes~, time~, kind~, direction~, next~NIL]];
};
AllocPrintBuf: ENTRY PROC [dH: DataHandle] RETURNS [b: PrintBuf] ~ {
IF (b ← dH.printQFree) # NIL THEN {
dH.printQFree ← b.next; b.next ← NIL;
dH.nPrintQFree ← dH.nPrintQFree.PRED;
RETURN;
};
IF dH.mayAllocate THEN {
b ← NewPrintBuf[];
RETURN;
};
IF (b ← dH.printQHead) # NIL THEN {
dH.printQHead ← b.next;
b.next ← NIL;
RETURN;
};
ERROR; -- can't happen
};
FreePrintBuf: ENTRY PROC [dH: DataHandle, b: PrintBuf] ~ {
b.next ← dH.printQFree; dH.printQFree ← b;
b.bufObject.ovh.next ← NIL;
b.bufObject.ovh.network ← NIL;
dH.nPrintQFree ← dH.nPrintQFree.SUCC;
};
SetFreeQSize: PROC [dH: DataHandle, n: CARDINAL] ~ {
DO
SELECT dH.nPrintQFree FROM
> n => {
[] ← AllocPrintBuf[dH];
};
< n => {
FreePrintBuf[dH, NewPrintBuf[]];
}
ENDCASE => {
RETURN;
};
ENDLOOP;
};
PostPrintRequest: PROC [tH: ToolHandle, kind: BufKind, buffer: CommDriver.Buffer, direction: BufDirection, bytes: NAT] ~ {
cH: ControlHandle ~ NARROW[tH.control];
dH: DataHandle ← NARROW[tH.data];
b: PrintBuf;
SELECT kind FROM
arpa => {
ab: ArpaBuf.Buffer;
TRUSTED { ab ← LOOPHOLE[buffer] };
IF ArpaExtras.IsBroadcast[ab.hdr1.dest] THEN {
dH.nBcst ← dH.nBcst + 1;
IF NOT cH.putBcst THEN RETURN };
SELECT ab.hdr1.protocol FROM
icmp => {
dH.nICMP ← dH.nICMP + 1;
IF NOT cH.putICMP THEN RETURN };
udp => {
dH.nUDP ← dH.nUDP + 1;
IF NOT cH.putUDP THEN RETURN };
tcp => {
dH.nTCP ← dH.nTCP + 1;
IF NOT cH.putTCP THEN RETURN };
ENDCASE => {
dH.nOther ← dH.nOther + 1;
IF NOT cH.putOther THEN RETURN };
};
ENDCASE => ERROR;
b ← AllocPrintBuf[dH];
b.bufObject ← buffer^;
b.bytes ← bytes;
b.bufObject.ovh.next ← NIL;
b.time ← BasicTime.Now[];
b.kind ← kind;
b.direction ← direction;
EnqueuePrintBuf[dH, b];
};
Watch: PROC [tH: ToolHandle] ~ {
cH: ControlHandle ~ NARROW[tH.control];
dH: DataHandle ~ NARROW[tH.data];
b: PrintBuf;
IF NOT Enter[tH, watch] THEN RETURN;
FlushPrintQueue[dH];
dH.mayAllocate ← TRUE;
Install[tH];
IO.PutF[tH.out, "\nStarted %g\n\n", [time[BasicTime.Now[]]] ];
DO
ENABLE IO.Error, ABORTED => EXIT;
b ← DequeuePrintBuf[dH];
IF dH.pleaseStop THEN EXIT;
IF b = NIL THEN LOOP;
SELECT b.direction FROM
send => SELECT b.kind FROM
arpa => TRUSTED {
DisplayArpaBuf[tH.out, LOOPHOLE[b], "Send", b.bytes, b.time, b.deltaT, cH.shortFormat, cH.etherAddrs] };
ENDCASE => ERROR;
recv => SELECT b.kind FROM
arpa => TRUSTED {
DisplayArpaBuf[tH.out, LOOPHOLE[b], "Recv", b.bytes, b.time, b.deltaT, cH.shortFormat, cH.etherAddrs] };
ENDCASE => ERROR;
ENDCASE;
IO.PutChar[tH.out, '\n];
FreePrintBuf[dH, b];
ENDLOOP;
IO.PutF[tH.out, "\n\nStopped %g\n", [time[BasicTime.Now[]]] ];
UnInstall[tH];
Exit[tH];
};
Dump: PROC [tH: ToolHandle] ~ {
cH: ControlHandle ~ NARROW[tH.control];
dH: DataHandle ~ NARROW[tH.data];
b: PrintBuf;
IF NOT Enter[tH, dump] THEN RETURN;
IF dH.mayAllocate
THEN {
IO.PutF[tH.out, "\nNothing to display\n\n"];
}
ELSE {
IO.PutF[tH.out, "\nStarted display %g\n\n", [time[BasicTime.Now[]]] ];
b ← dH.printQHead;
DO
ENABLE IO.Error, ABORTED => EXIT;
IF dH.pleaseStop THEN EXIT;
IF b = NIL THEN EXIT;
SELECT b.direction FROM
send => SELECT b.kind FROM
arpa => TRUSTED {
DisplayArpaBuf[tH.out, LOOPHOLE[b], "Send", b.bytes, b.time, b.deltaT, cH.shortFormat, cH.etherAddrs] };
ENDCASE => ERROR;
recv => SELECT b.kind FROM
arpa => TRUSTED {
DisplayArpaBuf[tH.out, LOOPHOLE[b], "Recv", b.bytes, b.time, b.deltaT, cH.shortFormat, cH.etherAddrs] };
ENDCASE => ERROR;
ENDCASE;
IO.PutChar[tH.out, '\n];
b ← b.next;
ENDLOOP;
IO.PutF[tH.out, "\n\nStopped display %g\n", [time[BasicTime.Now[]]] ];
};
Exit[tH];
};
Capture: PROC [tH: ToolHandle] ~ {
cH: ControlHandle ~ NARROW[tH.control];
dH: DataHandle ~ NARROW[tH.data];
IF NOT Enter[tH, capture] THEN RETURN;
FlushPrintQueue[dH];
SetFreeQSize[dH, cH.maxCapture];
dH.mayAllocate ← FALSE;
Install[tH];
IO.PutF[tH.out, "\nStarted capturing %g\n\n", [time[BasicTime.Now[]]] ];
DO
IF dH.pleaseStop THEN EXIT;
Process.PauseMsec[1000];
ENDLOOP;
IO.PutF[tH.out, "\n\nStopped capturing %g\n", [time[BasicTime.Now[]]] ];
UnInstall[tH];
Exit[tH];
};
Conversion Procs (for use from interpreter)
CvtRopeFromCardinals: PROC [args: LIST OF CARDINAL] RETURNS [result: ROPENIL] ~ {
WHILE args # NIL DO
n: CARDINAL ~ args.first;
result ← Rope.Concat[result, Rope.FromChar[VAL[n/256]]];
result ← Rope.Concat[result, Rope.FromChar[VAL[n MOD 256]]];
args ← args.rest;
ENDLOOP;
};
Initialization
Go: Commander.CommandProc
[cmd: Handle] RETURNS [result: REFNIL, msg: ROPENIL]
~ {
IF Create[]
THEN RETURN [result~$Done]
ELSE RETURN [result~$Failure]
};
Commander.Register[key~toolName, proc~Go];
END.