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
~ {
Types
HWORD: TYPE ~ Basics.HWORD;
FWORD: TYPE ~ Basics.FWORD;
Address: TYPE ~ Arpa.Address;
Buffer: TYPE ~ ArpaICMPBuf.Buffer;
Errors
Error: PUBLIC ERROR [code: ATOM] ~ CODE;
IP Interface
ipHandle: ArpaIP.Handle ← NIL;
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.
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]]; };
UniqueIDs
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;
};
Checksums
ComputeICMPChecksum:
PROC [b: Buffer, bytes:
CARDINAL]
RETURNS [checksum:
HWORD] ~ {
Compute ICMP checksum field of packet as if checksum field were currently 0.
Yuck! Word-size and byte-order (?) dependent.
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]];
};
Handles / Objects
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;
Hash Table for Objects
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] ~ {
Insert newHandle in hash table. Called before finalization of newHandle is enabled.
i: HashIndex ~ Hash[newHandle.id];
newHandle.next ← objectTable^[i];
objectTable^[i] ← newHandle;
};
RemoveOldHandle:
ENTRY
PROC [h: Handle ← objectTableLock, oldHandle: Handle] ~ {
Delete oldHandle from hash table. Called during finalization of oldHandle.
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] };
Handle Create / Destroy
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.
Drop handle, let finalization remove it from table.
};
Sending
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];
};
Receiving
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]];
};
Incoming packets from IP
Statistics
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;
};
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];
};
Server Process
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;
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]]];
};
N.B. There should be a proc in Convert to convert between Arpa and "our" representation of the time.
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;
};
Finalization
Statistics
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;
};
Initialization
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[];
}...