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.




���j��ArpaSpyTool.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˜�—�…—����SF��p¾��