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[];

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]] ]]; };


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: BOOL _ FALSE,
putUDP: BOOL _ FALSE,
putTCP: BOOL _ FALSE,
putBcst: BOOL _ FALSE,  -- packets sent to IP broadcast address
putOther: BOOL _ FALSE,
shortFormat: BOOL _ FALSE,
etherAddrs: BOOL _ FALSE,
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: BOOL _ TRUE,
enqueueTimeInPulses: BasicTime.Pulses _ 0,
pleaseStop: BOOL _ FALSE,
promiscuous: BOOL _ FALSE,
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];
};
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]] };
DisplayArpaBuf: PROC [s: STREAM, b: ArpaBuf.Buffer, heading: ROPE, bufBytes: NAT, when: BasicTime.GMT, whenPulses: BasicTime.Pulses, short: BOOL, etherAddrs: BOOL] ~ {

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] ~ {
PutOtherBuf[s, b, bytes, short]; 
};

PutOtherBuf: PROC [s: STREAM, b: ArpaBuf.Buffer, bytes: CARDINAL, short: BOOL] ~ {
i: CARDINAL _ 0;
words: CARDINAL _ MIN[((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;
};

Recv: CommDriver.RecvInterceptor
~ {
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
~ {
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 };

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];
};
CvtRopeFromCardinals: PROC [args: LIST OF CARDINAL] RETURNS [result: ROPE _ NIL] ~ {
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;
};
Go: Commander.CommandProc
~ {
IF Create[]
THEN RETURN [result~$Done]
ELSE RETURN [result~$Failure]
};

Commander.Register[key~toolName, proc~Go];

END.




jArpaSpyTool.mesa
Copyright c 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.

Utilities that belong in convert
Tool Creation
Print Utilities
Arpa Buffers
Print an Arpa buffer on s.  No assumptions about encapsulation.

Print generic part of a TCP packet.
NOT YET IMPLEMENTED.
Send and Receive Interceptor Procs
[recv: RecvType, data: REF ANY, network: Network, buffer: Buffer, bytes: NAT] RETURNS [kill: BOOL _ FALSE]
[send: SendType, data: REF ANY, network: Network, buffer: Buffer, bytes: NAT] RETURNS [kill: BOOL _ FALSE]]
Print Daemon
The Daemon actually prints buffers that have been queued by Recv and Translate procs.
Conversion Procs (for use from interpreter)
Initialization
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
Κ˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ%™%K™*—K™K™(K™š
Οk	˜	Kšœžœ˜"Kšœžœ;˜HKšœžœ˜*Kšœžœ,˜=Kšœžœ˜Kšœ	žœ˜,Kšœžœ˜Kšœžœ˜)Kšœžœ)žœžœ˜PKšœ
žœžœ%˜IKšœ
žœ˜(Kšœžœ˜KšœžœŽ
˜ž
Kšœžœ˜%Kšœžœ2˜?Jšœžœ˜*Kšœžœ6˜GKšžœ
žœžœ˜/KšœžœP˜]Kšœžœ˜Kšœžœžœ˜,Kšœžœ
˜Kšžœ
žœ˜—K˜KšΟbœžœ
ž˜Kšžœ€
žœ˜˜
šœž˜K˜Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜Kšœžœ˜$K˜Kšžœžœ
žœ
˜Kšžœžœ
žœ
˜K˜Kšœžœ˜*Kšœžœ˜*K˜K˜0K˜
head™ š
Οnœžœžœžœžœ˜?Kšœžœ
˜K˜Kšžœžœ
žœ˜!K˜Kšœžœ˜Kšžœ
žœ@˜I—K˜J˜—™
Kšœ
žœ˜K˜Kš
œ˜K˜Kšœ
žœ)˜:K˜Kšœžœžœ˜(šœžœžœ˜K˜K˜Kš
œ˜K˜K˜Kš
œ˜Kšœ	žœžœ
˜Kšœžœžœ
˜Kšœžœžœ
˜Kšœ	žœžœΟc'˜?Kšœ
žœžœ
˜Kšœ
žœžœ
˜Kšœžœžœ
˜Kšœžœ˜Kšœžœ˜'Kšœ
ž˜Kšœžœ
˜	Kšœžœ˜—K˜Kšœžœžœ˜"šœžœžœ˜Kšœ&žœ
˜*K˜-Kšœž	œ
˜Kšœ
žœ˜Kšœ
žœžœ
˜K˜*Kšœžœžœ
˜Kšœ
žœžœ
˜Kš
œ*˜*Kš
œ(˜(Kšœ
žœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜K˜K˜—š
 œžœ
žœ
žœžœ˜.Kš
œ˜Kš
œ˜Kš
žœžœ
žœ
žœžœ˜.KšœžœL˜TKšœžœ˜Kšžœ"˜)š
œ.˜.K˜K˜šœžœ
˜
K˜K˜#K˜$K˜—K˜Kš
œ˜K˜—Kšžœžœ˜K˜K˜—š œžœ
žœ"ž	œ˜BKš
œ˜Kš
œ2˜2K˜K˜—š
 œžœ
žœ#žœžœ˜OKšœžœ
˜'šžœžœ˜Kšœ+žœ˜1Kšžœžœ˜—Kš
œ˜Kšžœžœ˜K˜K˜—š œžœ˜Kšœžœ
˜'Kš
œ˜K˜—š œ˜Kšœžœ
˜'Kšœžœ
˜!šžœž˜Kšœžœ
˜K˜+Kšžœ
˜—Kšœžœ
˜K˜K˜—š 
œ˜K˜	Kšœžœ˜K˜—š œ˜"Kšœžœ
˜!Kšœžœ
˜'Kšœžœ
˜Jš
œ˜Jš
œ˜K˜Kšœžœ
˜Kš
œ$˜$šžœžœ˜ Jš
œ<˜<šžœž˜JšœBžœ˜IJšœDžœ˜KJšœFžœ˜MJšžœ
˜—Kšžœžœ	ž˜1šžœKžœ˜UKš
œ˜——šžœžœ˜"Jš
œ@˜@šžœž˜JšœEžœ˜LJšœEžœ˜LJšœIžœ˜PJšžœ
˜—Kšžœ žœž˜5KšžœMžœ˜X—Kšœžœ
˜$Kš
œ˜K˜—š œ˜Kšœžœ
˜!Kšœžœ
˜'Jšžœ
žœžœ
žœ
˜$š	œžœ
žœžœžœ
˜'Kšžœ
˜‘
KšžœE˜Gšžœ*˜,Kš
œ'˜'—K˜—Kš
œ	˜	K˜——™š œžœžœžœžœžœ˜2Kšžœ˜!—š œžœžœ
žœžœžœžœ˜7Kšžœ˜!—š œžœžœžœžœžœ˜2Kšžœ˜!—š œžœžœžœžœ
žœžœ˜7Kšžœ˜!——š
œ™š œžœžœžœžœžœ'žœžœ˜§
K™?K˜š œžœžœ˜!Kšžœ—
˜™
K˜šžœžœ˜Kšœžœ)˜Gšžœž˜š
œ
˜
Kšœžœ˜šžœ˜	Kš	œžœ
žœ
žœ žœ˜IKš
œ˜Kš
œ˜K˜—Kšžœy˜{K˜—š
œ˜Kš
œ˜šžœ˜	Kš	œžœ
žœ
žœ žœ˜IKš
œ˜Kš
œ˜K˜—Kšžœa˜cK˜—Kšžœ
˜—K˜K˜—K˜Kšžœτ
˜φ
Kšžœi˜kK˜K˜—Kšœžœ
˜"Kšœ'žœ
˜,Kšœžœ˜3Kš
œ0˜0Kš
œ$˜$Kšœžœžœ˜0K˜šžœž˜˜	Kš
œ˜šžœ˜	Kšžœ
žœžœ˜=Kšžœ%˜)—K˜—˜Kš
œ˜šžœ˜	Kšžœ
žœžœ˜<Kšžœ%˜)—K˜—˜Kš
œ˜šžœ˜	Kšžœ
žœžœ˜<Kšžœ%˜)—K˜—šžœ˜Kšœžœ˜7Kš
œ$˜$Kš
œ˜——K˜K™—š
 
œžœžœ žœ	žœ˜Ušžœž˜Kš
œD˜DK˜JK˜DK˜FKš
œ:˜:K˜DK˜VK˜7K˜AK˜HK˜Dšžœ˜Kšžœ8žœ"˜_K˜——K˜K˜—š œžœžœ žœ	žœ	žœ˜mKšœžœ
˜Kšžœ¦
˜¨
Kšœ(žœ8˜eK˜šžœž˜šžœ	ž˜šžœ!˜#Kšžœ
žœ4˜;—K˜
Kšžœ
˜—Kšžœ˜Kšžœžœ
žœ
˜Kšžœ
˜—K˜K˜—š 
œžœžœ˜7Kšžœμ˜ξKšžœ™
˜›
K˜K˜—š œžœžœ žœ	žœ	žœ˜gKšžœF˜HKš
œ˜K˜K˜—š œžœžœ žœ	žœ	žœ˜qKšžœ‘
˜“
Kš
œ˜K˜K˜—š œžœžœ žœ	žœ	žœ˜qKšžœz˜|Kš
œ˜K˜K˜—š œžœžœ žœ	žœ	žœ˜`Kšžœ°
˜²
Kšžœή
˜ΰ
K˜K˜—š œžœžœ žœ	žœ	žœ˜mKšžœ΄
˜Ά
K˜K˜—š
 	œžœžœžœ	žœ˜SKšœ
žœ
˜Kšœžœžœ
žœžœ
žœ˜aKšžœ‰
˜‹
K˜šžœž˜šžœ	žœž˜"Kšžœ5˜7K˜
Kšžœ
˜—Kšžœ˜Kšžœžœ
žœ
˜Kšžœ
˜—K˜K˜—š
 	œžœžœžœ	žœ˜PK™#K™Kš
œ!˜!K˜K˜—š
 œžœžœžœ	žœ˜RKšœžœ˜Kš
œžœžœ	žœ
žœžœ
žœ˜Všžœž˜šžœ	žœž˜"Kšžœ5˜7K˜
Kšžœ
˜—Kšžœ˜Kšžœžœ
žœ
˜Kšžœ
˜—K˜K˜——™"š œ˜ Kš
œžœ
žœ+žœžœžœžœ
™jKš
œ˜Kš
œ˜K˜K˜K˜Kšœžœ˜Kšœžœ
˜Kšœžœ
˜šžœžœ˜Kšœžœ
˜Kšžœ˜	—šžœž˜š
œ˜K˜Kšžœžœ˜!šžœ˜šžœ˜šžœ
žœ
ž˜š
œ"˜"Kš
œQ˜Q—š
œ˜Kš
œQ˜Q—š
œ*˜*Kš
œQ˜Q—Kšžœ
˜—K˜
—šžœ˜Kš
œO˜OKš
œ˜——K˜—Kšžœžœ
˜—Kš
œ˜K˜—š œ˜ Kšœžœžœ
žœ
ž
œž
œž
œžœ
žœžœžœ™kK˜Kš
œ˜K˜K˜K˜Kšœžœ˜Kšœžœ
˜Kšœžœ
˜Kšžœžœ
žœ
˜šžœžœ˜Kšœžœ
˜Kšžœ˜	—šžœž˜š
œ˜K˜Kšžœžœ˜!Kš
œO˜OK˜—Kšžœžœ
˜—K˜—K˜š œž
œ˜(Kšœžœ
˜!Kšœžœž
˜;Kšžœžœ
žœ
žœ
˜$Kšžœžœ
žœ
žœ
˜˜.K˜Kšœžœ
žœžœžœžœžœžœžœžœžœžœžœžœ˜ά
Kš
œ˜Kšœžœžœžœžœžœžœžœžœžœ˜˜
K˜K˜Kš
œ˜—K˜K˜—š 	œž
œ˜*Kšœžœ
˜!Kšžœžœ
žœ
žœ
˜$Kš
œ.˜.Kšœžœ˜——™K™UK˜Kšœ	žœ˜"Kšœžœ˜$K˜Kšœ
žœžœ˜$šœžœžœ˜K˜#Kšœžœ
˜Kšœžœ
˜Kšœžœ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—š œžœ
žœ˜0Kšœ žœ
˜$K˜K˜—š œžœ
žœ"˜=Kš
œ3˜3šžœž˜šžœ˜K˜
Kš
œ"˜"Kšžœ˜—šžœ˜K˜(Kš
œ˜Kš
œ˜——Kšœ	ž˜
K˜K˜—K˜š
 œžœ
žœžœžœ˜MKšžœ
žœžœ
˜šžœžœ
ž˜"Kšžœžœ
žœ
˜Kšžœ˜Kšžœ
˜—Kš
œ˜Kšœ	žœ
˜
K˜—K˜š œžœ
žœ˜+KšœžœFžœ˜SK˜K˜—š 
œžœ
žœžœ˜Dšžœžœ
žœ˜#Kšœ!žœ
˜%Kšœ žœ
˜%Kšžœ
˜Kš
œ˜—šžœžœ˜Kš
œ˜Kšžœ
˜K˜—šžœžœ
žœ˜#Kš
œ˜Kšœ	žœ
˜
Kšžœ
˜K˜—Kšžœ‘˜K˜—K˜š œžœ
žœ"˜:Kš
œ+˜+Kšœžœ
˜Kšœžœ
˜Kšœ žœ
˜%K˜K˜—š œžœžœ˜4š
ž˜šžœž˜˜Kš
œ˜K˜—˜Kš
œ ˜ K˜
—šžœ˜Kšžœ
˜K˜——Kšžœ
˜—K˜—K˜š œžœ\žœ˜zKšœžœ
˜'Kšœžœ
˜!Kš
œ˜šžœž˜˜	K˜Kšžœžœ˜"šžœ&žœ˜.Kš
œ˜Kšžœ
žœžœ
žœ˜ —šžœž˜˜	Kš
œ˜Kšžœ
žœžœ
žœ˜ —˜Kš
œ˜Kšžœ
žœžœ
žœ˜—˜Kš
œ˜Kšžœ
žœžœ
žœ˜—šžœ˜K˜Kšžœ
žœ
žœ
žœ˜!——K˜—Kšžœžœ
˜—Kš
œ˜K˜K˜Kšœžœ
˜K˜K˜K˜Kš
œ˜K˜—K˜š œžœ˜!Kšœžœ
˜'Kšœžœ
˜!K˜Kšžœ
žœžœ
žœ
˜$Kš
œ˜Kšœžœ
˜K˜Kšžœ<˜>š
ž˜Kšžœ
žœžœžœ
˜!Kš
œ˜Kšžœžœ
žœ
˜Kšžœžœ
žœ
žœ
˜šžœ
ž˜šœžœž˜šœžœ˜KšœžœI˜h—Kšžœžœ
˜—šœžœž˜šœžœ˜KšœžœI˜h—Kšžœžœ
˜—Kšžœ
˜—Kšžœ˜K˜Kšžœ
˜—Kšžœ<˜>J˜Jš
œ	˜	K˜K˜—š œžœ˜ Kšœžœ
˜'Kšœžœ
˜!K˜Kšžœ
žœžœ
žœ
˜#šžœ˜šžœ˜Kšžœ*˜,K˜
—šžœ˜KšžœD˜FK˜š
ž˜Kšžœ
žœžœžœ
˜!Kšžœžœ
žœ
˜Kšžœžœ
žœ
žœ
˜šžœ
ž˜šœžœž˜šœžœ˜KšœžœI˜h—Kšžœžœ
˜—šœžœž˜šœžœ˜KšœžœI˜h—Kšžœžœ
˜—Kšžœ
˜—Kšžœ˜K˜Kšžœ
˜—KšžœD˜FK˜——Jš
œ	˜	K˜K˜—š œžœ˜#Kšœžœ
˜'Kšœžœ
˜!Kšžœ
žœžœ
žœ
˜&Kš
œ˜Kš
œ ˜ Kšœžœ
˜K˜KšžœF˜Hš
ž˜Kšžœžœ
žœ
˜K˜Kšžœ
˜—KšžœF˜HJ˜Jš
œ	˜	K˜——™+š œžœžœ
žœ
žœžœ
žœžœ˜Tšžœžœ
ž˜Kšœžœ˜Kšœ+žœ
˜8Kšœ+žœžœ˜<K˜Kšžœ
˜—K˜——™˜Kšœžœ
žœžœžœžœ
™:K˜šžœ	˜Kšžœ
žœ˜Kšžœ
žœ˜—K˜K˜—Kš
œ*˜*—K˜Kšžœ
˜—J˜J˜J˜J˜—…—SFpΎ