[Cyan]<CedarChest6.1>EtherWatch>EtherWatch.mesa!3

EtherWatch.mesa

Russ Atkinson, March 13, 1985 3:56:47 pm PST

Andrew Birrell October 25, 1983 11:29 am

Hal Murray, October 29, 1986 6:22:18 pm PST

PupWatch and ArpaWatch have a similar structure. If you fix a bug here, consider fixing them too.

DIRECTORY

Ascii USING [CR, SP],

Basics USING [BITOR, BITSHIFT, bitsPerWord, bytesPerWord],

BasicTime USING [GetClockPulses, Now, Pulses, PulsesToMicroseconds],

Buttons USING [Button, ButtonProc, Create, ReLabel, SetDisplayStyle],

CommBuffer USING [],

CommDriver USING [Buffer, CreateInterceptor, DestroyInterceptor, GetNetworkChain, Interceptor, Network, RecvInterceptor, RecvType],

CommDriverType USING [Encapsulation],

Containers USING [ChildXBound, ChildYBound, Create],

Convert USING [CardFromRope, Error, RopeFromCard],

FS USING [Copy, Error, StreamOpen],

Imager USING [black, Box, Context, MaskBox, Rectangle, SetColor, SetFont, SetXY, ShowText, white],

ImagerBackdoor USING [GetBounds, GetCP],

ImagerFont USING [Font, FontBoundingBox, RopeWidth],

IO USING [Close, Put, PutChar, PutRope, STREAM],

Labels USING [Create],

PrincOpsUtils USING [LongCopy],

Process USING [Abort, Detach, EnableAborts, Priority, priorityBackground, priorityNormal, SetPriority],

Pup USING [allHosts],

PupBuffer USING [Buffer],

RefText USING [AppendChar, AppendRope],

Rope USING [Cat, Length, ROPE, Text],

VFonts USING [EstablishFont],

ViewerClasses USING [DestroyProc, PaintProc, Viewer, ViewerClass, ViewerClassRec],

ViewerOps USING [CreateViewer, FindViewer, OpenIcon, PaintViewer, RegisterViewerClass, RestoreViewer],

ViewerTools USING [GetContents, MakeNewTextViewer, SetContents, SetSelection],

VM USING [AddressForPageNumber, Allocate, Free, Interval, PagesForWords],

XNS USING [broadcastHost, Host];

EtherWatch: MONITOR

IMPORTS Basics, BasicTime, Buttons, CommDriver, Containers, Convert, FS, Imager, ImagerBackdoor, ImagerFont, IO, Labels, PrincOpsUtils, Process, RefText, Rope, VFonts, ViewerOps, ViewerTools, VM

EXPORTS CommBuffer = {

Simple things

BYTE: TYPE = [0..100H);

Encapsulation: PUBLIC TYPE = CommDriverType.Encapsulation;

ROPE: TYPE = Rope.ROPE;

Viewer: TYPE = ViewerClasses.Viewer;

MSec: PROC [rawClock: BasicTime.Pulses] RETURNS [LONG CARDINAL] = INLINE {

RETURN[BasicTime.PulsesToMicroseconds[rawClock]/1000];

};

User input

InputAction: TYPE = RECORD [SELECT act: * FROM

fast => NULL,

newHost => [who: ROPE],

pauseContinue => NULL,

replay => NULL,

slow => NULL,

start => NULL,

stop => NULL,

writeLog => NULL,

pktSize => [big: BOOL],

ENDCASE];

Packet level

bufferSize: INT;

copySize: NAT;

maxLength: NAT;

bigLength: NAT = 3000;

smallLength: NAT = 100;

Buffer: TYPE = LONG POINTER TO BufferData;

BufferData: TYPE = RECORD [

type: CommDriver.RecvType,

time: BasicTime.Pulses,

length: NAT,

encap: Encapsulation,

body: SELECT OVERLAID * FROM

null => [],

bytes => [bytes: PACKED ARRAY [0..4096) OF BYTE],

small => [PACKED ARRAY [0..smallLength) OF BYTE],

big => [PACKED ARRAY [0..bigLength) OF BYTE],

ENDCASE ];

nBuffers: CARDINAL = 1000;

BufferIndex: TYPE = [0..nBuffers);

bufferSpace: VM.Interval;

buffers: LONG POINTER TO --ARRAY BufferIndex OF-- BufferData ← NIL;

lost: PACKED ARRAY BufferIndex OF BOOL ← ALL[FALSE];

logged: PACKED ARRAY BufferIndex OF BOOL ← ALL[FALSE];

wBuffer: BufferIndex ← 0; -- buffer being written by ethernet driver

rBuffer: BufferIndex ← 0; -- buffer Looker wants to read

fullBuffers: [0..nBuffers] ← 0;

bufferChange: CONDITION;

lookerWaiting: BOOL ← FALSE;

allUsed: BOOL ← FALSE; -- whether all buffers have been written

lookerProcess: PROCESS;

AllocBuffers: ENTRY PROC [big: BOOL] = {

IF buffers # NIL THEN FreeBuffers[];

bufferSize ← IF big THEN SIZE[big BufferData] ELSE SIZE[small BufferData];

copySize ← CARDINAL[bufferSize - SIZE[null BufferData]];

bufferSpace ← VM.Allocate[VM.PagesForWords[nBuffers * bufferSize]];

buffers ← VM.AddressForPageNumber[bufferSpace.page];

maxLength ← IF big THEN bigLength ELSE smallLength;

InnerFlush[];

};

FreeBuffers: PROC = {

VM.Free[bufferSpace];

};

GetBuffer: ENTRY PROC RETURNS [BufferIndex] = {

ENABLE UNWIND => lookerWaiting ← FALSE;

WHILE fullBuffers = 0

DO lookerWaiting ← TRUE; WAIT bufferChange ENDLOOP;

lookerWaiting ← FALSE;

RETURN[rBuffer]

};

ReturnBuffer: ENTRY PROC = {

rBuffer ← IF rBuffer = LAST[BufferIndex] THEN 0 ELSE SUCC[rBuffer];

fullBuffers ← fullBuffers-1;

NOTIFY bufferChange;

};

ReplayBuffers: ENTRY PROC = {

rBuffer ← IF allUsed THEN

IF wBuffer = LAST[BufferIndex] THEN 0 ELSE SUCC[wBuffer]

ELSE 0;

fullBuffers ← (wBuffer+nBuffers-rBuffer) MOD nBuffers;

IF lookerWaiting THEN NOTIFY bufferChange;

};

FlushBuffers: ENTRY PROC = { InnerFlush[] };

InnerFlush: INTERNAL PROC = {

rBuffer ← wBuffer ← 0;

fullBuffers ← 0;

allUsed ← FALSE;

lost ← ALL[FALSE];

logged ← ALL[FALSE];

waitingForBuffers ← FALSE;

NOTIFY bufferChange;

};

waitingForBuffers: BOOL ← FALSE;

NextBuffer: INTERNAL PROC = {

IF fullBuffers >= nBuffers/2 OR ( waitingForBuffers AND fullBuffers+50 >= nBuffers/2 --make sure we have 50 free--)

THEN { waitingForBuffers ← TRUE; lost[wBuffer] ← TRUE; RETURN };

waitingForBuffers ← FALSE;

IF wBuffer = LAST[BufferIndex]

THEN { allUsed ← TRUE; wBuffer ← 0 }

ELSE wBuffer ← SUCC[wBuffer];

fullBuffers ← fullBuffers+1;

IF lookerWaiting THEN NOTIFY bufferChange;

logged[wBuffer] ← lost[wBuffer] ← FALSE;

};

wanted: CARDINAL ← 0; -- 3MB

big: REF BOOL ← NEW[BOOL ← FALSE];

background: REF BOOL ← NEW[BOOL ← TRUE];

broadcast: REF BOOL ← NEW[BOOL ← FALSE];

pup: REF BOOL ← NEW[BOOL ← TRUE];

rpc: REF BOOL ← NEW[BOOL ← TRUE];

xns: REF BOOL ← NEW[BOOL ← TRUE];

arpa: REF BOOL ← NEW[BOOL ← TRUE];

breathOfLife: REF BOOL ← NEW[BOOL ← TRUE];

other: REF BOOL ← NEW[BOOL ← TRUE];

error: REF BOOL ← NEW[BOOL ← TRUE];

EthernetOneHostFilter: PROC [buffer: CommDriver.Buffer] RETURNS [reject: BOOL] = {

IF wanted = 0 THEN RETURN [FALSE];

IF broadcast^ AND buffer.ovh.encap.ethernetOneDest = Pup.allHosts THEN RETURN [FALSE];

IF buffer.ovh.encap.ethernetOneDest = wanted THEN RETURN [FALSE];

IF buffer.ovh.encap.ethernetOneSource = wanted THEN RETURN [FALSE];

RETURN[TRUE];

};

Recv: ENTRY CommDriver.RecvInterceptor = TRUSTED {

words: NAT = (bytes + Basics.bytesPerWord - 1) / Basics.bytesPerWord;

myBuffer: BufferIndex = wBuffer;

copy: Buffer ← buffers + myBuffer * bufferSize;

SELECT recv FROM

arpa => IF ~arpa^ THEN RETURN;

xns, xnsTranslate => IF ~xns^ THEN RETURN;

pup, pupTranslate => {

b: PupBuffer.Buffer = LOOPHOLE[buffer];

SELECT b.type.ORD FROM

IN [140B..177B] => IF ~rpc^ THEN RETURN;

ENDCASE => IF ~pup^ THEN RETURN; };

other => {

SELECT TRUE FROM

network.type = ethernetOne => -- 3MB

SELECT buffer.ovh.encap.ethernetOneType FROM

breathOfLife => IF ~breathOfLife^ THEN RETURN;

ENDCASE => IF ~other^ THEN RETURN;

ENDCASE => IF ~other^ THEN RETURN; };

error => IF ~error^ THEN RETURN;

ENDCASE => NULL; -- I wish the Compiler would catch these.

IF EthernetOneHostFilter[buffer] THEN RETURN; -- 3MB

copy.type ← recv;

copy.time ← BasicTime.GetClockPulses[];

copy.length ← bytes;

copy.encap ← buffer.ovh.encap;

PrincOpsUtils.LongCopy[

from: @buffer.data,

to: @copy.body,

nwords: MIN[words, copySize] ];

NextBuffer[];

};

interceptor: CommDriver.Interceptor;

network: CommDriver.Network ← CommDriver.GetNetworkChain[];

TakeEthernet: ENTRY PROC = {

recvMask: PACKED ARRAY CommDriver.RecvType OF BOOL ← ALL[TRUE];

interceptor ← CommDriver.CreateInterceptor[

network: network,

sendMask: ALL[FALSE],

sendProc: NIL,

recvMask: recvMask,

recvProc: Recv,

data: NIL,

promiscuous: TRUE];

};

GiveEthernet: ENTRY PROC = {

CommDriver.DestroyInterceptor[interceptor];

};

Synchronization with user type-in

inputActive: BOOL ← FALSE;

lookerActive: BOOL ← FALSE;

pauseWanted: BOOL ← FALSE;

inputChange: CONDITION;

lookerChange: CONDITION;

wantedPriority: Process.Priority ← Process.priorityBackground;

lookerPriority: Process.Priority;

ActivateLooker: ENTRY PROC RETURNS [BOOL] = {

ENABLE UNWIND => NULL;

IF lookerPriority # wantedPriority THEN Process.SetPriority[lookerPriority ← wantedPriority];

IF inputActive OR pauseWanted THEN {

WHILE inputActive OR pauseWanted DO WAIT inputChange ENDLOOP;

RETURN[FALSE] }

ELSE { lookerActive ← TRUE; RETURN[TRUE]; };

};

DeactivateLooker: ENTRY PROC = {

lookerActive ← FALSE;

IF inputActive THEN NOTIFY lookerChange;

};

ActivateInput: ENTRY PROC = {

ENABLE UNWIND => NULL;

WHILE inputActive DO WAIT inputChange ENDLOOP;

inputActive ← TRUE;

WHILE lookerActive DO WAIT lookerChange ENDLOOP;

};

DeactivateInput: ENTRY PROC = {

inputActive ← FALSE;

BROADCAST inputChange;

};

Output subroutines

mode: {display, disk} ← display;

dataBytesPerLine: NAT = 30;

tenMB: BOOL ← FALSE;

Displayline layout is:

time *leng dst←src type body...

3MB: 7777: *9999 377� 177777 0123 4567 8901 2345 6789 ...

10MB: 7777: *9999 xx25200012345←xx25200012345 177777 0123 4567 8901 2345 6789 ...

* => error

Tab: TYPE = {length, to, type, body};

displayTabs: ARRAY Tab OF REAL;

diskTabs: ARRAY Tab OF NAT;

InitTabs: PROC = {

length: ROPE ← "*7777: ";

to: ROPE ← "*7777: 9999 ";

hosts: ROPE ← IF tenMB THEN "xx25200012345←xx25200012345 " ELSE "377� ";

body: ROPE ← "177777 ";

displayTabs[length] ← GetLength[length];

displayTabs[to] ← GetLength[to];

displayTabs[type] ← displayTabs[to] + GetLength[hosts];

displayTabs[body] ← displayTabs[type] + GetLength[body];

diskTabs[length] ← Rope.Length[length];

diskTabs[to] ← Rope.Length[to];

diskTabs[type] ← diskTabs[to] + Rope.Length[hosts];

diskTabs[body] ← diskTabs[type] + Rope.Length[body];

};

WriteChar: PROC [CHARACTER] ← DisplayChar;

WriteMultiple: PROC [LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER] ←

DisplayMultiple;

WriteTab: PROC [tab: Tab] = {

SELECT mode FROM

display => SetDisplayPosition[displayTabs[tab]];

disk => SetDiskPosition[diskTabs[tab]];

ENDCASE => ERROR;

};

WriteDigit: PROC [card: CARDINAL] = INLINE { WriteChar['0+card]; };

WriteHexDigit: PROC [card: CARDINAL] = INLINE {

SELECT card FROM

IN [0..9] => WriteChar['0+card];

IN [10..15] => WriteChar['A+card-10];

ENDCASE => ERROR; };

WriteHexByte: PROC [card: CARDINAL] = INLINE {

WriteHexDigit[card/16];

WriteHexDigit[card MOD 16];

};

WriteString: PROC [s: LONG STRING] = {

WriteMultiple[DESCRIPTOR[@(s.text), s.length]];

};

hostNumber: REF TEXT ← NEW[TEXT[20]];

Write10MBHost: PROC [host: XNS.Host] = {

words: Words ← LOOPHOLE[@host];

first: NAT ← 0;

IF host = XNS.broadcastHost THEN { WriteChar['*]; RETURN; };

hostNumber.length ← 0;

hostNumber ← AppendField[hostNumber, words, SIZE[XNS.Host], octal];

IF hostNumber.length > 13 THEN first ← hostNumber.length-13;

FOR i: NAT IN [first..hostNumber.length) DO WriteChar[hostNumber[i]]; ENDLOOP;

};

WriteText: PROC [r: Rope.Text] = {

s: LONG STRING = LOOPHOLE[r];

WriteMultiple[DESCRIPTOR[@(s.text), s.length]];

};

WriteTextOctal: PROC [r: Rope.Text, n: CARDINAL] = {

s: LONG STRING = LOOPHOLE[r];

WriteMultiple[DESCRIPTOR[@(s.text), s.length]];

WriteOctal[n];

};

WriteOctal: PROC [n: CARDINAL] = {

SELECT n FROM

< 10B =>

Fastest case, probably most common, too.

GO TO Final;

< 100B => {

Second fastest case, probably second most common, too.

WriteDigit[(n / 10B)];

GO TO Final; };

< 1000B => {

WriteDigit[(n / 100B)];

WriteDigit[(n / 10B) MOD 10B];

GO TO Final; };

>= 10000B => {

IF n >= 100000B THEN WriteChar['1];

WriteDigit[(n / 10000B) MOD 10B]; };

ENDCASE;

WriteDigit[(n / 1000B) MOD 10B];

WriteDigit[(n / 100B) MOD 10B];

WriteDigit[(n / 10B) MOD 10B];

GO TO Final;

EXITS Final => WriteDigit[(n MOD 10B)];

};

WriteLongOctal: PROC [n: LONG CARDINAL] = {

SELECT n FROM

<= LAST[CARDINAL] => WriteOctal[n];

ENDCASE => {

radix: CARDINAL = 8;

radixPower: LONG CARDINAL ← 1;

lwb: LONG CARDINAL ← n/radix;

WHILE radixPower <= lwb DO radixPower ← radixPower*radix ENDLOOP;

WHILE radixPower > 0 DO

x: CARDINAL = n/radixPower;

WriteDigit[x];

n ← n - x*radixPower;

radixPower ← radixPower/radix;

ENDLOOP;

};

WriteDecimal: PROC [n: CARDINAL] = {

tenPower: CARDINAL ← 1;

n10: CARDINAL ← n/10;

WHILE tenPower <= n10 DO tenPower ← tenPower*10 ENDLOOP;

WHILE tenPower > 0 DO

x: CARDINAL = n/tenPower;

WriteDigit[x];

n ← n - x*tenPower;

tenPower ← tenPower/10;

ENDLOOP;

};

WriteLongDecimal: PROC [n: LONG CARDINAL] = {

tenPower: LONG CARDINAL ← 1;

n10: LONG CARDINAL ← n/10;

WHILE tenPower <= n10 DO tenPower ← tenPower*10 ENDLOOP;

WHILE tenPower > 0 DO

x: CARDINAL = n/tenPower;

WriteDigit[x];

n ← n - x*tenPower;

tenPower ← tenPower/10;

ENDLOOP;

};

prevMS: LONG CARDINAL ← 0;

Byte: TYPE = [0..256);

Major procedures

Watch: PROC [b: Buffer] = {

newMS: LONG CARDINAL = MSec[b.time];

SELECT (newMS-prevMS) FROM

< 10000 => WriteDecimal[(newMS-prevMS)];

< 1000*LONG[1000] => { -- 1000 seconds

WriteDecimal[(newMS-prevMS)/1000];

WriteChar['s]; }

ENDCASE => WriteText[IF prevMS = 0 THEN "first" ELSE "long"];

prevMS ← newMS;

WriteChar[' ];

WriteTab[length];

IF b.type = error THEN WriteChar['*];

WriteDecimal[b.length];

WriteTab[to];

IF tenMB THEN {

Write10MBHost[b.encap.ethernetDest];

WriteChar['←];

Write10MBHost[b.encap.ethernetSource]; }

ELSE {

WriteOctal[b.encap.ethernetOneDest];

WriteChar['←];

WriteOctal[b.encap.ethernetOneSource]; };

WriteTab[type];

WriteOctal[b.encap.ethernetOneType.ORD];

WriteTab[body];

FOR i: NAT IN [0..MIN[b.length, maxLength]) DO

IF (i > 0) AND ((i MOD dataBytesPerLine) = 0) THEN

SELECT mode FROM

display => EXIT;

disk => {WriteChar[Ascii.CR]; WriteTab[body]; };

ENDCASE => ERROR;

IF (i MOD 2 = 0) THEN WriteString[" "];

WriteHexByte[b.bytes[i]];

ENDLOOP;

WriteChar[Ascii.CR];

};

speed: {slow, fast} ← fast;

lookerCount: CARDINAL;

StartPause: PROC = {

WriteText["Pausing ..."];

SendNow[];

NotePausing[TRUE];

pauseWanted ← TRUE;

};

LookerMain: PROC = {

Process.SetPriority[lookerPriority ← wantedPriority];

DO

ENABLE ABORTED => EXIT;

this: BufferIndex = GetBuffer[];

IF ActivateLooker[] THEN {

IF lost[this] THEN {

WriteText["Lost packet(s)"];

WriteChar[Ascii.CR]; };

Watch[buffers + this * bufferSize];

ReturnBuffer[];

IF speed = slow AND (lookerCount ← lookerCount+1) >= threeQuarterScreen

THEN StartPause[];

DeactivateLooker[]; };

ENDLOOP;

};

WriteDiskLog: PROC = {

WriteChar ← DiskChar;

WriteMultiple ← DiskMultiple;

mode ← disk;

WriteChar[Ascii.CR];

ReplayBuffers[];

IF logged[GetBuffer[]] THEN {

WriteText["{ continued from previous logged packets }"];

WriteChar[Ascii.CR];

FOR i: NAT IN [0..fullBuffers) DO

this: BufferIndex = GetBuffer[];

buffer: Buffer = buffers + this * bufferSize;

IF logged[this] THEN prevMS ← buffer.time ELSE EXIT;

ReturnBuffer[];

ENDLOOP; }

ELSE {

IF wanted = 0 THEN WriteText["Watching all hosts"]

ELSE WriteTextOctal["Watching host ", wanted];

WriteChar[Ascii.CR]; };

FOR i: NAT IN [0..fullBuffers) DO

this: BufferIndex = GetBuffer[];

IF lost[this] THEN {

WriteText["Lost packet(s)"];

WriteChar[Ascii.CR]; };

Watch[buffers + this * bufferSize];

logged[this] ← TRUE;

ReturnBuffer[];

ENDLOOP;

DiskCommit[];

WriteChar ← DisplayChar;

WriteMultiple ← DisplayMultiple;

mode ← display;

};

user command input

WriteTitle: PROC = {

IF wanted = 0 THEN DisplayTitle["EtherWatch: Watching all hosts"]

ELSE DisplayTitle[

Rope.Cat["EtherWatch: Watching host ", Convert.RopeFromCard[wanted, 8]]];

};

DoAction: PROC [act: InputAction] = {

InputAction: TYPE = RECORD[SELECT act: * FROM

fast => NULL,

newHost => [name: ROPE],

pauseContinue => NULL,

quit => NULL,

replay => NULL,

slow => NULL,

start => NULL,

stop => NULL,

writeLog => NULL,

pktSize => [big: BOOL],

ENDCASE];

alreadyPaused: BOOL;

ActivateInput[];

alreadyPaused ← pauseWanted;

IF pauseWanted AND act.act # pauseContinue THEN WriteChar[Ascii.CR];

lookerCount ← 0;

WITH act: act SELECT FROM

fast => {

WriteText["Fast"];

speed ← fast;

NoteSlow[FALSE];

pauseWanted ← FALSE; };

newHost => {

WriteText["Host ... "];

SendNow[];

GiveEthernet[]; -- stops driver

SELECT Lookup[act.who] FROM

ok => {

WriteText["ok"];

SendNow[];

Clear[];

FlushBuffers[];

WriteTitle[];

pauseWanted ← FALSE; };

bad => WriteText["Need octal number in [0..377]"];

ENDCASE => ERROR;

tenMB ← network.type = ethernet;

InitTabs[];

TakeEthernet[]; }; -- starts driver

pktSize => AllocBuffers[big: act.big];

replay => {

Clear[];

WriteText["Replay (Slow)"];

ReplayBuffers[]; speed ← slow;

NoteSlow[TRUE];

pauseWanted ← FALSE; };

slow => {

WriteText["Slow"];

speed ← slow;

NoteSlow[TRUE];

pauseWanted ← FALSE; };

start => {

tenMB ← network.type = ethernet;

InitTabs[];

AllocBuffers[big: FALSE];

wanted ← 0;

WriteTitle[];

pauseWanted ← FALSE;

lookerProcess ← FORK LookerMain[];

TakeEthernet[]; };

stop => {

Process.Abort[lookerProcess];

JOIN lookerProcess;

GiveEthernet[];

FreeBuffers[]; };

writeLog => {

WriteText["Writing log file ... "];

SendNow[];

WriteDiskLog[];

WriteText["ok"]; };

pauseContinue =>

IF pauseWanted THEN { WriteText[" continuing"]; pauseWanted ← FALSE; }

ELSE StartPause[];

ENDCASE => ERROR;

IF ~pauseWanted OR alreadyPaused THEN WriteChar[Ascii.CR];

IF ~pauseWanted AND act.act # stop THEN NotePausing[FALSE];

DeactivateInput[];

};

Address Lookup

LookupOutcome: TYPE = { ok, bad };

Lookup: PROC [who: ROPE] RETURNS [outcome: LookupOutcome] = { -- 3MB

temp: LONG CARDINAL;

outcome ← ok;

temp ← Convert.CardFromRope[who, 8 ! Convert.Error => { outcome ← bad; CONTINUE; }];

IF outcome = bad OR temp > 377B THEN RETURN[bad];

wanted ← temp;

};

Display interface

font: ImagerFont.Font = VFonts.EstablishFont["Helvetica",8];

fontAscent: REAL ← ImagerFont.FontBoundingBox[font].ascent;

fontDescent: REAL ← ImagerFont.FontBoundingBox[font].descent;

fontSpace: REAL ← fontAscent+fontDescent;

topPos: REAL = fontAscent;

myViewer: Viewer;

pause, fast, slow, hostText: Viewer;

line: REF TEXT = NEW[TEXT[600]];

xPos: REAL ← 0.0;

yPos: REAL ← topPos; -- offset from top of text area

DisplayChar: PROC [c: CHAR] = {

IF c = Ascii.CR THEN { SendNow[]; xPos ← 0.0; yPos ← yPos + fontSpace; }

ELSE { line[line.length] ← c; line.length ← line.length+1 };

};

DisplayMultiple: PROC [desc: LONG DESCRIPTOR FOR PACKED ARRAY OF CHAR] = {

amount: CARDINAL = MIN[line.maxLength-line.length, LENGTH[desc]];

IF line.length MOD 2 = 0 THEN

PrincOpsUtils.LongCopy[

from: BASE[desc],

nwords: (amount+1)/2,

to: LOOPHOLE[line,LONG POINTER]+SIZE[TEXT[0]]+line.length/2]

ELSE FOR i: CARDINAL IN [0..amount) DO line[line.length+i] ← desc[i]; ENDLOOP;

line.length ← line.length + amount;

};

GetLength: PROC [r: ROPE] RETURNS [length: REAL] = {

RETURN[ImagerFont.RopeWidth[font, r].x]

};

SetDisplayPosition: PROC [pos: REAL] = {

SendNow[];

xPos ← pos;

};

SendNow: PROC = {

ViewerOps.PaintViewer[myViewer, client, FALSE, line];

line.length ← 0;

};

Clear: PROC = {

ViewerOps.PaintViewer[myViewer, client, FALSE, $Clear];

};

DisplayTitle: PROC [rope: ROPE] = {

myViewer.parent.name ← rope;

ViewerOps.PaintViewer[myViewer.parent, caption, FALSE, NIL];

};

myClass: ViewerClasses.ViewerClass = NEW[ViewerClasses.ViewerClassRec ←[

paint: MyPaint,

destroy: MyDestroy,

icon: tool]];

screenLines: CARDINAL ← 0;

threeQuarterScreen: CARDINAL ← 0;

MyPaint: ENTRY ViewerClasses.PaintProc = TRUSTED {

self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOLEAN

bounds: Imager.Rectangle = ImagerBackdoor.GetBounds[context];

box: Imager.Box ← [xmin: bounds.x, xmax: bounds.x+bounds.w, ymin: bounds.y, ymax: bounds.y+bounds.h];

IF whatChanged = NIL THEN {

tempY: REAL ← topPos;

yPos ← topPos;

screenLines ← 0;

WHILE box.ymax - tempY - fontDescent >= box.ymin DO

screenLines ← screenLines+1;

tempY ← tempY + fontSpace;

ENDLOOP;

threeQuarterScreen ← (screenLines * 3) / 4;

RETURN };

WITH whatChanged SELECT FROM

text: REF TEXT => {

IF box.ymax - yPos - fontDescent < box.ymin THEN yPos ← topPos;

IF xPos = 0.0 THEN {

start of a new line

yBase: REAL =

IF box.ymax - yPos - fontDescent - fontSpace < box.ymin

THEN topPos

ELSE yPos + fontSpace;

Imager.SetColor[context, Imager.white];

Imager.MaskBox[context, [

xmin: box.xmin, ymin: box.ymax - yBase - fontDescent,

xmax: box.xmax, ymax: box.ymax - yBase + fontAscent]];

Imager.SetColor[context, Imager.black];

};

Imager.SetXY[context, [box.xmin + xPos, box.ymax - yPos]];

Imager.SetFont[context, font];

FOR i: NAT IN [0..text.length) DO

We force all characters > \177 to be that character, to avoid problems with potentially small fonts for our printing.

IF text[i] > '\177 THEN text[i] ← '\177;

ENDLOOP;

Imager.ShowText[context, text];

xPos ← ImagerBackdoor.GetCP[context].x - box.xmin;

};

x: ATOM => SELECT x FROM

$Clear => {

Imager.SetColor[context, Imager.white];

Imager.MaskBox[context,

[xmin: box.xmin, ymin: box.ymin,

xmax: box.xmax, ymax: box.ymax - topPos + fontAscent]];

xPos ← 0.0;

yPos ← topPos;

};

ENDCASE => NULL;

};

MyDestroy: ViewerClasses.DestroyProc = TRUSTED {

self: Viewer

Process.Detach[FORK DoAction[[stop[]]]];

};

active: ATOM = $WhiteOnBlack;

Create: PROC RETURNS [text: Viewer] = {

returns viewer which is the non-scrolling text area

outer: Viewer = Containers.Create[

info: [name: "EtherWatch", column: right, scrollable: FALSE, iconic: TRUE]];

child: Viewer ← CreateChildren[outer];

Buttons.SetDisplayStyle[fast, active, FALSE];

text ← ViewerOps.CreateViewer[

flavor: $EtherWatch,

info: [parent: outer, scrollable: FALSE, border: FALSE, wx: 2, wy: child.wy + child.wh + 2]];

Containers.ChildXBound[outer, text];

Containers.ChildYBound[outer, text];

ViewerOps.OpenIcon[outer];

};

CreateChildren: PROC [v: Viewer] RETURNS [child: Viewer] = {

InputButton: PROC [name: ROPE, action: InputAction] = {

child ← Buttons.Create[

info: [name: name, parent: v, border: TRUE,

wx: IF child = NIL THEN 2 ELSE 2+child.wx+child.ww,

wy: IF child = NIL THEN 1 ELSE child.wy],

proc: DoSimpleAction,

clientData: NEW[InputAction ← action],

fork: TRUE];

};

SimpleLabel: PROC [name: ROPE, newLine: BOOL ← FALSE] = {

child ← Labels.Create[

info: [name: name, parent: v, border: FALSE,

wx: IF newLine THEN 2 ELSE 2+child.wx+child.ww,

wy: IF newLine THEN child.wy + child.wh + 2 ELSE child.wy]];

};

SimpleButton: PROC [name: ROPE, proc: Buttons.ButtonProc, newLine: BOOL ← FALSE, border: BOOL ← TRUE] RETURNS [Viewer] = {

child ← Buttons.Create[

info: [name: name, parent: v, border: border,

wx: IF newLine THEN 2 ELSE 2+child.wx+child.ww,

wy: IF newLine THEN child.wy + child.wh + 2 ELSE child.wy],

proc: proc, fork: TRUE];

RETURN [child];

};

child ← NIL;

InputButton["Continue", [pauseContinue[]]]; pause ← child;

InputButton["Fast", [fast[]]]; fast ← child;

InputButton["Slow", [slow[]]]; slow ← child;

InputButton["Replay", [replay[]]];

InputButton["Write log", [writeLog[]]];

[] ← SimpleButton["New host", DoHost];

[] ← SimpleButton[" Host: ", DoHostPrompt, FALSE, TRUE];

hostText ← ViewerTools.MakeNewTextViewer[

info: [parent: v, scrollable: FALSE, border: FALSE,

wx: 2+child.wx+child.ww, wy: child.wy,

ww: v.cw-(2+child.wx+child.ww), wh: child.wh]];

Containers.ChildXBound[v, hostText];

child ← MakeBool[name: "Bkg", init: background, change: DoPriority, parent: v, x: 2, y: child.wy+child.wh+2];

child ← MakeBool[name: "Big", init: big, change: DoSize, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "BC", init: broadcast, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "Pup", init: pup, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "RPC", init: rpc, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "XNS", init: xns, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "ARPA", init: arpa, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "BoL", init: breathOfLife, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "Oth", init: other, parent: v, x: child.wx+child.ww+2, y: child.wy];

child ← MakeBool[name: "Err", init: error, parent: v, x: child.wx+child.ww+2, y: child.wy];

};

BoolProc: TYPE = PROC [parent: Viewer, clientData: REF, value: BOOL];

Bool: TYPE = REF BoolRec;

BoolRec: TYPE = RECORD [

value: REF BOOL,

change: BoolProc,

clientData: REF,

button: Viewer ];

MakeBool: PROC [name: ROPE, init: REF BOOL, change: BoolProc ← NIL, clientData: REF ← NIL, parent: Viewer, x, y: INTEGER]

RETURNS [child: Viewer] = {

bool: Bool ← NEW [BoolRec ← [

value: IF init # NIL THEN init ELSE NEW [BOOL ← TRUE],

change: change,

clientData: clientData,

button: NIL ] ];

child ← Buttons.Create[

info: [name: name, parent: parent, border: TRUE, wx: x, wy: y],

proc: BoolHelper, clientData: bool, fork: TRUE, paint: TRUE];

bool.button ← child;

IF bool.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];

};

BoolHelper: Buttons.ButtonProc = TRUSTED {

parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL

self: Buttons.Button = NARROW[parent];

bool: Bool = NARROW[clientData];

bool.value^ ← ~bool.value^;

IF bool.value^ THEN Buttons.SetDisplayStyle[bool.button, $WhiteOnBlack]

ELSE Buttons.SetDisplayStyle[bool.button, $BlackOnWhite];

IF bool.change # NIL THEN bool.change[self.parent, bool.clientData, bool.value^];

};

NotePausing: ENTRY PROC [nowPausing: BOOL] = {

Buttons.ReLabel[pause, IF nowPausing THEN "Continue" ELSE "Pause"];

};

DoSimpleAction: Buttons.ButtonProc = TRUSTED {

parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL

DoAction[NARROW[clientData, REF InputAction]^];

};

isSlow: BOOL ← FALSE;

NoteSlow: ENTRY PROC [nowSlow: BOOL] = {

Buttons.SetDisplayStyle[IF isSlow THEN slow ELSE fast, $BlackOnWhite];

isSlow ← nowSlow;

Buttons.SetDisplayStyle[IF isSlow THEN slow ELSE fast, active];

};

DoHost: Buttons.ButtonProc = TRUSTED {

parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL

DoAction[[newHost[ViewerTools.GetContents[hostText]]]];

};

DoHostPrompt: Buttons.ButtonProc = TRUSTED {

parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL

text: Viewer = hostText;

SELECT mouseButton FROM

red => ViewerTools.SetSelection[text, NIL];

blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };

yellow => NULL;

ENDCASE => ERROR;

};

DoPriority: BoolProc = TRUSTED {

IF background^ THEN wantedPriority ← Process.priorityBackground

ELSE wantedPriority ← Process.priorityNormal;

};

DoSize: BoolProc = TRUSTED {

DoAction[[pktSize[big: big^]]];

};

Disk logging

logName: Rope.ROPE = "EtherWatch.log";

file: IO.STREAM;

lineLength: NAT ← 0;

lineMaxlength: NAT = 100;

firstChar: BOOL ← TRUE;

firstTime: BOOL ← TRUE;

DiskChar: PUBLIC PROC [c: CHAR] = {

IF firstChar THEN {

firstChar ← FALSE;

IF firstTime THEN {

firstTime ← FALSE;

file ← FS.StreamOpen[logName, $create]; }

ELSE {

[] ← FS.Copy[from: logName, to: logName, keep: 1 ! FS.Error => CONTINUE];

file ← FS.StreamOpen[logName, $append]; };

LogTime[]; };

IF c = Ascii.CR THEN { IO.PutChar[file, c]; lineLength ← 0 }

ELSE { IO.PutChar[file, c]; lineLength ← lineLength+1 };

};

LogTime: PROC = {

IO.PutRope[file, "EtherWatch.log written at "];

IO.Put[file, [time[BasicTime.Now[]]]];

};

DiskMultiple: PUBLIC PROC [desc: LONG DESCRIPTOR FOR PACKED ARRAY OF CHAR] = {

FOR i: CARDINAL IN [0..LENGTH[desc]) DO

c: CHAR = desc[i];

IF c IN [40C..176C] THEN DiskChar[c] ELSE DiskChar['?];

ENDLOOP;

};

SetDiskPosition: PUBLIC PROC [pos: NAT] = {

FOR i: NAT IN [lineLength..pos) DO

IO.PutChar[file, Ascii.SP];

lineLength ← lineLength.SUCC;

ENDLOOP;

};

DiskCommit: PUBLIC PROC = {

DiskChar[Ascii.CR];

IO.Close[file];

{

v: Viewer = ViewerOps.FindViewer["EtherWatch.log"].viewer;

IF v = NIL THEN [] ← ViewerTools.MakeNewTextViewer[

info: [name: logName, file: "EtherWatch.log", iconic: FALSE]]

ELSE ViewerOps.RestoreViewer[v];

};

firstChar ← TRUE;

};

48 bit host number conversion (snitched from ThisMachineImpl)

maxDigits: NAT = MAX[16];

Digits: TYPE = ARRAY [0..maxDigits) OF NAT;

Format: TYPE = {octal, productSoftware, hex};

Words: TYPE = POINTER TO ARRAY [0..3) OF WORD;

UnrecognizedFormatOption: ERROR = CODE;

This will break on a 32 bit machine.

AppendField: PROC [text: REF TEXT, words: Words, count: NAT, format: Format] RETURNS [REF TEXT] = {

digits: Digits;

base: NAT;

SELECT format FROM

octal => base ← 8;

productSoftware => base ← 10;

hex => base ← 16;

ENDCASE => ERROR UnrecognizedFormatOption;

TRUSTED {

ConvertToDigits[words, count, base, @digits];

text ← AppendDigits[text, @digits, base = 10]; };

IF base = 16 THEN text ← RefText.AppendChar[text, 'H];

RETURN[text];

};

ConvertToDigits: PROC [words: Words, size, base: NAT, digits: POINTER TO Digits] = TRUSTED {

digits^ ← ALL[0];

FOR i: NAT IN [0..size*Basics.bitsPerWord) DO

bit: CARDINAL ← ShiftFieldLeft[words, size, 1];

FOR j: NAT DECREASING IN [0..maxDigits) DO

digits[j] ← digits[j]*2 + bit;

IF digits[j] >= base THEN { digits[j] ← digits[j] - base; bit ← 1; }

ELSE bit ← 0;

ENDLOOP;

};

ShiftFieldLeft: PROC [words: Words, count: NAT, shift: INTEGER]

RETURNS [left: NAT] = TRUSTED {

right: WORD ← 0;

FOR i: NAT DECREASING IN [0..count) DO

left ← Basics.BITSHIFT[words[i], shift - 16];

words[i] ← Basics.BITOR[Basics.BITSHIFT[words[i], shift], right];

right ← left;

ENDLOOP;

};

AppendDigits: PROC [text: REF TEXT, digits: POINTER TO Digits, dashes: BOOL] RETURNS [REF TEXT] = TRUSTED {

something: BOOL ← FALSE;

FOR i: NAT IN [0..maxDigits) DO

v: NAT ← digits[i];

IF dashes AND something AND (maxDigits - i) MOD 3 = 0 THEN

text ← RefText.AppendChar[text, '-];

IF v # 0 AND ~something THEN {

IF dashes THEN {

SELECT maxDigits - i FROM

1 => text ← RefText.AppendRope[text, "0-00"];

2 => text ← RefText.AppendRope[text, "0-0"];

3 => text ← RefText.AppendRope[text, "0-"];

ENDCASE => NULL; };

IF v > 9 THEN text ← RefText.AppendChar[text, '0]; -- Leading digit for Hex case

something ← TRUE; };

IF something THEN {

c: CHAR ← IF v > 9 THEN v - 10 + 'A ELSE v + '0;

text ← RefText.AppendChar[text, c]; };

ENDLOOP;

IF ~something THEN text ← RefText.AppendChar[text, '0];

RETURN[text];

};

Initialization

Process.EnableAborts[@bufferChange];

Process.EnableAborts[@inputChange];

Process.EnableAborts[@lookerChange];

ViewerOps.RegisterViewerClass[$EtherWatch, myClass];

myViewer ← Create[];

DoAction[[start[]]];

DoAction[[newHost[NIL]]];

}.