
    <<ArpaICMPImpl.mesa>>
        <<Demers, August 28, 1987 1:36:58 am PDT>>

    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;

            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];
            };
    <<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;
                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]]];
            };

        <<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[];
        }...