DIRECTORY
Arpa USING [Address],
ArpaBuf USING [Buffer],
ArpaExtras USING [NetAndSubnetNumber],
ArpaICMP USING [dontWait, nullID, waitForever],
ArpaICMPBuf USING [Buffer, hdrBytes],
ArpaIP USING [AllocBuffers, CreateHandle, DispatchICMP, FreeBuffers, GetSource, GetUserBytes, Handle, OnesComplementAddBlock, RecvProc, Send, SetUserBytes],
ArpaRouterPrivate USING [Redirect],
Basics USING [BITNOT, Card16FromH, FFromCard32, FWORD, HFromCard16, HWORD],
BasicTime USING [Now, Unpacked, Unpack],
Process USING [Detach, DisableTimeout, EnableAborts, MsecToTicks, priorityForeground, SecondsToTicks, SetPriority, SetTimeout],
SafeStorage USING [EnableFinalization, EstablishFinalization, FinalizationQueue, FQNext, NewFQ]
;

ArpaICMPImpl: CEDAR MONITOR
IMPORTS ArpaExtras, ArpaIP, ArpaRouterPrivate, Basics, BasicTime, Process, SafeStorage
EXPORTS ArpaICMP
~ {
HWORD: TYPE ~ Basics.HWORD;
FWORD: TYPE ~ Basics.FWORD;

Address: TYPE ~ Arpa.Address;
Buffer: TYPE ~ ArpaICMPBuf.Buffer;
Error: PUBLIC ERROR [code: ATOM] ~ CODE;
ipHandle: ArpaIP.Handle _ NIL;
IPBuffer: PROC [b: Buffer] RETURNS [ArpaBuf.Buffer] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[b]]; };
ICMPBuffer: PROC [aB: ArpaBuf.Buffer] RETURNS [Buffer] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[aB]]; };
Next: PROC [b: Buffer] RETURNS [Buffer] = TRUSTED INLINE {
RETURN[LOOPHOLE[b.ovh.next]]; };
nextID: CARD16 _ 512;
idLock: Handle ~ NEW[Object];

FixID: ENTRY PROC [h: Handle _ idLock, req: CARD16] RETURNS [id: HWORD] ~ {
IF req # ArpaICMP.nullID THEN RETURN [Basics.HFromCard16[req]];
id _ Basics.HFromCard16[nextID];
nextID _ nextID + 1;
};
ComputeICMPChecksum: PROC [b: Buffer, bytes: CARDINAL]
RETURNS [checksum: HWORD] ~ {
cs, words: CARDINAL;
IF (bytes MOD 2) # 0 THEN b.body.bytes[bytes-ArpaICMPBuf.hdrBytes] _ 0;
words _ (bytes + 1)/2;
cs _ Basics.BITNOT[LOOPHOLE[b.hdr2.checksum]];
TRUSTED { cs _ ArpaIP.OnesComplementAddBlock[ptr~@b.hdr2, count~words, initialSum~cs] };
checksum _ LOOPHOLE[Basics.BITNOT[cs]];
};
Handle: TYPE ~ REF Object;
Object: PUBLIC TYPE ~ MONITORED RECORD [
id: HWORD,
dead: BOOL _ FALSE,
waitForInput: CONDITION,
inputQueueSize: CARDINAL _ 0,
firstInput, lastInput: Buffer _ NIL,
next: Handle _ NIL
];

maxInputQueueSize: CARDINAL _ 6;

numHashHeaders: CARDINAL ~ 17;
HashIndex: TYPE ~ [0 .. numHashHeaders);

ObjectTable: TYPE ~ REF ObjectTableRep;
ObjectTableRep: TYPE ~ ARRAY HashIndex OF Handle;

objectTable: ObjectTable ~ NEW[ObjectTableRep];

objectTableLock: Handle ~ NEW[Object];

Hash: PROC [id: HWORD] RETURNS [HashIndex] ~ INLINE {
RETURN [Basics.Card16FromH[id] MOD numHashHeaders] };

AddNewHandle: ENTRY PROC [h: Handle _ objectTableLock, newHandle: Handle] ~ {
i: HashIndex ~ Hash[newHandle.id];
newHandle.next _ objectTable^[i];
objectTable^[i] _ newHandle;
};

RemoveOldHandle: ENTRY PROC [h: Handle _ objectTableLock, oldHandle: Handle] ~ {
i: HashIndex ~ Hash[oldHandle.id];
IF oldHandle = objectTable^[i]
THEN {
objectTable^[i] _ oldHandle.next }
ELSE {
prev: Handle;
FOR prev _ objectTable^[i], prev.next WHILE prev.next # oldHandle DO NULL ENDLOOP;
prev.next _ oldHandle.next };
oldHandle.next _ NIL; -- Help finalization of oldHandle.next^
};

FindHandle: PROC [id: HWORD] RETURNS [Handle] ~ {
i: HashIndex ~ Hash[id];
FOR handle: Handle _ objectTable^[i], handle.next UNTIL handle = NIL DO  -- ATOMIC
IF handle.id = id THEN RETURN[handle];
ENDLOOP;
RETURN[NIL] };
CreateHandle: PUBLIC PROC [id: CARD16] RETURNS [h: Handle] ~ {
IF ipHandle = NIL THEN ERROR Error[$cantRegisterProtocol];
h _ NEW [Object _ [id~FixID[req~id]]];
TRUSTED { Process.EnableAborts[@h.waitForInput] };
AddNewHandle[newHandle~h];
SafeStorage.EnableFinalization[h];
};

CreateDefaultHandle: PROC RETURNS [h: Handle] ~ {
h _ NEW [Object _ [id~[0, 0]]];
TRUSTED { Process.EnableAborts[@h.waitForInput] };
};

Kick: PUBLIC ENTRY PROC [h: Handle] ~ {
ENABLE UNWIND => NULL;
BROADCAST h.waitForInput;
};
DestroyHandle: PUBLIC ENTRY PROC [h: Handle] ~ {
h.dead _ TRUE;
UNTIL h.firstInput = NIL DO
b: Buffer _ h.firstInput;
h.firstInput _ Next[b];
b.ovh.next _ NIL;
ArpaIP.FreeBuffers[IPBuffer[b]];
h.inputQueueSize _ h.inputQueueSize.PRED;
ENDLOOP;
h.lastInput _ NIL; -- Help Buffer finalization.
};

AllocBuffer: PUBLIC PROC [h: Handle] RETURNS [b: Buffer] ~ {
b _ ICMPBuffer[ArpaIP.AllocBuffers[1]];
};

SetBodyBytes: PUBLIC PROC [b: Buffer, bodyBytes: CARDINAL, optionsBytes: CARDINAL] ~ {
ArpaIP.SetUserBytes[b~IPBuffer[b], bodyBytes~(bodyBytes+ArpaICMPBuf.hdrBytes), optionsBytes~optionsBytes];
};

Send: PUBLIC PROC [h: Handle, b: Buffer, address: Address] ~ {
bytes: CARDINAL;
SELECT b.hdr2.icmpType FROM
echo => b.body.echo.identifier _ h.id;
timestamp => b.body.timestamp.identifier _ h.id;
infoReply => b.body.infoReply.identifier _ h.id;
ENDCASE;
[bodyBytes~bytes] _ ArpaIP.GetUserBytes[IPBuffer[b]];
b.hdr2.checksum _ ComputeICMPChecksum[b, bytes];
[] _ ArpaIP.Send[ipHandle, IPBuffer[b], address, NIL];
};
SetGetTimeout: PROC [h: Handle, timeout: CARD] ~ {
SELECT timeout FROM
ArpaICMP.dontWait => ERROR;
ArpaICMP.waitForever => TRUSTED {
Process.DisableTimeout[@h.waitForInput] };
< CARDINAL.LAST => TRUSTED {
Process.SetTimeout[@h.waitForInput, Process.MsecToTicks[timeout] ]; };
ENDCASE => TRUSTED {
Process.SetTimeout[@h.waitForInput, Process.SecondsToTicks[timeout/1000] ]; };
};
Receive: PUBLIC ENTRY PROC [h: Handle, timeoutMsec: CARD] RETURNS [b: Buffer] ~ {
ENABLE UNWIND => NULL;
IF h = NIL THEN RETURN WITH ERROR Error[$receiveNilHandle];
IF (h.firstInput = NIL) AND (timeoutMsec # ArpaICMP.dontWait) THEN {
SetGetTimeout[h, timeoutMsec];
WAIT h.waitForInput;
};
IF (b _ h.firstInput) # NIL THEN {
IF (h.firstInput _ Next[b]) = NIL THEN h.lastInput _ NIL;
b.ovh.next _ NIL;
h.inputQueueSize _ h.inputQueueSize.PRED;
};
};

GetBodyBytes: PUBLIC PROC [b: Buffer] RETURNS [bodyBytes: CARDINAL, optionsBytes: CARDINAL] ~ {
[bodyBytes, optionsBytes] _ ArpaIP.GetUserBytes[IPBuffer[b]];
bodyBytes _ bodyBytes - ArpaICMPBuf.hdrBytes;
};

GetSource: PUBLIC PROC [b: Buffer] RETURNS [Address] ~ {
RETURN [ArpaIP.GetSource[IPBuffer[b]]];
};

FreeBuffer: PUBLIC PROC [h: Handle, b: Buffer] ~ {
ArpaIP.FreeBuffers[IPBuffer[b]];
};
errorTooShort: CARD _ 0;
errorChecksum: CARD _ 0;
errorNoHandle: CARD _ 0;
errorDeadHandle: CARD _ 0;
errorBuffersFull: CARD _ 0;

ChecksumsMatch: PROC [c1, c2: HWORD] RETURNS [BOOL] ~ INLINE { RETURN[c1=c2] };

TakeThis: ArpaIP.RecvProc -- [b: ArpaIP.Buffers, clientData: REF] RETURNS [rB: ArpaIP.Buffers] -- ~ {
buf: Buffer;
totalBytes, bodyBytes: CARDINAL;
h: Handle;

rB _ b;
[bodyBytes~totalBytes] _ ArpaIP.GetUserBytes[b];
IF totalBytes < ArpaICMPBuf.hdrBytes
THEN { errorTooShort _ errorTooShort.SUCC; GOTO Out };
bodyBytes _ totalBytes - ArpaICMPBuf.hdrBytes;
buf _ ICMPBuffer[b];
IF NOT ChecksumsMatch[buf.hdr2.checksum, ComputeICMPChecksum[buf, totalBytes]]
THEN { errorChecksum _ errorChecksum.SUCC; GOTO Out };
SELECT buf.hdr2.icmpType FROM
echoReply => h _ FindHandle[buf.body.echoReply.identifier];
timestampReply => h _ FindHandle[buf.body.timestampReply.identifier];
infoReply => h _ FindHandle[buf.body.infoReply.identifier];
ENDCASE => h _ defaultHandle;
IF h = NIL
THEN { errorNoHandle _ errorNoHandle.SUCC; h _ defaultHandle };
IF h = NIL
THEN GOTO Out;
IF h.dead
THEN { errorDeadHandle _ errorDeadHandle.SUCC; GOTO Out };
IF NOT TakeThisInner[h, buf]
THEN { errorBuffersFull _ errorBuffersFull.SUCC; GOTO Out };
rB _ NIL;

EXITS
Out => NULL;
};

TakeThisInner: ENTRY PROC [h: Handle, b: Buffer]
RETURNS [ok: BOOL] ~ {
IF h.inputQueueSize >= maxInputQueueSize THEN RETURN [FALSE];
h.inputQueueSize _ h.inputQueueSize.SUCC;
IF h.firstInput = NIL
THEN h.firstInput _ b
ELSE h.lastInput.ovh.next _ b;
h.lastInput _ b;
NOTIFY h.waitForInput;
RETURN [TRUE];
};
defaultHandle: Handle _ NIL;

Server: PROC ~ {
b: Buffer _ NIL;
defaultHandle _ CreateDefaultHandle[];
DO
IF b # NIL THEN ArpaIP.FreeBuffers[IPBuffer[b]];
b _ Receive[defaultHandle, ArpaICMP.waitForever];
IF b = NIL THEN LOOP;
SELECT b.hdr2.icmpType FROM
echoReply => NULL;
destUnreachable => { ReDispatch[b]; b _ NIL };
sourceQuench => { ReDispatch[b]; b _ NIL };
redirect => { Redirect[b] };
echo => { ReplyToEchoRequest[b] };
timeExceeded => { ReDispatch[b]; b _ NIL };
parameterProblem => NULL;
timestamp => { ReplyToTimestampRequest[b] };
timestampReply => NULL;
infoRequest => { ReplyToInfoRequest[b] };
infoReply => NULL;
ENDCASE => NULL;
ENDLOOP;
};

ReDispatch: PROC [b: Buffer] ~ {
ArpaIP.DispatchICMP[IPBuffer[b], b.body.destUnreachable.origHdr.protocol]; -- All redispatched messages have on origHdr field in the same place ... yuck!
};

Redirect: PROC [b: Buffer] ~ {
dest: Address;
SELECT b.hdr2.redirectCode FROM
network,  networkAndService =>
dest _ ArpaExtras.NetAndSubnetNumber[b.body.redirect.origHdr.dest];
host, hostAndService =>
dest _ b.body.redirect.origHdr.dest;
ENDCASE =>
RETURN;
ArpaRouterPrivate.Redirect[dest~dest, network~NARROW[b.ovh.network], immediate~b.body.redirect.address];
};

ReplyToEchoRequest: PROC [b: Buffer] ~ {
b.hdr2.icmpType _ echoReply;
Send[defaultHandle, b, ArpaIP.GetSource[IPBuffer[b]]];
};

ReplyToInfoRequest: PROC [b: Buffer] ~ {
b.hdr2.icmpType _ infoReply;
Send[defaultHandle, b, ArpaIP.GetSource[IPBuffer[b]]];
};

ReplyToTimestampRequest: PROC [b: Buffer] ~ {
theTimestamp: FWORD ~ Basics.FFromCard32[SecondsSinceMidnight[]];
b.hdr2.icmpType _ timestampReply;
b.body.timestampReply.receiveTimestamp _ theTimestamp;
b.body.timestampReply.transmitTimestamp _ theTimestamp;
Send[defaultHandle, b, ArpaIP.GetSource[IPBuffer[b]]];
};

SecondsSinceMidnight: PROC RETURNS [ms: INT] = {
secondsPerDay: INT _ 86400;
now: BasicTime.Unpacked _ BasicTime.Unpack[BasicTime.Now[]];
ms _ secondsPerDay;
IF now.dst = yes THEN ms _ ms - 3600;
ms _ ms + LONG[now.hour]*3600;
ms _ ms + LONG[(now.minute + now.zone)]*60;
ms _ ms + now.second;
ms _ ms MOD secondsPerDay;
ms _ ms * 1000;
};

droppedHandles: INT _ 0;
finishedHandles: INT _ 0;

ofq: SafeStorage.FinalizationQueue ~ SafeStorage.NewFQ[]; -- for Objects

ObjectFinalizer: PROC = {
Process.SetPriority[Process.priorityForeground];
DO
handle: Handle _ NARROW[SafeStorage.FQNext[ofq]];
IF NOT handle.dead
THEN { -- User forgot to call Destroy
SafeStorage.EnableFinalization[handle];
DestroyHandle[handle];
droppedHandles _ droppedHandles.SUCC; }
ELSE { -- Normal end of life
RemoveOldHandle[oldHandle~handle];
finishedHandles _ finishedHandles.SUCC };
handle _ NIL;
ENDLOOP;
};
Init: PROC ~ {
SafeStorage.EstablishFinalization[type: CODE[Object], npr: 1, fq: ofq];
ipHandle _ ArpaIP.CreateHandle[icmp, TakeThis, NIL, FALSE];
TRUSTED { Process.Detach[FORK ObjectFinalizer[]] };
TRUSTED { Process.Detach[FORK Server[]] };
};

Init[];
}...
‚ArpaICMPImpl.mesa
Demers, August 28, 1987 1:36:58 am PDT
Types
Errors
IP Interface
Buffer Type Coercions
... we're not actually smashing the types of the objects (they're all CommDriver.Buffer), but just LOOPHOLEing between IP and UDP buffer descriptions.

UniqueIDs
Checksums
Compute ICMP checksum field of packet as if checksum field were currently 0.
Yuck!  Word-size and byte-order (?) dependent.
Handles / Objects
Hash Table for Objects
Insert newHandle in hash table.  Called before finalization of newHandle is enabled.
Delete oldHandle from hash table.  Called during finalization of oldHandle.
Handle Create / Destroy

Drop handle, let finalization remove it from table.
Sending
Receiving

Incoming packets from IP
Statistics
Server Process
N.B. There should be a proc in Convert to convert between Arpa and "our" representation of the time.

Finalization
Statistics
Initialization
Κ
°˜
code™K™&K˜—š
Οk	˜	Kšœœ˜Kšœœ
˜Kšœœ˜&Kšœ	œ!˜/Kšœœ˜%Kšœœ
˜œ
Kšœœ˜#Kš	œœœœœ˜KKšœ
œ˜(Kšœœr˜KšœœN˜_K˜
K˜—šΟnœœ
˜KšœO˜VKšœ	˜K˜
head™Kšœœ
œ
˜Kšœœ
œ
˜K˜Kšœ	œ˜Kšœœ˜"—™Kš
žœœ
œœœ
˜(—™Kšœœ
˜—™K™–
K™š
žœœ
œœ
œ˜FKšœ
œ˜—š
ž
œœœœ
œ˜IKšœ
œ	˜—š
žœœ
œœ
œ˜:Kšœ
œ˜ ——š
ž	™	Kšœœ˜Kšœœ	˜K˜šžœœ
œœœœ˜KKšœœ
œ˜?Kš
œ ˜ Kš
œ˜K˜——™	š
žœœœœœ˜TKšœœ@™LK™.Kšœœ
˜Kšœœœ.˜GKš
œ˜Kšœœ
œ˜.KšœQ˜XKšœœœ˜'K˜——™Kšœœœ˜š	œœ
œ	œ
œ˜(Kšœœ
˜
Kšœœœ
˜Kšœ
˜Kšœœ˜Kšœ œ
˜$Kšœ˜K˜K˜—Kšœœ˜ —K˜š
ž™Kšœœ˜Kšœœ˜(K˜Kšœ
œœ˜'Kšœœœœ˜1K˜Kšœœ˜/K˜Kšœœ	˜&K˜š
žœœœœœ˜5Kšœœ˜5K˜—šžœœ
œ5˜MK™TKš
œ"˜"Kš
œ!˜!Kš
œ˜K˜K˜—šžœœ
œ5˜PK™KKš
œ"˜"šœ˜šœ˜Kš
œ"˜"—šœ˜K˜
Kš	œ#œœ
œ
˜RKš
œ˜——KšœœΟc'˜=K˜—šž
œœœœ
˜1Kš
œ˜š	œ/œ
œ
œŸ	˜RKšœœ
œ	˜&Kšœ
˜—Kšœ
œ˜——™š
žœœ
œœœ˜>Kšœœ
œ
œ˜:Kšœœ˜&Kšœ+˜2Kš
œ˜Icode2š
œ"˜"K˜K˜—šžœœ
œ˜1Kšœœ˜Kšœ+˜2K˜K˜—šžœœ
œ
œ˜'Kšœ
œœ
˜Kš	œ˜K˜K™—šž
œœ
œ
œ˜0Kšœ	œ
˜šœœ
˜Kš
œ˜Kš
œ˜Kšœ
œ
˜Kš
œ ˜ Kšœ$œ
˜)Kšœ
˜—KšœœŸ˜/K™3K˜——K˜™šžœœ
œ
œ˜<Kš
œ'˜'K˜—K˜š
žœœ
œœœ˜VKš
œj˜jK˜—K˜šžœœ
œ-˜>Kšœœ
˜šœ˜Kš
œ&˜&Kš
œ0˜0Kš
œ0˜0Kšœ
˜—K˜5Kš
œ0˜0Kšœ1œ˜6K˜——™	šž
œœœ˜2šœ	˜Kšœœ
˜šœœ˜!Kš
œ*˜*—šœœ
œœ˜Kš
œF˜F—šœœ˜Kš
œN˜N——Kš
œ˜K™—šžœœ
œ
œœœ˜QKšœ
œœ
˜Kšœœ
œ
œ
œ
œ˜;šœœœ#œ˜DK˜Kšœ˜K˜—šœœ
œ˜"Kšœœ
œœ
˜9Kšœ
œ
˜Kšœ$œ
˜)K˜—K˜K˜—šžœœ
œ
œ
œœ˜_K˜=Kš
œ-˜-K˜K˜—šž	œœ
œ
œ˜8Kšœ!˜'K˜K˜—šž
œœ
œ˜2K˜ K˜——š
œ™™
Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜—K˜Kšžœœ
œœœœœ
˜OK˜šžœŸGœ˜eK˜Kšœœ
˜ K˜
K˜K˜K˜0šœ"˜$Kšœ!œœ˜6—Kš
œ.˜.Kš
œ˜šœ
œH˜NKšœ!œœ˜6—šœ˜Kš
œ;˜;Kš
œE˜EKš
œ;˜;Kšœ˜—šœ˜
Kšœ!œ˜?—šœ˜
Kšœ
œ˜—šœ˜	Kšœ%œ
œ˜:—šœ
œ˜Kšœ'œœ˜<—Kšœœ
˜	K˜š
˜Kšœœ
˜—K˜K˜—š
ž
œœ
œœœ˜GKšœ'œ
œœ˜=Kšœ$œ
˜)šœ˜Kšœ˜Kšœ˜—K˜Kšœ˜Kšœœ˜K˜——™Kšœœ
˜K˜šžœœ˜Kšœœ
˜K˜&š
˜Kšœœ
œ!˜0Kš
œ1˜1Kšœœ
œ
œ
˜šœ˜Jšœ
œ
˜Jšœ(œ˜.Jšœ%œ˜+J˜Jš
œ"˜"Jšœ%œ˜+Jšœœ
˜Jš
œ,˜,Jšœœ
˜Jš
œ)˜)Jšœ
œ
˜Kšœœ
˜—Kšœ
˜—K˜K˜—šž
œœ˜ KšœKŸN˜™
K˜K˜—šžœœ˜K˜šœ˜š
œ˜Kš
œC˜C—˜Kš
œ$˜$—šœ˜
Kšœ
˜——Kšœ.œ4˜hK˜K˜—šžœœ˜(K˜K˜6K˜K˜—šžœœ˜(K˜K˜6K˜K˜—šžœœ˜-Kšœœ.˜AKš
œ!˜!Kš
œ6˜6Kš
œ7˜7K˜6K˜K˜—K™dK™šžœœ
œœ˜0Kšœœ	˜Kš
œ<˜<Kš
œ˜Kšœœ˜%Kšœ
œ˜Kšœ
œ˜+Kš
œ˜Kšœœ˜Kš
œ˜Kš
œ˜—K˜—™™
Kšœœ˜Kšœœ˜—K˜Kšœ:Ÿ˜HK˜šžœœ˜Kš
œ0˜0š
˜Kšœœ˜1šœ
œ˜šœŸ˜%Kš
œ'˜'Kš
œ˜Kšœ œ˜'—šœŸ˜Kš
œ"˜"Kšœ"œ˜)——Kšœ	œ
˜
Kšœ
˜—Kš
œ
˜——™šžœœ˜Kšœ(œ˜GKšœ/œœ˜;Kšœœ˜3Kšœœ
˜*K˜K˜—K˜—K˜——…—)~:°