<<>>
    <<SunRPCOnUDPImpl.mesa>>
        <<Copyright Ó 1989, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Demers, November 23, 1988 2:45:39 pm PST>>
        <<Carl Hauser, November 22, 1988 4:01:56 pm PST>>
        <<Willie-Sue, March 16, 1989 7:03:43 pm PST>>
        <<Michael Plass, September 23, 1991 11:51 am PDT>>
        <<David Nichols, January 15, 1991 5:44 pm PST>>
        <<Willie-s, August 21, 1991 12:27 pm PDT>>
        <<Chauser, January 14, 1992 1:21 pm PST>>
        <<Christian Jacobi, July 24, 1992 2:28 pm PDT>>

    DIRECTORY
        Arpa USING [Address, IsBroadcast, nullAddress],
        ArpaUDP USING [nullPort, Port],
        Basics USING [CopyBytes, FWORD, HWORD, UnsafeBlock],
        DatagramSocket USING [Create, Destroy, Error, GetLocal, Handle, Kick, Recv, Send],
        FinalizeOps USING [CallQueue, CreateCallQueue, EnableFinalization, FinalizeProc],
        Process USING [Detach],
        RefText USING [New, ObtainScratch, ReleaseScratch],
        Rope USING [ROPE],

        SunRPC,
        SunRPCAuth USING [Authenticate, AuthenticateResult, CheckReplyVerifier, Conversation, Flavor, maxValueBytes, nullFlavor],
        SunRPCNumbers USING [],
        SunRPCOnUDP,
        SunRPCType USING [AcceptStat, AuthStat, MsgType, RejectStat, ReplyStat, rpcVersion]
        ;

    SunRPCOnUDPImpl: CEDAR MONITOR
        LOCKS sd USING sd: PacketServer
        IMPORTS Arpa, Basics, DatagramSocket, FinalizeOps, Process, RefText, SunRPC, SunRPCAuth
        EXPORTS SunRPCOnUDP
        ~ {
        OPEN RPCT: SunRPCType;
    <<Types>>
        ROPE: TYPE ~ Rope.ROPE;

        Address: TYPE ~ Arpa.Address;
        nullAddress: Address ~ Arpa.nullAddress;

        Port: TYPE ~ ArpaUDP.Port;
        nullPort: Port ~ ArpaUDP.nullPort;

        UnsafeBlock: TYPE ~ Basics.UnsafeBlock;

        Handle: TYPE ~ REF Object;
        Object: TYPE ~ SunRPC.Object;

        Conversation: TYPE ~ SunRPCAuth.Conversation;
        AuthFlavor: TYPE ~ SunRPCAuth.Flavor;
            nullFlavor: AuthFlavor ~ SunRPCAuth.nullFlavor;
        AuthValue: TYPE ~ REF TEXT;

        Error: ERROR[code: ATOM] ~ SunRPC.Error;
    <<Parameters>>
        udpFlavor: ATOM ~ $UDP;

        dataBufBytes: CARDINAL ~ 8704;

        maxAuthBytes: CARDINAL ~ SunRPCAuth.maxValueBytes;
        maxRefTextLength: CARDINAL Ź 8*1024;
        maxUnsafeBlockLength: CARDINAL Ź CARDINAL.LAST - 3;    -- ensures stopIndexPlusOne fields won't overflow in calls to ByteBlt

        maxProcessesPerServer: CARDINAL ~ 6;

        minTimeout: CARD Ź 100;
        maxTimeout: CARD Ź 15*1000;

        maxRetries: CARDINAL Ź 20;
        maxReads: CARDINAL Ź 10;    -- max reads before resend

        retryCeiling: CARDINAL ~ 6;
        getTimeouts: ARRAY [0..retryCeiling] OF CARD ~ [ 250, 250, 500, 1000, 2000, 4000, 8000 ];

        ComputeGetTimeout: PROC [tryNo: CARDINAL, callTime: CARD]
        RETURNS [getTimeout: CARD] ~ INLINE {
            getTimeout Ź MAX[callTime, getTimeouts[MIN[tryNo, retryCeiling]]];
            };

        rwCacheSize: CARDINAL ~ 8;

        defaultReplyTTL: CARDINAL Ź 5; -- seconds
    <<LOOPHOLEs>>
        TextPtrFromRefText: UNSAFE PROC [block: REF READONLY TEXT] RETURNS [LONG POINTER] ~ TRUSTED INLINE {
            RETURN[ LOOPHOLE[block, LONG POINTER] + UNITS[TEXT[0]] ] };
    <<Client Handles>>
        PacketData: TYPE ~ REF PacketDataObject;
        PacketDataObject: TYPE ~ RECORD [
            datagramHandle: DatagramSocket.Handle,
            address: Arpa.Address Ź Arpa.nullAddress,
            port: ArpaUDP.Port Ź ArpaUDP.nullPort,
            lastRemoteAddress: Arpa.Address Ź Arpa.nullAddress,
            lastRemotePort: ArpaUDP.Port Ź ArpaUDP.nullPort,
            ttl: CARDINAL Ź 0,
            busy: BOOL Ź FALSE,
            sendBuf: REF TEXT,
            recvBuf: REF TEXT,
            index: CARDINAL Ź 0
            ];

        Create: PUBLIC PROC [remoteAddress: Address Ź nullAddress, remotePort: Port Ź nullPort] RETURNS [h: Handle]
            ~ {
            d: PacketData;
            h Ź NEW[Object];
            h.flavor Ź udpFlavor;
            h.procs Ź packetProcs;
            h.flavorData Ź d Ź NEW[PacketDataObject];
            d.sendBuf Ź RefText.ObtainScratch[dataBufBytes];
            d.recvBuf Ź RefText.ObtainScratch[dataBufBytes];
            d.datagramHandle Ź DatagramSocket.Create[];
            <<Default remote address is ME:>>
                IF remoteAddress=nullAddress THEN
                    remoteAddress Ź DatagramSocket.GetLocal[d.datagramHandle].address;
            h Ź SetRemote[h, remoteAddress, remotePort];
            [] Ź FinalizeOps.EnableFinalization[h, fQueue];
            };


        GetRemote: PUBLIC PROC [h: Handle] RETURNS [remoteAddress: Address, remotePort: Port]
            ~ {
            d: PacketData Ź NARROW[h.flavorData];
            remoteAddress Ź d.address;
            remotePort Ź d.port;
            };

        SetRemote: PUBLIC PROC [h: Handle, remoteAddress: Address, remotePort: Port]
        RETURNS [newH: Handle]
            ~ {
            d: PacketData Ź NARROW[h.flavorData];
            d.address Ź remoteAddress;
            d.port Ź remotePort;
            newH Ź h;
            };

        GetReplyAddress: PUBLIC PROC [h: Handle] RETURNS [remoteAddress: Address, remotePort: Port] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            RETURN[d.lastRemoteAddress, d.lastRemotePort];
            };
    <<Class procs>>
        packetProcs: REF SunRPC.ProcsObject ~ NEW[ SunRPC.ProcsObject Ź [
            destroy~DestroyPacketHandle,
            sendCallAndReceiveReply~SendCallAndReceiveReply,
            receiveAnotherReply~ReceiveAnotherReply,
            releaseReply~ReleaseReply,
            bytesRemaining~BytesRemaining,
            getByte~GetByte,
            getAlign~GetAlign,
            getH~GetH,
            getF~GetF,
            unsafeGetBlock~UnsafeGetBlock,
            getBlock~GetBlock,
            putByte~PutByte,
            putAlign~PutAlign,
            putH~PutH,
            putF~PutF,
            unsafePutBlock~UnsafePutBlock, 
            putBlock~PutBlock,
            prepareForMessage~PrepareForMessage
            ]];

        readerWriterProcs: REF SunRPC.ProcsObject ~ NEW[ SunRPC.ProcsObject Ź [
            destroy~DestroyReaderOrWriter,
            sendCallAndReceiveReply~CantSendCallAndReceiveReply,
            receiveAnotherReply~CantReceiveAnotherReply,
            releaseReply~ReleaseReply,
            bytesRemaining~BytesRemaining,
            getByte~GetByte,
            getAlign~GetAlign,
            getH~GetH,
            getF~GetF,
            unsafeGetBlock~UnsafeGetBlock,
            getBlock~GetBlock,
            putByte~PutByte,
            putAlign~PutAlign,
            putH~PutH,
            putF~PutF,
            unsafePutBlock~UnsafePutBlock, 
            putBlock~PutBlock,
            prepareForMessage~PrepareForMessage
            ]];

        DestroyPacketHandle: PROC [h: Handle] ~ {
            WITH h.flavorData SELECT FROM
                d: PacketData => {
                    IF d.sendBuf # NIL THEN { RefText.ReleaseScratch[d.sendBuf]; d.sendBuf Ź NIL };
                    IF d.recvBuf # NIL THEN { RefText.ReleaseScratch[d.recvBuf]; d.recvBuf Ź NIL };
                    IF d.datagramHandle # NIL THEN { DatagramSocket.Destroy[d.datagramHandle]; d.datagramHandle Ź NIL };
                    h.flavorData Ź NIL;
                    };
                ENDCASE;
            };

        DestroyReaderOrWriter: PROC [h: Handle] ~ {
            SELECT h.flavor FROM
                $reader, $writer => {
                    d: PacketData ~ NARROW[h.flavorData];
                    d.sendBuf Ź NIL;
                    d.recvBuf Ź NIL;
                    FreeLocalHandle[h~h];
                    };
                ENDCASE => Error[$wrongFlavor];
            };

        SendCallAndReceiveReply: PROC [h: Handle, timeoutMsec: CARD, retries: CARD] ~ {
            SendAndReceive[h, timeoutMsec, retries, TRUE];
            };

        CantSendCallAndReceiveReply: PROC [h: Handle, timeoutMsec: CARD, retries: CARD] ~ {
            Error[$wrongFlavor];
            };

        ReceiveAnotherReply: PROC [h: Handle, timeoutMsec: CARD] ~ {
            SendAndReceive[h, timeoutMsec, 0, FALSE];
            };

        CantReceiveAnotherReply: PROC [h: Handle, timeoutMsec: CARD] ~ {
            Error[$wrongFlavor];
            };

        SendAndReceive: PROC [h: Handle, timeoutMsec: CARD, retries: CARD, doSend: BOOL] ~ {
            d: PacketData Ź NARROW[h.flavorData]; 
            errorCode: ATOM Ź NIL;
            replyVerifier: AuthValue;
            tryNo: CARDINAL Ź 0;

            retries Ź MIN[retries, maxRetries];
            timeoutMsec Ź MAX[timeoutMsec, minTimeout];
            IF retries > 0 THEN timeoutMsec Ź MIN[timeoutMsec, maxTimeout];

            FOR tryNo: CARD IN [0 .. retries] DO
                IF doSend THEN {
                    errorCode Ź NIL;
                    DatagramSocket.Send[d.datagramHandle, d.address, d.port, d.sendBuf
                    ! DatagramSocket.Error => { errorCode Ź code; CONTINUE }];
                    SELECT errorCode FROM
                        NIL => NULL;
                        $transientError => LOOP;
                        ENDCASE => GOTO Done;
                    };
                THROUGH [0 .. maxReads) DO
                    d.index Ź 0;
                    errorCode Ź NIL;
                    [, d.lastRemoteAddress, d.lastRemotePort] Ź DatagramSocket.Recv[d.datagramHandle, d.recvBuf, 0, NAT.LAST, ComputeGetTimeout[tryNo, 
                    timeoutMsec]
                    ! DatagramSocket.Error => { errorCode Ź code; CONTINUE }];
                    SELECT errorCode FROM
                        NIL => {
                            <<Is it from the guy I'm interested in?>>
                                IF d.lastRemoteAddress # d.address
                                    THEN IF NOT Arpa.IsBroadcast[d.address]
                                        THEN LOOP;
                            <<Is it a reply message for this call?>>
                            { ENABLE Error => LOOP;
                                returnedXid, returnedMsgType: CARD32;
                                returnedXid Ź SunRPC.GetCard32[h];
                                returnedMsgType Ź SunRPC.GetCard32[h];
                                IF (returnedXid # h.xid) OR (returnedMsgType # ORD[RPCT.MsgType.reply]) THEN LOOP;
                                };
                            <<At this point, committed to accepting the reply message.  Parse it, switching on replyStat ...>>
                            { ENABLE Error => { errorCode Ź $protocolError; GOTO Done };
                                replyStat, acceptStat, rejectStat, authStat: CARD32;
                                replyFlavor: AuthFlavor;
                                SELECT (replyStat Ź SunRPC.GetCard32[h]) FROM
                                    ORD[RPCT.ReplyStat.msgAccepted] => {
                                        [replyFlavor, replyVerifier] Ź SunRPC.GetAuth[h];
                                        errorCode Ź SELECT SunRPCAuth.CheckReplyVerifier[NARROW[h.authData], replyFlavor, replyVerifier] FROM
                                            ok => NIL,
                                            badVerifier => $badReplyVerifier,
                                            wrongVerifier => $wrongReplyVerifier, 
                                            ENDCASE => ERROR;
                                        IF errorCode # NIL THEN GOTO Done;
                                        acceptStat Ź SunRPC.GetCard32[h];
                                        errorCode Ź SELECT acceptStat FROM
                                            ORD[RPCT.AcceptStat.success] => NIL, -- winner!
                                            ORD[RPCT.AcceptStat.progUnavail] => $wrongProgram,
                                            ORD[RPCT.AcceptStat.progMismatch] => $wrongProgramVersion,
                                            ORD[RPCT.AcceptStat.procUnavail] => $wrongProc,
                                            ENDCASE => $protocolError;
                                        GOTO Done;
                                        };
                                    ORD[RPCT.ReplyStat.msgDenied] => {
                                        SELECT (rejectStat Ź SunRPC.GetCard32[h]) FROM
                                            ORD[RPCT.RejectStat.rpcMismatch] => {
                                                errorCode Ź $wrongRPCVersion;
                                                };
                                            ORD[RPCT.RejectStat.authError] => {
                                                authStat Ź SunRPC.GetCard32[h];
                                                errorCode Ź SELECT authStat FROM
                                                    ORD[RPCT.AuthStat.authBadcred] => $badCredentials,
                                                    ORD[RPCT.AuthStat.authRejectedcred] => $wrongCredentials,
                                                    ORD[RPCT.AuthStat.authBadverf] => $badVerifier,
                                                    ORD[RPCT.AuthStat.authRejectedverf] => $wrongVerifier,
                                                    ORD[RPCT.AuthStat.authTooweak] => $weakCredentials,
                                                    ENDCASE => $protocolError;
                                                };
                                            ENDCASE => {
                                                errorCode Ź $protocolError
                                                };
                                        GOTO Done;
                                        };
                                    ENDCASE => {
                                        errorCode Ź $protocolError;
                                        GOTO Done;
                                        };
                                };
                            };
                        $timeout => {
                            errorCode Ź $timeout;
                            EXIT;        -- and repeat outer loop if we should
                            };
                        $transientError => {
                            LOOP;
                            };
                        $unreachable => {
                            errorCode Ź $unreachable;
                            EXIT;
                            };
                        ENDCASE => {
                            errorCode Ź $protocolError;
                            GOTO Done;
                            };
                    ENDLOOP;
                REPEAT
                    Done => NULL;
                ENDLOOP;
            IF replyVerifier # NIL
                THEN { RefText.ReleaseScratch[replyVerifier]; replyVerifier Ź NIL };
            IF errorCode # NIL THEN { ERROR Error[errorCode] };
            };

        ReleaseReply: PROC [h: Handle] ~ {
            h.authData Ź NIL; -- help finalization
            };
    <<Server Registration>>
        Server: TYPE ~ SunRPC.Server;
        ServerObject: TYPE ~ SunRPC.ServerObject;

        PacketServer: TYPE ~ REF PacketServerObject;
        PacketServerObject: TYPE ~ MONITORED RECORD [
            datagramHandle: DatagramSocket.Handle,
            serverPort: ArpaUDP.Port,
            dead: BOOL Ź FALSE,
            freeHandle: CONDITION,
            freeHandleIndex: CARDINAL Ź 0,
            handles: SEQUENCE concurrencyPlusOne: CARDINAL OF Handle
            ];

        myServerMgtProcs: SunRPC.ServerMgtProcs ~ NEW[SunRPC.ServerMgtProcsObject Ź [
            destroyServer~DestroyServer
            ]];

        CreateServer: PUBLIC PROC [pgm, version: CARD, serverProc: SunRPC.ServerProc, port: Port, concurrency: CARDINAL, clientData: REF] 
        RETURNS [s: Server]
            ~ {
            sd: PacketServer;
            concurrency Ź MAX[concurrency, 1];
            concurrency Ź MIN[concurrency, maxProcessesPerServer]; 
            sd Ź NEW[PacketServerObject[concurrency+1]];
            s Ź NEW[ServerObject];
            s.pgm Ź pgm;
            s.version Ź version;
            s.flavor Ź udpFlavor;
            s.flavorData Ź sd;
            s.mgtProcs Ź myServerMgtProcs;
            sd.datagramHandle Ź DatagramSocket.Create[port];
            sd.serverPort Ź DatagramSocket.GetLocal[sd.datagramHandle].port;
            s.clientData Ź clientData;
            s.serverProc Ź serverProc;
            FOR i: CARDINAL IN [0..concurrency+1) DO
                h: Handle Ź NEW[Object];
                d: PacketData Ź NEW[PacketDataObject];
                h.flavor Ź udpFlavor;
                h.flavorData Ź d;
                h.procs Ź packetProcs;
                d.sendBuf Ź RefText.ObtainScratch[dataBufBytes];
                d.recvBuf Ź RefText.ObtainScratch[dataBufBytes];
                d.datagramHandle Ź sd.datagramHandle;
                sd.handles[i] Ź h;
                ENDLOOP;
            createdServers Ź createdServers.SUCC;
            [] Ź FinalizeOps.EnableFinalization[s, fQueue];
            TRUSTED { Process.Detach[ FORK Serve[s, sd] ] };
            TRUSTED { Process.Detach[ FORK AgeResults[s, sd] ] };
            };

        GetServerPort: PUBLIC PROC [s: Server] RETURNS [port: Port] ~ {
            nS: Server ~ IF s.flavor=udpFlavor THEN s ELSE Error[$wrongFlavor];
            d: PacketServer ~ NARROW[s.flavorData];
            RETURN[ d.serverPort ];
            };

        DestroyServer: PROC [s: Server] ~ {
            sd: PacketServer ~ NARROW[s.flavorData];
            LockedDestroyServer: ENTRY PROC[ s: Server, sd: PacketServer ] ~ {
                IF NOT s.dead THEN destroyedServers Ź destroyedServers.SUCC;
                s.dead Ź TRUE;
                BROADCAST sd.freeHandle;
                DatagramSocket.Kick[sd.datagramHandle];
                <<Drop the server, let finalization finish it off.>>
                };
            LockedDestroyServer[s, sd];
            };
    <<Server Finalization>>
        <<Statistics>>
            createdServers: CARD Ź 0;
            droppedServers: CARD Ź 0;
            destroyedServers: CARD Ź 0;
            finishedServers: CARD Ź 0;

        FinalizeServer: PROC [s: Server] = {
            IF NOT s.dead
                THEN { -- Can't happen unless the daemons have failed for some reason ...
                    droppedServers Ź droppedServers.SUCC;
                    [] Ź FinalizeOps.EnableFinalization[s, fQueue];
                    DestroyServer[s];
                    }
                ELSE { -- Normal end of life
                    sd: PacketServer ~ NARROW[s.flavorData];
                    finishedServers Ź finishedServers.SUCC;
                    FOR i: CARDINAL IN [0 .. sd.concurrencyPlusOne) DO
                        h: Handle ~ sd.handles[i];
                        d: PacketData ~ IF h=NIL THEN NIL ELSE NARROW[h.flavorData];
                        IF d # NIL THEN {
                            IF d.sendBuf # NIL
                                THEN { RefText.ReleaseScratch[d.sendBuf]; d.sendBuf Ź NIL };
                            IF d.recvBuf # NIL
                                THEN { RefText.ReleaseScratch[d.recvBuf]; d.recvBuf Ź NIL };
                            d.datagramHandle Ź NIL;
                            };
                        ENDLOOP;
                    IF sd.datagramHandle # NIL
                        THEN { DatagramSocket.Destroy[sd.datagramHandle]; sd.datagramHandle Ź NIL };
                    };
            };
    <<Servers>>
        GetFreeHandle: ENTRY PROC [s: Server, sd: PacketServer] RETURNS [handle: Handle] ~ {
            <<client must assure that s.flavorData=sd>>
            WHILE NOT s.dead DO
                i: CARDINAL Ź sd.freeHandleIndex;
                bestTTL: CARDINAL Ź CARDINAL.LAST;
                bestIndex: CARDINAL Ź sd.concurrencyPlusOne;
                THROUGH [0 .. sd.concurrencyPlusOne) DO
                    h: Handle;
                    d: PacketData;
                    IF (i Ź i + 1) >= sd.concurrencyPlusOne THEN i Ź 0;
                    h Ź sd.handles[i];
                    d Ź NARROW[h.flavorData];
                    IF (NOT d.busy) AND (d.ttl < bestTTL)
                        THEN { bestTTL Ź d.ttl; bestIndex Ź i };
                    ENDLOOP;
                IF bestIndex < sd.concurrencyPlusOne THEN {
                    d: PacketData;
                    handle Ź sd.handles[bestIndex];
                    d Ź NARROW[handle.flavorData];
                    d.busy Ź TRUE;
                    RETURN;
                    };
                WAIT sd.freeHandle;
                ENDLOOP;
            };

        GetThisFreeHandle: ENTRY PROC [sd: PacketServer, h: Handle] RETURNS [gotIt: BOOL] ~ {
            d: PacketData Ź NARROW[h.flavorData];
            IF d.busy THEN RETURN [FALSE];
            RETURN [d.busy Ź TRUE];
            };

        NotifyFreeHandle: ENTRY PROC [sd: PacketServer, h: Handle] ~ {
            d: PacketData Ź NARROW[h.flavorData];
            d.busy Ź FALSE;
            BROADCAST sd.freeHandle;
            };

        AgeResults: ENTRY PROC [s: Server, sd: PacketServer] ~ {
            WHILE NOT s.dead DO
                FOR i: CARDINAL IN [0 .. sd.concurrencyPlusOne) DO
                    h: Handle ~ sd.handles[i];
                    d: PacketData Ź NARROW[h.flavorData];
                    IF d.busy THEN LOOP;
                    IF d.ttl > 0 THEN d.ttl Ź d.ttl - 1;
                    ENDLOOP;
                WAIT sd.freeHandle;
                ENDLOOP;
            };

        Serve: PROC [s: Server, sd: PacketServer] ~  {
            <<client must assure s.flavorData=sd>>
            h: Handle Ź GetFreeHandle[s, sd];
            d: PacketData;
            WHILE NOT s.dead DO
                ENABLE DatagramSocket.Error => {
                    SELECT code FROM
                        $transientError, $datagramTooShort, $datagramTooLong, $protocol => NULL;
                        <<$timeout, $handleDestroyed => s.dead _ TRUE;>>
                        ENDCASE => s.dead Ź TRUE;
                    LOOP;
                    };
                d Ź NARROW[h.flavorData];
                <<Attach the incoming datagram to the free handle ...>>
                    [, d.address, d.port] Ź DatagramSocket.Recv[sd.datagramHandle, d.recvBuf, 0, NAT.LAST];
                    d.index Ź 0;
                { ENABLE Error => CONTINUE;
                    msgType: CARD32;
                    h.xid Ź SunRPC.GetCard32[h];
                    msgType Ź SunRPC.GetCard32[h];
                    SELECT TRUE FROM
                        (msgType # ORD[RPCT.MsgType.call]) => {
                            NULL;
                            };
                        ENDCASE => {
                            isDuplicate: BOOL Ź FALSE;
                            finger: Handle;
                            fingerD: PacketData;
                            FOR i: CARDINAL IN [0 .. sd.concurrencyPlusOne) DO
                                finger Ź sd.handles[i];
                                fingerD Ź NARROW[finger.flavorData];
                                IF (finger # h) AND (finger.xid = h.xid) AND (fingerD.port = d.port) AND (fingerD.address = d.address) AND (fingerD.ttl > 0)
                                    THEN { isDuplicate Ź TRUE; EXIT };
                                ENDLOOP;
                            IF isDuplicate
                                THEN {
                                    IF GetThisFreeHandle[sd, finger] THEN {
                                        TRUSTED { Process.Detach[FORK SendDuplicateReply[s, finger]] };
                                        };
                                    }
                                ELSE -- not a duplicate -- {
                                    finger Ź GetFreeHandle[s, sd]; -- may block
                                    TRUSTED { Process.Detach[FORK CallServerProcAndSendReply[s, h]] };
                                    h Ź finger;
                                    };
                            };
                    };
                ENDLOOP;
            };

        SendDuplicateReply: PROC [s: Server, h: Handle] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            sd: PacketServer ~ NARROW[s.flavorData];
            DatagramSocket.Send[d.datagramHandle, d.address, d.port, d.sendBuf];
            d.ttl Ź MAX[d.ttl, defaultReplyTTL];
            NotifyFreeHandle[sd, h];
            };

        CallServerProcAndSendReply: PROC [s: Server, h: Handle] ~ {
            sd: PacketServer ~ NARROW[s.flavorData];
            errorCode: ATOM;
            credentials, verifier: AuthValue;
            sendReply: BOOL Ź TRUE;
            d: PacketData ~ NARROW[h.flavorData];
            d.ttl Ź defaultReplyTTL;
            BEGIN
                { ENABLE Error => { sendReply Ź FALSE; GOTO Out };
                    rpcvers, prog, vers, proc: CARD32;
                    cFlavor, vFlavor: AuthFlavor;
                    authResult: SunRPCAuth.AuthenticateResult;
                    conversation: Conversation;

                    <<Check RPC version (else we can't parse the message)>>
                        rpcvers Ź SunRPC.GetCard32[h];
                        IF (rpcvers # RPCT.rpcVersion)
                            THEN { errorCode Ź $wrongRPCVersion; GOTO Reply };
                    <<Get <prog, vers, proc>.  There's nothing we can do with them yet, until we've examined the credentials and verifier, but that's 
                    the way they defined the protocol.>>
                        prog Ź SunRPC.GetCard32[h];
                        vers Ź SunRPC.GetCard32[h];
                        proc Ź SunRPC.GetCard32[h];
                    <<Get credentials ...>>
                        [cFlavor, credentials] Ź SunRPC.GetAuth[h
                        ! Error => { errorCode Ź $badCredentials; GOTO Reply }];
                    <<Get verifier ...>>
                        [vFlavor, verifier] Ź SunRPC.GetAuth[h
                        ! Error => { errorCode Ź $badVerifier; GOTO Reply }];
                <<Authenticate ...>>
                    [authResult, h.authFlavor, h.authData, conversation] Ź SunRPCAuth.Authenticate[cFlavor, credentials, vFlavor, verifier];
                    IF authResult # ok THEN {
                        errorCode Ź SELECT authResult FROM
                            badCredentials => $badCredentials,
                            wrongCredentials => $wrongCredentials,
                            badVerifier => $badVerifier,
                            wrongVerifier => $wrongVerifier,
                            ENDCASE => ERROR;
                        GOTO Reply;
                        };
                    <<Check program, version ...>>
                        IF prog # s.pgm
                            THEN { errorCode Ź $wrongProgram; GOTO Reply };
                        IF vers # s.version
                            THEN { errorCode Ź $wrongProgramVersion; GOTO Reply };
                    <<Call the server proc!>>
                        [sendReply, d.ttl] Ź s.serverProc[h, conversation, proc, s.clientData
                        ! Error => { errorCode Ź code; CONTINUE }];
                    EXITS
                        Reply => NULL;
                    };

                { ENABLE Error => ERROR;
                    SELECT errorCode FROM
                        NIL => NULL;
                        $wrongRPCVersion => {
                            SunRPC.StartRejectReply[h, ORD[RPCT.RejectStat.rpcMismatch]];
                            SunRPC.PutCard32[h, RPCT.rpcVersion];
                            SunRPC.PutCard32[h, RPCT.rpcVersion];
                            };
                        $badCredentials => {
                            SunRPC.StartRejectReply[h, ORD[RPCT.RejectStat.authError]];
                            SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authBadcred]];
                            };
                        $wrongCredentials => {
                            SunRPC.StartRejectReply[h, ORD[RPCT.RejectStat.authError]];
                            SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authRejectedcred]];
                            };
                        $badVerifier => {
                            SunRPC.StartRejectReply[h, ORD[RPCT.RejectStat.authError]];
                            SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authBadverf]];
                            };
                        $wrongVerifier => {
                            SunRPC.StartRejectReply[h, ORD[RPCT.RejectStat.authError]];
                            SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authRejectedverf]];
                            };
                        $weakCredentials => {
                            SunRPC.StartRejectReply[h, ORD[RPCT.RejectStat.authError]];
                            SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authTooweak]];
                            };
                        $wrongProgram => {
                            SunRPC.StartAcceptReply[h, ORD[RPCT.AcceptStat.progUnavail]];
                            };
                        $wrongProgramVersion => {
                            SunRPC.StartAcceptReply[h, ORD[RPCT.AcceptStat.progMismatch]];
                            SunRPC.PutCard32[h, s.version];
                            SunRPC.PutCard32[h, s.version];
                            };
                        $wrongProc => {
                            SunRPC.StartAcceptReply[h, ORD[RPCT.AcceptStat.procUnavail]];
                            };
                        $abortWithoutReturn => {
                            sendReply Ź FALSE;
                            };
                        ENDCASE => {
                            SunRPC.StartAcceptReply[h, ORD[RPCT.AcceptStat.garbageArgs]];
                            };
                    };
                EXITS
                    Out => NULL;
                END;

            IF sendReply
                THEN -- send the reply -- {
                    d: PacketData Ź NARROW[h.flavorData];
                    DatagramSocket.Send[d.datagramHandle, d.address, d.port, d.sendBuf
                    ! DatagramSocket.Error => CONTINUE];
                    };

            h.authData Ź NIL; -- help finalization
            NotifyFreeHandle[sd, h];
            IF credentials # NIL THEN { RefText.ReleaseScratch[credentials]; credentials Ź NIL };
            IF verifier # NIL THEN { RefText.ReleaseScratch[verifier]; verifier Ź NIL };
            };
    <<Readers / Writers>>
        rwCache: PacketServer Ź NEW[PacketServerObject[rwCacheSize]];

        AllocLocalHandle: ENTRY PROC [flavor: ATOM, sd: PacketServer Ź rwCache]
        RETURNS [h: Handle]
            ~ {
            IF rwCache.freeHandleIndex > 0
            THEN {
                rwCache.freeHandleIndex Ź rwCache.freeHandleIndex - 1;
                h Ź rwCache.handles[rwCache.freeHandleIndex];
                rwCache.handles[rwCache.freeHandleIndex] Ź NIL;
                }
            ELSE {
                d: PacketData Ź NEW[PacketDataObject];
                h Ź NEW[Object];
                h.flavor Ź flavor;
                h.flavorData Ź d;
                h.procs Ź readerWriterProcs;
                };
            };

        FreeLocalHandle: ENTRY PROC [sd: PacketServer Ź rwCache, h: Handle] ~ {
            IF rwCache.freeHandleIndex < rwCacheSize THEN {
                rwCache.handles[rwCache.freeHandleIndex] Ź h;
                rwCache.freeHandleIndex Ź rwCache.freeHandleIndex + 1;
                };
            };

        OpenReader: PUBLIC PROC [block: REF TEXT] RETURNS [h: Handle] ~ {
            h Ź AllocLocalHandle[$reader];
            {
                d: PacketData Ź NARROW[h.flavorData];
                d.recvBuf Ź block;
                d.index Ź 0;
                d.recvBuf Ź block;
                };
            };

        OpenWriter: PUBLIC PROC [maxBytes: CARDINAL] RETURNS [h: Handle] ~ {
            dB: REF TEXT ~ RefText.New[maxBytes];
            h Ź AllocLocalHandle[$writer];
            {
                d: PacketData ~ NARROW[h.flavorData];
                d.sendBuf Ź dB;
                };
            dB.length Ź 0;
            };

        TextFromWriter: PUBLIC PROC [h: Handle] RETURNS [output: REF TEXT] ~ {
            hN: Handle ~ IF h.flavor=$writer THEN h ELSE Error[$wrongFlavor];
            d: PacketData ~ NARROW[hN.flavorData];
            output Ź d.sendBuf; 
            };

    <<Serializing / Deserializing>>
        BytesRemaining: PROC [h: Handle] RETURNS [bytes: CARDINAL] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            bytes Ź d.recvBuf.length - d.index;
            };

        GetByte: PROC [h: Handle] RETURNS [byte: BYTE] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.recvBuf;
            IF (d.index+BYTES[BYTE]) > dB.length THEN ERROR Error[$outOfData];
            byte Ź ORD[dB[d.index]];
            d.index Ź d.index+BYTES[BYTE];
            };

        GetH: PROC [h: Handle] RETURNS [hword: Basics.HWORD] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.recvBuf;
            IF (d.index+BYTES[Basics.HWORD]) > dB.length THEN ERROR Error[$outOfData];
            hword Ź [hi~ORD[dB[d.index]], lo~ORD[dB[d.index+1]]];
            d.index Ź d.index+BYTES[Basics.HWORD];
            };

        GetF: PUBLIC PROC [h: Handle] RETURNS [fword: Basics.FWORD] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.recvBuf;
            IF (d.index+BYTES[Basics.FWORD]) > dB.length THEN ERROR Error[$outOfData];
            fword Ź [
            hi~[hi~ORD[dB[d.index]], lo~ORD[dB[d.index+1]]],
            lo~[hi~ORD[dB[d.index+2]], lo~ORD[dB[d.index+3]]]];
            d.index Ź d.index+BYTES[Basics.FWORD];
            };

        UnsafeGetBlock: UNSAFE PROC [h: Handle, block: UnsafeBlock]
            ~ UNCHECKED {
            delta: INT Ź block.startIndex / BYTES[WORD]; -- delta is in WORDs
            block.base Ź block.base + delta*UNITS[WORD]; -- base is in UNITs
            block.startIndex Ź (block.startIndex - delta*BYTES[WORD]); -- index is in BYTEs
            IF (CARD[block.count] > maxUnsafeBlockLength)
            OR (UnsafeGetBlockInner[h, block] # CARD[block.count])
                THEN ERROR Error[$outOfData];
            };

        UnsafeGetBlockInner: UNSAFE PROC [h: Handle, block: UnsafeBlock]
        RETURNS[bytesMoved: CARDINAL]
            ~ {
            d: PacketData ~ NARROW[h.flavorData];
            IF (bytesMoved Ź MIN[CARD[block.count], d.recvBuf.length - d.index]) > 0 THEN {
                TRUSTED {
                    Basics.CopyBytes[
                        dstBase: block.base, dstStart: block.startIndex,
                        srcBase: TextPtrFromRefText[d.recvBuf], srcStart: d.index,
                        count: bytesMoved];
                    };
                d.index Ź d.index + bytesMoved;
                };
            };

        GetBlock: PROC [h: Handle, block: REF TEXT, startIndex, count: CARDINAL] ~ {
            actualCount: CARDINAL;
            IF startIndex > block.length THEN ERROR;
            count Ź MIN[count, CARDINAL[CARDINAL[block.maxLength]-startIndex]];
            TRUSTED { actualCount Ź UnsafeGetBlockInner[h, [base~TextPtrFromRefText[block], startIndex~startIndex, count~count]] };
            block.length Ź startIndex + actualCount;
            IF actualCount # count THEN ERROR Error[$outOfData];
            };

        GetAlign: PROC [h: Handle] ~ {
            n: CARDINAL ;
            d: PacketData ~ NARROW[h.flavorData];
            IF (n Ź (d.index MOD 4)) # 0 THEN d.index Ź d.index + 4 - n;
            };

        PutByte: PROC [h: Handle, byte: BYTE] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.sendBuf;
            index: CARDINAL Ź dB.length;
            IF (index + BYTES[BYTE]) > dB.maxLength
            THEN ERROR Error[$outOfBufferSpace];
            dB.length Ź index + BYTES[BYTE];
            dB[index] Ź VAL[byte];
            };

        PutH: PROC [h: Handle, hword: Basics.HWORD] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.sendBuf;
            index: CARDINAL Ź dB.length;
            IF (index + BYTES[Basics.HWORD]) > dB.maxLength
            THEN ERROR Error[$outOfBufferSpace];
            dB.length Ź index + BYTES[Basics.HWORD];
            dB[index] Ź VAL[hword.hi];
            dB[index+1] Ź VAL[hword.lo];
            };

        PutF: PROC [h: Handle, fword: Basics.FWORD] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.sendBuf;
            index: CARDINAL Ź dB.length;
            IF (index + BYTES[Basics.FWORD]) > dB.maxLength
            THEN ERROR Error[$outOfBufferSpace];
            dB.length Ź index + BYTES[Basics.FWORD];
            dB[index] Ź VAL[fword.hi.hi];
            dB[index+1] Ź VAL[fword.hi.lo];
            dB[index+2] Ź VAL[fword.lo.hi];
            dB[index+3] Ź VAL[fword.lo.lo];
            };

        UnsafePutBlock: UNSAFE PROC [h: Handle, block: UnsafeBlock]
            ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.sendBuf;

            TRUSTED {
                delta: INT Ź block.startIndex / BYTES[WORD]; -- delta in WORDs
                block.base Ź block.base + delta*UNITS[WORD]; -- base in UNITs
                block.startIndex Ź (block.startIndex - delta*BYTES[WORD]); -- index in BYTEs
                };
            SELECT CARD[block.count] FROM
                0 => RETURN;
                > maxUnsafeBlockLength => ERROR Error[$outOfBufferSpace];
                ENDCASE;
            IF (dB.length + block.count) > dB.maxLength
            THEN ERROR Error[$outOfBufferSpace];
            TRUSTED {
                Basics.CopyBytes[
                    dstBase: TextPtrFromRefText[dB], dstStart: dB.length,
                    srcBase: block.base, srcStart: block.startIndex,
                    count: block.count];
                };
            dB.length Ź dB.length + block.count;
            };

        PutBlock: PROC [h: Handle, block: REF READONLY TEXT, startIndex: CARDINAL Ź 0, count: CARDINAL]
            ~ TRUSTED {
            IF startIndex > block.length THEN ERROR;
            count Ź MIN[count, CARDINAL[CARDINAL[block.length]-startIndex]];
            UnsafePutBlock[h, [base~TextPtrFromRefText[block], startIndex~startIndex, count~count]];
            };

        PutAlign: PROC [h: Handle, padValue: BYTE] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.sendBuf;
            WHILE (dB.length MOD 4) # 0 DO
                PutByte[h, padValue];
                ENDLOOP;
            };

        PrepareForMessage: PROC [h: Handle] ~ {
            d: PacketData ~ NARROW[h.flavorData];
            dB: REF TEXT ~ d.sendBuf;
            dB.length Ź 0;
            };

    <<Finalization>>
        fQueue: FinalizeOps.CallQueue Ź FinalizeOps.CreateCallQueue[Finalizer];
        Finalizer: FinalizeOps.FinalizeProc = {
            WITH object SELECT FROM
                h: Handle => SunRPC.Destroy[h];
                s: Server => FinalizeServer[s];
                ENDCASE;
            };

        }...