-- Pupwatch: communications and user interface

-- [Indigo]<Grapevine>PupWatch>Cedar>Looker.mesa

-- Andrew Birrell October 25, 1983 11:29 am --

DIRECTORY
Ascii  USING[ CR, SP ],
BasicTime USING[ Pulses, PulsesToMicroseconds ],
BufferDefs USING[ Buffer, PupBuffer ],
DriverDefs USING[ ChangeNumberOfInputBuffers, GetDeviceChain ],
IO   USING[ PutFR ],
LookerDefs USING[ Clear, DiskChar, DiskCommit, DiskMultiple, DiskPos,
   GetLength, InputAction, NotePausing, NoteSlow, ScreenLines,
   SendNow, SetPos, DisplayChar, DisplayMultiple, WriteTitle ],
PrincOpsUtils  USING[ BITAND, IsBound, LongCOPY ],
Process  USING[ Abort, EnableAborts, Priority, priorityBackground, SetPriority ],
PupDefs  USING[ AnyLocalPupAddress, GetPupAddress, PupAddress, PupNameTrouble, PupPackageMake ],
PupTypes,
Rope  USING[ Length, ROPE ],
RPCWatch USING[ SetSpyProc ],
SpecialCommunication USING[ SetEthernetOneListener, SetSpyProc ],
TeledebugProtocol,
VM   USING[ AddressForPageNumber, Allocate, Free, Interval, PagesForWords ];

Looker: MONITOR

IMPORTS BasicTime, DriverDefs, IO, LookerDefs, PrincOpsUtils, Process, PupDefs, Rope, RPCWatch, SpecialCommunication, VM
EXPORTS LookerDefs
SHARES BufferDefs =

BEGIN

MSec: PROC[rawClock: BasicTime.Pulses] RETURNS[ LONG CARDINAL ] = INLINE
{ RETURN[BasicTime.PulsesToMicroseconds[rawClock]/1000] };


-- Pup level --

bufferSize: CARDINAL;
maxPupLength: CARDINAL;
bigPupLength: CARDINAL = PupTypes.maxDataBytesPerGatewayPup;
smallPupLength: CARDINAL = 54;

BufferData: TYPE = MACHINE DEPENDENT RECORD[
pupLength: CARDINAL,
pupTransportControl: [0..256),
pupType: PupTypes.PupType,
pupID: PupTypes.Pair,
dest: PupDefs.PupAddress,
source: PupDefs.PupAddress,
pupBody: SELECT OVERLAID * FROM
big => [bigChars: PACKED ARRAY[0..bigPupLength) OF CHARACTER],
small => [smallChars: PACKED ARRAY[0..smallPupLength) OF CHARACTER],
pupChars => [pupChars: PACKED ARRAY[0..0) OF CHARACTER],
pupBytes => [pupBytes: PACKED ARRAY[0..0) OF [0..377B]],
pupWords => [pupWords: ARRAY[0..0) OF CARDINAL],
pupString => [pupString: StringBody],
rfc => [address: PupDefs.PupAddress ],
ack => [maximumBytesPerPup, numberOfPupsAhead,
numberOfBytesAhead: CARDINAL ],
abort => [abortCode: CARDINAL,
abortText: PACKED ARRAY [0..0) OF CHARACTER ],
error => [errorHeader: ARRAY [0..9] OF WORD,
errorCode: PupTypes.PupErrorCode,
errorOptions: WORD,
errorText: PACKED ARRAY [0..0) OF CHARACTER],
nameIs => [nameIs: ARRAY [0..0) OF PupDefs.PupAddress ],
ENDCASE ];

Buffer: TYPE = LONG POINTER TO BufferData;

ContentsBytes: PROC[b: Buffer] RETURNS[CARDINAL] = INLINE
{ RETURN[ b.pupLength - 22 ] };

nBuffers: CARDINAL = 300;
BufferIndex: TYPE = [0..nBuffers);

bufferSpace: VM.Interval;
buffers: LONG POINTER TO --ARRAY BufferIndex OF-- BufferData ← NIL;

times: REF ARRAY BufferIndex OF BasicTime.Pulses ← NIL;

lost: PACKED ARRAY BufferIndex OF BOOLEAN ← ALL[FALSE];
logged: PACKED ARRAY BufferIndex OF BOOLEAN ← 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: BOOLEAN ← FALSE;
allUsed: BOOLEAN ← FALSE; -- whether all buffers have been written --

AllocBuffers: ENTRY PROC[big: BOOLEAN] =
BEGIN
IF buffers # NIL THEN FreeBuffers[];
bufferSize ← IF big THEN SIZE[big BufferData] ELSE SIZE[small BufferData];
bufferSpace ← VM.Allocate[VM.PagesForWords[LONG[nBuffers] * bufferSize]];
buffers ← VM.AddressForPageNumber[bufferSpace.page];
maxPupLength ← IF big THEN bigPupLength ELSE smallPupLength;
times ← NEW[ARRAY BufferIndex OF BasicTime.Pulses];
InnerFlush[];
END;

FreeBuffers: PROC =
BEGIN
VM.Free[bufferSpace];
times ← NIL;
END;

GetBuffer: ENTRY PROC RETURNS[BufferIndex] = --INLINE--
BEGIN
ENABLE UNWIND => lookerWaiting ← FALSE;
WHILE fullBuffers = 0
DO lookerWaiting ← TRUE; WAIT bufferChange ENDLOOP;
lookerWaiting ← FALSE;
RETURN[ rBuffer ]
END;

ReturnBuffer: ENTRY PROC = --INLINE--
{ rBuffer ← IF rBuffer = LAST[BufferIndex] THEN 0 ELSE SUCC[rBuffer];
fullBuffers ← fullBuffers-1;
NOTIFY bufferChange };

ReplayBuffers: ENTRY PROC =
BEGIN
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;
END;

FlushBuffers: ENTRY PROC =
{ InnerFlush[] };

InnerFlush: INTERNAL PROC =
BEGIN
rBuffer ← wBuffer ← 0;
fullBuffers ← 0; allUsed ← FALSE; lost ← ALL[FALSE]; logged ← ALL[FALSE];
waitingForBuffers ← FALSE;
NOTIFY bufferChange;
END;

waitingForBuffers: BOOLEAN ← FALSE;

NextBuffer: INTERNAL PROC = --INLINE--
BEGIN
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;
END;

wanted: PupDefs.PupAddress;
myNet: CARDINAL ← 0;

broadcast: BOOLEAN ← FALSE;

ShowBroadcast: PUBLIC --ENTRY-- PROC[wanted: BOOLEAN] =
BEGIN
broadcast ← wanted;
END;

Driver: ENTRY PROC[b: BufferDefs.Buffer] RETURNS[BOOLEAN] =
BEGIN
IF b.encapsulation.ethernetType = pup
AND ( ( (b.dest.host = wanted.host OR (broadcast AND b.dest.host = 0) OR wanted.host=0)
AND ( b.dest.net = wanted.net
OR ( b.dest.net = 0 AND wanted.net = myNet )
OR wanted.net = 0
)
)
OR ( ( b.source.host = wanted.host OR wanted.host = 0 )
AND ( b.source.net = wanted.net
OR ( b.source.net = 0 AND wanted.net = myNet )
OR wanted.net = 0
)
)
)
THEN BEGIN
myBuffer: BufferIndex = wBuffer;
times[myBuffer] ← b.time;
PrincOpsUtils.LongCOPY[from: @b.bufferBody, to: buffers + myBuffer * bufferSize,
nwords: MIN[ (b.pupLength+1)/2, bufferSize ] ];
NextBuffer[];
END;
RETURN[TRUE]--pkt still belongs to dispatcher--
END;

RPCDriver: SAFE PROC[b: BufferDefs.PupBuffer] = TRUSTED
BEGIN
[] ← Driver[LOOPHOLE[b]];
--TEMP: patch to prevent RPCRuntime getting confused --
IF b.dest.host # 0 AND b.dest.host # realHost THEN b.pupType ← LOOPHOLE[0];
END;

realHost: CARDINAL;

TakeEthernet: ENTRY PROC =
BEGIN
realHost ← DriverDefs.GetDeviceChain[].hostNumber;
DriverDefs.ChangeNumberOfInputBuffers[TRUE];
IF NOT SpecialCommunication.SetEthernetOneListener[
physicalOrder: 1, newHostNumber: 0--promiscuous--]
THEN ERROR;
SpecialCommunication.SetSpyProc[Driver];
IF PrincOpsUtils.IsBound[RPCWatch.SetSpyProc] THEN RPCWatch.SetSpyProc[RPCDriver];
END;

GiveEthernet: ENTRY PROC =
BEGIN
DriverDefs.ChangeNumberOfInputBuffers[FALSE];
IF NOT SpecialCommunication.SetEthernetOneListener[
physicalOrder: 1, newHostNumber: realHost]
THEN ERROR;
SpecialCommunication.SetSpyProc[NIL];
IF PrincOpsUtils.IsBound[RPCWatch.SetSpyProc] THEN RPCWatch.SetSpyProc[NIL];
END;





-- Synchronization with user type-in --

inputActive: BOOLEAN ← FALSE;
lookerActive: BOOLEAN ← FALSE;
pauseWanted: BOOLEAN ← FALSE;
inputChange: CONDITION;
lookerChange: CONDITION;
wantedPriority: Process.Priority ← Process.priorityBackground;
lookerPriority: Process.Priority;

ActivateLooker: ENTRY PROC RETURNS[ BOOLEAN ] = --INLINE--
BEGIN
ENABLE UNWIND => NULL;
IF lookerPriority # wantedPriority
THEN Process.SetPriority[lookerPriority ← wantedPriority];
IF inputActive OR pauseWanted
THEN BEGIN
WHILE inputActive OR pauseWanted DO WAIT inputChange ENDLOOP;
RETURN[FALSE]
END
ELSE BEGIN
lookerActive ← TRUE; RETURN[TRUE]
END;
END;

DeactivateLooker: ENTRY PROC = INLINE
{ lookerActive ← FALSE; IF inputActive THEN NOTIFY lookerChange };

ActivateInput: ENTRY PROC =
BEGIN
ENABLE UNWIND => NULL;
WHILE inputActive DO WAIT inputChange ENDLOOP;
inputActive ← TRUE;
WHILE lookerActive DO WAIT lookerChange ENDLOOP;
END;

DeactivateInput: ENTRY PROC =
BEGIN
inputActive ← FALSE; BROADCAST inputChange;
END;

NewPriority: PUBLIC ENTRY PROC[new: Process.Priority] =
BEGIN
wantedPriority ← new;
END;

-- Output subroutines --

mode: { display, disk} ← display;

-- Display line layout is:
-- 7777: from 77#377#777 [aData,L:777,to:177777]abcdefghijklmn
-- 7777: to 77#377#777 [aData,L:777,to:177777]abcdefghijklmn
tabFrom: REAL;
tabTo: REAL;
tabAddr: REAL;
tabPkt: REAL;
tabData: REAL;

-- Disk log line layout is:
-- 7777: from 377#377#377 [aData,L:1024,to:177777] abcdefghijklmn
-- 7777: to 377#377#377 [aData,L:1024,to:177777] abcdefghijklmn
diskFrom: CARDINAL;
diskPkt: CARDINAL;
diskDetails: CARDINAL;

InitTabs: PROC =
BEGIN
tabFrom ← LookerDefs.GetLength["7777: "];
tabTo ← tabFrom +
(LookerDefs.GetLength["from"]-LookerDefs.GetLength["to"]);
tabAddr ← tabFrom + LookerDefs.GetLength["from "];
tabPkt ← tabAddr + LookerDefs.GetLength["77#777#777 "];
tabData ← tabPkt + LookerDefs.GetLength["[aData,L:777,to:177777]"];
diskFrom ← 6; -- "7777: " --
diskPkt ← diskFrom + 17; -- "from 377#377#377 " --
diskDetails ← diskPkt + 25; -- "[aData,L:1024,to:177777] " --
END;

WriteChar: PROC[CHARACTER] ← LookerDefs.DisplayChar;

WriteMultiple: PROC[LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER] ←
LookerDefs.DisplayMultiple;

WriteString: PROC[s: LONG STRING] =
{ WriteMultiple[DESCRIPTOR[@(s.text),s.length]] };

WritePup: PROC[b: Buffer] = INLINE
{ WriteMultiple[DESCRIPTOR[@(b.pupChars),
MIN[ContentsBytes[b],maxPupLength]]] };

WriteOctal777: PROC[n: CARDINAL] =
BEGIN
IF n >= 10B
THEN BEGIN
IF n >= 100B
THEN WriteChar['0 + n / 100B];
WriteChar['0 + (n/10B) MOD 10B];
END;
WriteChar['0 + n MOD 10B];
END;

WriteOctal: PROC[n: CARDINAL] = INLINE
BEGIN
IF n < 1000B
THEN WriteOctal777[n]
ELSE WriteFullOctal[n];
END;

WriteFullOctal: PROC[n: CARDINAL] =
BEGIN
WriteOctal777[n/1000B];
WriteChar['0 + ((n/100B) MOD 10B)];
WriteChar['0 + ((n/10B) MOD 10B)];
WriteChar['0 + n MOD 10B];
END;

WriteLongOctal: PROC[n: LONG CARDINAL] =
BEGIN
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;
WriteChar['0+x];
n ← n - x*radixPower;
radixPower ← radixPower/radix;
ENDLOOP;
END;

WritePair: PROC[p: PupTypes.Pair] =
{ WriteOctal[p.a]; WriteChar[',]; WriteOctal[p.b] };

WriteDecimal: PROC[n: CARDINAL] =
BEGIN
tenPower: CARDINAL ← 1;
n10: CARDINAL ← n/10;
WHILE tenPower <= n10 DO tenPower ← tenPower*10 ENDLOOP;
WHILE tenPower > 0
DO x: CARDINAL = n/tenPower;
WriteChar['0+x];
n ← n - x*tenPower;
tenPower ← tenPower/10;
ENDLOOP;
END;

WriteAddr: PROC[addr: PupDefs.PupAddress] = INLINE
BEGIN
WriteOctal777[addr.net];
WriteChar['#];
WriteOctal777[addr.host];
WriteChar['#];
WriteOctal777[PrincOpsUtils.BITAND[addr.socket.b,777B]];
END;

WriteID: PROC[n: CARDINAL] = INLINE
BEGIN
WriteString["to:"];
WriteOctal[n];
END;

prevMS: LONG CARDINAL ← 0;

-- layout of Pup id's for Sequin/Leaf protocol --

SequinID: TYPE = MACHINE DEPENDENT RECORD[
allocate: Byte, receiveSequence: Byte,
control: SequinControl, sendSequence: Byte ];

Byte: TYPE = [0..256);

SequinControl: TYPE = MACHINE DEPENDENT {
data(0), ack(1), nop(2), restart(3),
check(4), open(5), break(6), close(7),
closed(8), destroy(9), dallying(10), quit(11),
broken(12), retransmit(13), stifle(14), openclose(15),
opendestroy(16), (255) };

leafSocket: PupTypes.PupSocketID = [a:0,b:43B];
lookupFileSocket: PupTypes.PupSocketID = [a:0,b:61B];
teleSwatSocket: PupTypes.PupSocketID = TeledebugProtocol.teleSwatSocket;

Watch: PROC[ b: Buffer, time: BasicTime.Pulses ] =
BEGIN
DefaultBodyPrintout: PROC[b: Buffer] = INLINE
{ WriteString["L:"]; WriteOctal[ContentsBytes[b]] };
BEGIN
mscSrv: BOOLEAN = b.source.socket = PupTypes.miscSrvSoc
OR b.dest.socket = PupTypes.miscSrvSoc;
leaf: BOOLEAN = b.source.socket = leafSocket
OR b.dest.socket = leafSocket;
lookupFile: BOOLEAN = b.source.socket = lookupFileSocket
OR b.dest.socket = lookupFileSocket;
teleSwat: BOOLEAN = b.source.socket = teleSwatSocket
OR b.dest.socket = teleSwatSocket;
newMS: LONG CARDINAL = MSec[time];
IF newMS >= prevMS + 10000
THEN IF newMS >= prevMS + 1000*LONG[1000] -- 1000 seconds --
THEN WriteString[IF prevMS = 0 THEN "first"L ELSE "long"L]
ELSE BEGIN
WriteDecimal[(newMS-prevMS)/1000];
WriteChar['s];
END
ELSE WriteDecimal[(newMS-prevMS) MOD 10000 ];
prevMS ← newMS;
WriteChar[':];
IF mode = display
THEN BEGIN
IF b.source.host = wanted.host
AND b.source.net = wanted.net
THEN { LookerDefs.SetPos[tabTo]; WriteString["to"];
LookerDefs.SetPos[tabAddr]; WriteAddr[b.dest] }
ELSE { LookerDefs.SetPos[tabFrom]; WriteString["from"];
LookerDefs.SetPos[tabAddr]; WriteAddr[b.source] };
LookerDefs.SetPos[tabPkt];
END
ELSE BEGIN
LookerDefs.DiskPos[diskFrom];
IF b.source.host = wanted.host
AND b.source.net = wanted.net
THEN { WriteString[" to "]; WriteAddr[b.dest] }
ELSE { WriteString["from "]; WriteAddr[b.source] };
LookerDefs.DiskPos[diskPkt];
END;
WriteChar['[];
BEGIN
type: STRING = SELECT b.pupType FROM

-- registered pup types
echoMe => "echoMe",
iAmEcho => "iAmEcho",
badEcho => "badEcho",
error => "error",
rfc => "rfc",
abort => "abort",
end => "end",
endRep => "endRep",
data => "data",
aData => "aData",
ack => "ack",
mark => "mark",
int => "int",
intRep => "intRep",
aMark => "aMark",
eData => "eData",
eAck => "eAck",
eEnd => "eEnd",
eAbort => "eAbort",
rpp => "rpp",
-- Cedar RPC pup types. Bits are:
-- 8..10: 3 (=> start at pt140)
-- 11: {end(0),notEnd(1)}
-- 12: {dontAck(0),pleaseAck(1)}
-- 13..15: {call,data,ack,spare,rfa}
LOOPHOLE[140B] => "RPC-call-end",
LOOPHOLE[141B] => "RPC-data-end",
LOOPHOLE[142B] => "RPC-ack",
LOOPHOLE[143B] => "RPC-spare",
LOOPHOLE[144B] => "RPC-RFA",
LOOPHOLE[150B] => "RPC-a-call-end",
LOOPHOLE[151B] => "RPC-a-data-end",
LOOPHOLE[152B] => "RPC-ping",
LOOPHOLE[153B] => "RPC-a-spare",
LOOPHOLE[154B] => "RPC-a-RFA",
LOOPHOLE[160B] => "RPC-call-more",
LOOPHOLE[161B] => "RPC-data-more",
LOOPHOLE[170B] => "RPC-a-call-more",
LOOPHOLE[171B] => "RPC-a-data-more",

-- unregistered pup types (possible overlap)
gatewayRequest--200-- =>
IF lookupFile THEN "fileLookup" ELSE "gatewayRequest",
--also dateTextRequest (socket 4), statisticsRequest (socket 22)
gatewayInfo--201-- =>
IF lookupFile THEN "fileInfo" ELSE "gatewayInfo",
--also dateTextIs (socket 4), statisticsAre (socket 22)
dateTenexRequest--202-- =>
IF lookupFile THEN "fileError"
ELSE IF teleSwat THEN "go" ELSE "dateTenexRequest",
dateTenexIs--203-- =>
IF teleSwat THEN "goReply" ELSE "dateTenexIs",
LOOPHOLE[204B] =>
IF teleSwat THEN "ack" ELSE "pt204",
dateAltoRequest--206-- => "dateAltoRequest",
dateAltoIs--207-- => "dateAltoIs",
mailCheck--210-- => "mailCheck",
mailIsNew--211-- => "mailIsNew",
mailNotNew--212-- => "mailNotNew",
mailError--213-- => "mailError",
mailCheckLaurel--214-- => "mailCheckL",
nameLookup--220-- => "nameLookup",
nameIs--221-- => "nameIs",
nameError--222-- => "nameError",
addressLookup--223-- => "addrLookup",
addressIs--224-- => "addrIs",
whereIsUser--230-- => "whereIsUser",
userIs--231-- => "userIs",
userError--232-- => "userError",
netDirVersion--240-- => "netDirVersion",
--also eventReport (socket 30)
sendNetDir--241-- => "sendNetDir",
--also eventReportReply (socket 30)
bootFileSend--244-- => "bootFileSend",
kissOfDeath--247-- => "kissOfDeath",
request--250-- =>
IF mscSrv THEN "userAuthReq" ELSE "request",
result--251-- =>
IF mscSrv THEN "userAuthOk" ELSE "result",
unsolicited--252-- =>
IF mscSrv THEN "userAuthBad" ELSE "unsolicited",
custodian--253-- => "custodian",
sync--254-- => "sync",
pineAck--255-- => "pineAck",
noop--256-- => "noop",
bootDirReq--257-- => "bootDirReq",
bootDirReply--260-- =>
IF NOT leaf THEN "bootDirReply"
ELSE SELECT LOOPHOLE[b.pupID,SequinID].control FROM
data=> "lData", ack=> "lAck",
nop=> "nop", restart=> "restart",
check=> "check", open=> "open",
break=> "break", close=> "close",
closed=>"closed", destroy=> "destroy",
dallying=>"dallying", quit=> "quit",
broken=>"broken", retransmit=> "retransmit",
stifle=>"stifle", openclose=> "openClose",
opendestroy=>"opendestroy",
ENDCASE => "leaf?",
TeledebugProtocol.coreStoreRequest--300-- => "wCore",
TeledebugProtocol.coreFetchRequest--301-- => "rCore",
TeledebugProtocol.diskAddressSetRequest--302-- => "diskAddr",
TeledebugProtocol.diskStoreRequest--303-- => "wDisk",
TeledebugProtocol.diskFetchRequest--304-- => "rDisk",
ENDCASE => NIL;
IF type = NIL
THEN BEGIN
WriteString["pt"];
WriteOctal[LOOPHOLE[b.pupType, CARDINAL]];
END
ELSE WriteString[type];
END;

WriteChar[',];

SELECT b.pupType FROM
error =>
SELECT b.errorCode FROM
badChecksumPupErrorCode =>
WriteString["badChecksum"];
noProcessPupErrorCode =>
WriteString["noSuchPort"];
resourceLimitsPupErrorCode =>
WriteString["resourceLimits"];
inconsistentPupErrorCode =>
WriteString["inconsistentPup"];
cantGetTherePupErrorCode =>
WriteString["cantGetThere"];
hostDownPupErrorCode =>
WriteString["hostDown"];
eightHopsPupErrorCode =>
WriteString["sixteenHops"];
tooBigPupErrorCode =>
WriteString["tooBigPup"];
iAmNotAGatewayPupErrorCode =>
WriteString["iAmNotAGateway"];
gatewayResourceLimitsPupErrorCode =>
WriteString["gatewayResources"];
ENDCASE => WriteOctal[LOOPHOLE[b.errorCode]];
mailCheck, mailCheckLaurel, nameLookup =>
IF mode # disk THEN WritePup[b];
nameIs =>
WriteAddr[b.nameIs[0]];
abort =>
WriteOctal[b.abortCode];
data, aData =>
BEGIN
l: CARDINAL = ContentsBytes[b];
WriteID[b.pupID.b+l];
WriteString[",L:"];
WriteOctal[l];
END;
ack =>
BEGIN
WriteID[b.pupID.b];
WriteString[",pups:"];
WriteOctal777[b.numberOfPupsAhead];
END;
mark, aMark =>
BEGIN
WriteID[b.pupID.b+1];
WriteString[",mk:"];
WriteOctal777[b.pupBytes[0]];
END;
rfc, echoMe =>
BEGIN
wellKnown: STRING = SELECT b.dest.socket FROM
PupTypes.telnetSoc => "telnet",
PupTypes.gatewaySoc => "gateway",
PupTypes.ftpSoc => "ftp",
PupTypes.miscSrvSoc => "miscSrv",
PupTypes.echoSoc => "echo",
PupTypes.bspTestSoc => "bspTest",
PupTypes.mailSoc => "mail",
PupTypes.eftpReceiveSoc => "eftp",
PupTypes.copyDiskSoc => "copyDisk",
PupTypes.rpcpSoc => "rpcp",
PupTypes.librarianSoc => "librarian",
PupTypes.pineSoc => "pine",
ENDCASE => NIL;
IF wellKnown # NIL
THEN WriteString[wellKnown]
ELSE BEGIN
IF b.dest.socket.b IN [50B..57B]
AND b.dest.socket.a IN [0..1]
THEN BEGIN -- RFC or EchoMe on a Grapevine socket --
gvSoc: STRING = SELECT b.dest.socket.b FROM
50B => "RS-enquire",
51B => "RS-update",
52B => "RS-poll",
53B => "GV-Lily",
54B => "MS-poll",
55B => "MS-forward",
56B => "MS-send",
57B => "MS-retrieve",
ENDCASE => ERROR;
IF b.dest.socket.a = 1 THEN WriteString["Test-"];
WriteString[gvSoc];
END
ELSE IF b.dest.socket.a = 0
AND b.dest.socket.b IN [0 .. 256)
THEN WriteOctal777[b.dest.socket.b];
END;
END;
end, endRep, int, intRep => NULL;
IN [ LOOPHOLE[140B]..LOOPHOLE[171B] ] => --Cedar RPC packet--
BEGIN
--*** RPC header layout, stolen from RPCPkt.mesa --
RPCHeader: TYPE = MACHINE DEPENDENT RECORD[
length (0:0..14): [0..77777B],
oddByte (0:15..15): { no(0), yes(1) },
type (1):  RPCPktType,
destPSB (2):  CARDINAL--PSB.PsbIndex--,-- field has 6 extra bits
srcePSB (3):  CARDINAL--PSB.PsbIndex--,-- field has 6 extra bits
destHost (4):  CARDINAL--Machine--,
destSoc (5):  PupTypes.PupSocketID,
srceHost (7):  CARDINAL--Machine--,
srceSoc (8):  PupTypes.PupSocketID,
-- end of standard Pup header --
convLS (10):  CARDINAL--PktConversationID--,
convMS (11):  CARDINAL,
-- For secure conversations, the remainder of the packet must be encrypted --
pktID (12):  RPCPktID,
dispatcher (16): DispatcherDetails ];
RPCPktType: TYPE = MACHINE DEPENDENT RECORD[ -- "type" word of a Pup --
transport (0:0..7): [0..255], -- should be zero before sending --
subType (0:8..10): { rpc(3B), (7B) },
eom (0:11..11): { end(0), notEnd(1) },
ack (0:12..12): { dontAck(0), pleaseAck(1) },
class (0:13..15): { call(0), data(1), ack(2), rfa(4), (7) } ];
RPCPktID: TYPE = MACHINE DEPENDENT RECORD[
-- [ConversationID,PktID] uniquely identifies pkt for all hosts and time --
activity(0): CARDINAL--PSB.PsbIndex--,-- field has 6 extra bits--
callSeqLS(1): CARDINAL--CallCount--,
callSeqMS(2): CARDINAL,
pktSeq(3): CARDINAL ];
DispatcherDetails: TYPE = MACHINE DEPENDENT RECORD[
mds: CARDINAL, -- top half of dispatcher's MDS base address --
dispatcherID: LONG CARDINAL--DispatcherID--,
dispatcherHint: CARDINAL--ExportHandle-- -- hint to exporter host's export table -- ];
--*** --
h: LONG POINTER TO RPCHeader = LOOPHOLE[b];
overhead: CARDINAL = SIZE[RPCHeader]+1--checksum--;
WriteString["Len:"];
IF h.length < overhead
THEN { WriteString["?-"L]; WriteOctal777[overhead-h.length] }
ELSE WriteOctal777[h.length-overhead];
WriteString[",Cnv:"]; WriteOctal777[h.convLS MOD 1000B];
WriteString[",Call:"]; WriteOctal777[h.pktID.callSeqLS MOD 1000B];
WriteString[",Pkt:"]; WriteOctal777[h.pktID.pktSeq MOD 1000B];
IF h.type.class = call
THEN { WriteString[",Disp:"]; WriteOctal777[h.dispatcher.dispatcherHint MOD 1000B] };
END;
addressLookup =>
WriteAddr[b.nameIs[0]];
gatewayRequest =>
IF lookupFile AND mode # disk THEN WritePup[b];
bootDirReply =>
IF leaf
THEN BEGIN
id: SequinID = LOOPHOLE[b.pupID];
IF b.dest.socket = leafSocket
THEN BEGIN
WriteString["rec:"];
WriteOctal777[id.receiveSequence];
WriteString[",send:"];
WriteOctal777[id.sendSequence];
END
ELSE BEGIN
WriteString["send:"];
WriteOctal777[id.sendSequence];
WriteString[",rec:"];
WriteOctal777[id.receiveSequence];
END;
-- WriteString[",alloc:"];
-- WriteOctal777[id.allocate];
IF id.control = data
THEN BEGIN
l: CARDINAL = ContentsBytes[b];
WriteString[",L:"];
WriteOctal[l];
END;
END;
request =>
IF mscSrv THEN WriteString[@(b.pupString)] --userAuthReq--
ELSE WriteString["Pine-request"];
result =>
IF mscSrv THEN DefaultBodyPrintout[b] --userAuthOk--
ELSE WriteString["Pine-result"];
unsolicited =>
IF mscSrv THEN DefaultBodyPrintout[b] --userAuthBad--
ELSE WriteString["Pine-unsolicited"];
custodian => WriteString["Pine-unsolicited"];
sync => NULL;
pineAck => NULL;
noop => NULL;
TeledebugProtocol.coreStoreRequest, TeledebugProtocol.coreFetchRequest =>
IF teleSwat
THEN WriteLongOctal[LOOPHOLE[@b.pupBody,
LONG POINTER TO TeledebugProtocol.CoreStoreRequest].page];
TeledebugProtocol.diskAddressSetRequest, TeledebugProtocol.diskFetchRequest =>
IF teleSwat AND ContentsBytes[b] = 2*SIZE[TeledebugProtocol.DiskAddressSetRequest]
THEN WriteLongOctal[LOOPHOLE[@b.pupBody,
LONG POINTER TO TeledebugProtocol.DiskAddressSetRequest].page];
ENDCASE => DefaultBodyPrintout[b];
WriteChar[']];
IF mode = disk
THEN BEGIN
LookerDefs.DiskPos[diskDetails];
WriteString["ID="];
WritePair[b.pupID];
WriteString[" from="];
WritePair[LOOPHOLE[b.source.socket]];
WriteString[" to="];
WritePair[LOOPHOLE[b.dest.socket]];
BEGIN
l: CARDINAL = MIN[ContentsBytes[b],maxPupLength];
WriteChar[Ascii.CR];
LookerDefs.DiskPos[diskFrom];
LookerDefs.DiskPos[diskPkt];
IF l = 0 THEN WriteString["{empty}"] ELSE WritePup[b];
WriteChar[Ascii.CR];
LookerDefs.DiskPos[diskFrom];
LookerDefs.DiskPos[diskPkt];
WriteString["Bytes="];
IF l = 0
THEN WriteString["{empty}"]
ELSE FOR i: CARDINAL IN [0..l)
DO WriteOctal777[b.pupBytes[i]];
WriteChar[Ascii.SP]
ENDLOOP;
WriteChar[Ascii.CR];
LookerDefs.DiskPos[diskFrom];
LookerDefs.DiskPos[diskPkt];
WriteString["Words="];
IF l = 0
THEN WriteString["{empty}"]
ELSE FOR i: CARDINAL IN [0..l/2)
DO WriteOctal[b.pupWords[i]];
WriteChar[Ascii.SP]
ENDLOOP;
END;
END
ELSE IF b.pupType = data OR b.pupType = aData
THEN { LookerDefs.SetPos[tabData]; WritePup[b] };
WriteChar[Ascii.CR];
END;
END;


speed: {slow, fast} ← fast;
lookerCount: CARDINAL;

StartPause: PROC =
BEGIN
WriteString["Pausing ..."L]; LookerDefs.SendNow[];
LookerDefs.NotePausing[TRUE]; pauseWanted ← TRUE;
END;

LookerMain: PROC =
BEGIN
countLimit: CARDINAL = 40;
Process.SetPriority[lookerPriority ← wantedPriority];
DO ENABLE ABORTED => EXIT;
this: BufferIndex = GetBuffer[];
IF ActivateLooker[]
THEN BEGIN
IF lost[this]
THEN { WriteString["Lost packet(s)"L]; WriteChar[Ascii.CR] };
Watch[buffers + this * bufferSize, times[this]];
ReturnBuffer[];
IF speed = slow
AND (lookerCount ← lookerCount+1) >= (LookerDefs.ScreenLines[] * 3) / 4
THEN StartPause[];
DeactivateLooker[];
END;
ENDLOOP;
END;

WriteDiskLog: PROC =
BEGIN
WriteChar ← LookerDefs.DiskChar;
WriteMultiple ← LookerDefs.DiskMultiple;
mode ← disk;
WriteChar[Ascii.CR];
ReplayBuffers[];
IF logged[GetBuffer[]]
THEN BEGIN
WriteString["{ continued from previous logged packets }"L];
WriteChar[Ascii.CR];
THROUGH [1..fullBuffers]
DO this: BufferIndex = GetBuffer[];
IF logged[this]
THEN prevMS ← MSec[times[this]]
ELSE EXIT;
ReturnBuffer[];
ENDLOOP;
END
ELSE BEGIN
WriteString["Watching host "L];
WriteOctal777[wanted.net]; WriteChar['#];
WriteOctal777[wanted.host]; WriteChar['#];
WriteChar[Ascii.CR];
END;
THROUGH [1..fullBuffers]
DO this: BufferIndex = GetBuffer[];
IF lost[this]
THEN { WriteString["Lost packet(s)"L]; WriteChar[Ascii.CR] };
Watch[buffers + this * bufferSize, times[this]];
logged[this] ← TRUE;
ReturnBuffer[];
ENDLOOP;
WriteChar ← LookerDefs.DisplayChar;
WriteMultiple ← LookerDefs.DisplayMultiple;
mode ← display;
LookerDefs.DiskCommit[];
END;



-- user command input --

WriteTitle: PROC =
BEGIN
LookerDefs.WriteTitle[IO.PutFR[ "PUPWatch: watching host %b#%b#",
[integer[wanted.net]], [integer[wanted.host]] ] ];
END;

DoAction: PUBLIC PROC[act: LookerDefs.InputAction] =
-- InputAction: TYPE = RECORD[SELECT act: * FROM
-- fast => NULL,
-- newHost => [name: Rope.ROPE],
-- pauseContinue => NULL,
-- quit => NULL,
-- replay => NULL,
-- slow => NULL,
-- writeLog => NULL,
-- pktSize => [big: BOOL],
-- ENDCASE];
BEGIN
alreadyPaused: BOOLEAN;
ActivateInput[];
alreadyPaused ← pauseWanted;
IF pauseWanted AND act.act # pauseContinue THEN WriteChar[Ascii.CR];
lookerCount ← 0;
WITH act: act SELECT FROM
fast =>
BEGIN
WriteString["Fast"L];
speed ← fast; LookerDefs.NoteSlow[FALSE]; pauseWanted ← FALSE;
END;
newHost =>
BEGIN
WriteString["Host ... "]; LookerDefs.SendNow[];
GiveEthernet[]; -- stops driver --
BEGIN
outcome: LookupOutcome;
net, host: [0..255];
[outcome, net, host] ← Lookup[act.name];
SELECT outcome FROM
ok =>
BEGIN
WriteString["ok"L]; LookerDefs.SendNow[];
wanted.net ← [net]; wanted.host ← [host];
LookerDefs.Clear[];
FlushBuffers[];
WriteTitle[];
pauseWanted ← FALSE;
END;
noResponse => WriteString["no name-lookup response"L];
badName => WriteString["name not found"L];
noRoute => WriteString["no route to that host"L];
ENDCASE => ERROR;
END;
TakeEthernet[]; -- starts driver --
END;
pktSize =>
AllocBuffers[big: act.big];
replay =>
BEGIN
LookerDefs.Clear[];
WriteString["Replay (Slow)"L];
ReplayBuffers[]; speed ← slow; LookerDefs.NoteSlow[TRUE];
pauseWanted ← FALSE;
END;
slow =>
BEGIN
WriteString["Slow"L];
speed ← slow; LookerDefs.NoteSlow[TRUE];
pauseWanted ← FALSE;
END;
start =>
BEGIN
InitTabs[];
AllocBuffers[big: FALSE];
PupDefs.PupPackageMake[];
wanted ← PupDefs.AnyLocalPupAddress[PupTypes.fillInSocketID]; myNet ← wanted.net;
WriteTitle[];
pauseWanted ← FALSE;
lookerProcess ← FORK LookerMain[];
TakeEthernet[];
END;
stop =>
BEGIN
Process.Abort[lookerProcess];
JOIN lookerProcess;
GiveEthernet[];
FreeBuffers[];
END;
writeLog =>
IF version = boot
THEN WriteString["""Write log"" isn't implemented in this version"L]
ELSE BEGIN
WriteString["Writing log file ... "L]; LookerDefs.SendNow[];
WriteDiskLog[];
WriteString["ok"L];
END;
pauseContinue =>
IF pauseWanted
THEN { WriteString[" continuing"L]; pauseWanted ← FALSE; }
ELSE StartPause[];
ENDCASE => ERROR;
IF NOT pauseWanted OR alreadyPaused THEN WriteChar[Ascii.CR];
IF NOT pauseWanted AND act.act # stop THEN LookerDefs.NotePausing[FALSE];
DeactivateInput[];
END;

-- Address Lookup --

LookupOutcome: TYPE = { ok, badName, noResponse, noRoute };

Lookup: PROC[name: Rope.ROPE]
  RETURNS[outcome: LookupOutcome, net, host: [0..255]] =
BEGIN
addr: PupDefs.PupAddress;
outcome ← ok;
addr ← PupDefs.GetPupAddress[, IF name.Length[] = 0 THEN "ME" ELSE name !
PupDefs.PupNameTrouble =>
{ outcome ← SELECT code FROM noRoute => noRoute, noResponse => noResponse,
ENDCASE => badName;
CONTINUE } ];
net ← addr.net; host ← addr.host;
END;


-- Initialisation --

version: { bcd, image, boot } ← bcd;

lookerProcess: PROCESS;

-- Our display module hasn't been started yet --

SELECT version FROM
image => { STOP };
bcd => { NULL };
boot => { NULL };
ENDCASE => ERROR;

-- We're now fully running, possibly after ether-booting --

Process.EnableAborts[@bufferChange];
Process.EnableAborts[@inputChange];
Process.EnableAborts[@lookerChange];

END.