DIRECTORY
Arpa USING [Address, nullAddress],
ArpaBuf USING [Buffer, FragmentOffset, Hdr, maxBodyHWords, maxBytes, minIHL],
ArpaExtras USING [IsBroadcast, MyAddress],
ArpaICMPBuf USING [Body, Buffer, hdrBytes, maxEchoDataBytes],
ArpaIP USING [GetUserBytes],
ArpaName USING [ReplyStatus, NameToAddress],
ArpaTCPOps USING [Flip, tcpHdrByteLength, TCPHeaderP],
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, int, PutChar, PutF, PutFR, PutRope, rope, STREAM],
Process USING [ConditionPointer, EnableAborts, Pause, PauseMsec, SecondsToTicks, SetTimeout],
Pup USING [Host],
Rope USING [Cat, Concat, FromChar, Length, ROPE],
ViewerClasses USING [Viewer],
XNS USING [Host];
~
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: 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];
};
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;
};
pktBytesPrinted: INT ← 200;
PutTCPBuf:
PROC [s:
STREAM, b: ArpaBuf.Buffer, bytes:
CARDINAL, short:
BOOL] ~
TRUSTED {
Print generic part of a TCP packet.
ENABLE UNWIND => NULL;
tcpHdrPtr: ArpaTCPOps.TCPHeaderP ← LOOPHOLE[@b.body];
ipHdr: ArpaBuf.Hdr ← LOOPHOLE[b.hdr1];
ctlString: Rope.ROPE;
PutData:
PROC [s:
IO.
STREAM, data: ArpaBuf.Buffer, fudge:
BOOL] =
TRUSTED {
cruft: INT ← 0;
length: INT ← ArpaIP.GetUserBytes[data].bodyBytes;
c: INT;
tcpDataStart: INT;
tcpHdrPtr: ArpaTCPOps.TCPHeaderP;
IF length <= ArpaTCPOps.tcpHdrByteLength THEN RETURN;
TRUSTED {
tcpHdrPtr ← LOOPHOLE[@data.body];
tcpDataStart ← tcpHdrPtr.dataWordOffset*4;
IF fudge
THEN {
-- Recv case ??
IF tcpHdrPtr.dataWordOffset # 5
THEN {
-- TCP Options
end: INT = tcpHdrPtr.dataWordOffset*4;
s.PutRope["Options: "];
FOR i:
INT
IN [4*5..end)
DO
c ← data.body.bytes[tcpDataStart+i];
s.PutF["%b ", IO.int[c]];
ENDLOOP;
s.PutChar['\n]; };
length ← length - tcpHdrPtr.dataWordOffset*4; }; };
IF length = 0 THEN RETURN;
FOR i:
INT
IN [0..
MIN[length,pktBytesPrinted])
DO
c ← data.body.bytes[tcpDataStart+i];
IF c
IN [40b..176b]
THEN
s.PutChar['\000 + c]
ELSE {
cruft ← cruft + 1;
IF cruft > 10 THEN { s.PutRope["(more)"]; EXIT; };
s.PutF["<%b>", IO.int[c]]; };
ENDLOOP;
s.PutChar['\n];
};
ctlString ← "";
IF tcpHdrPtr.urg THEN ctlString ← ctlString.Cat["U"];
IF tcpHdrPtr.ack THEN ctlString ← ctlString.Cat["A"];
IF tcpHdrPtr.psh THEN ctlString ← ctlString.Cat["P"];
IF tcpHdrPtr.rst THEN ctlString ← ctlString.Cat["R"];
IF tcpHdrPtr.syn THEN ctlString ← ctlString.Cat["S"];
IF tcpHdrPtr.fin THEN ctlString ← ctlString.Cat["F"];
s.PutF[" %g -> ", IO.int[tcpHdrPtr.sourcePort]];
s.PutF[" %g\n", IO.int[tcpHdrPtr.dstnPort]];
s.PutF[" %6g ", IO.rope[ctlString]];
s.PutF["%7g %7g %7g %7g\n", IO.int[ArpaTCPOps.Flip[tcpHdrPtr.seqNumber] MOD 100000], IO.int[ArpaTCPOps.Flip[tcpHdrPtr.ackNumber] MOD 100000], IO.int[tcpHdrPtr.window], IO.int[ArpaIP.GetUserBytes[b].bodyBytes]];
PutData[s, b, FALSE];
};
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;
};
Send and Receive Interceptor Procs
Recv: CommDriver.RecvInterceptor
[recv: RecvType, data: REF ANY, network: Network, buffer: Buffer, bytes: NAT] RETURNS [kill: BOOL ← FALSE]
~ {
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: BOOL ← FALSE]]
~ {
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[]];
}
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:
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;
};
Initialization
Go: Commander.CommandProc
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
~ {
IF Create[]
THEN RETURN [result~$Done]
ELSE RETURN [result~$Failure]
};
Commander.Register[key~toolName, proc~Go];
END.