
    <<SunYPAgentImpl.mesa>>
        <<Demers, September 25, 1987 5:23:00 pm PDT>>

    DIRECTORY
        Arpa USING [Address, nullAddress],
        ArpaUDP USING [nullPort, Port],
        Ascii USING [CR, FF, LF, SP, TAB],
        Basics USING [HFromCard16],
        BasicTime USING [earliestGMT, GMT, Now, Period],
        Process USING [Detach, PauseMsec],
        RefText USING [Append, New, ObtainScratch, ReleaseScratch],
        Rope USING [FromRefText, ROPE, ToRefText],
        SunPMap USING [ipProtocolUDP, udpPort],
        SunPMapClient USING [GetPort],
        SunRPC USING [Create, Destroy, Error, Handle, SetRemote],
        SunRPCAuth USING [Conversation, Initiate, Terminate],
        SunYP USING [EachMapNameProc, program, programVersion, ResponseKeyVal, ResponseVal, Status],
        SunYPAgent USING [TextSeq, TextSeqObject],
        SunYPClient USING [Domain, First, Maplist, Match, Next, Null],
        SymTab USING [Create, Fetch, Ref, Store, Update, UpdateAction, Val]
        ;

    SunYPAgentImpl: CEDAR MONITOR
        LOCKS lock USING lock: Lock
        IMPORTS Basics, BasicTime, Process, RefText, Rope, SunPMapClient, SunRPC, SunRPCAuth, SunYPClient, SymTab
        EXPORTS SunYPAgent
        ~ {
    <<Parameters>>
        msecBetweenSweeps: CARD _ 11111;
        initialServerTTL: CARDINAL _ 300;
        initialCachedValueTTL: CARDINAL _ 300;

        maxCachedValues: CARDINAL _ 31;

        defaultDomainName: ROPE _ "PARC"; -- should be in SystemSite or something ???
    <<Types>>
        ROPE: TYPE ~ Rope.ROPE;

        Lock: TYPE ~ REF LockObject;
        LockObject: TYPE ~ MONITORED RECORD [];

        Error: PUBLIC ERROR [code: ATOM] ~ CODE;
    <<Server Cache>>
        Server: TYPE ~ REF ServerObject;
        ServerObject: TYPE ~ RECORD [
            next: Server,
            address: Arpa.Address,
            port: ArpaUDP.Port,
            ttl: CARDINAL,
            down: BOOL
            ];

        serverTab: SymTab.Ref _ SymTab.Create[];

        serverLock: Lock ~ NEW[LockObject];
        serverList: Server _ NIL;
        nullServerLock: Lock ~ NEW[LockObject];
        nullServerList: Server _ NIL;

        GetServerByAddressAndPort: ENTRY PROC [address: Arpa.Address, port: ArpaUDP.Port, lock: Lock _ serverLock] RETURNS [server: Server] 
        ~ {
            FOR server _ serverList, server.next
            WHILE (server # NIL) AND ((server.address # address) OR (server.port # port))
                DO NULL ENDLOOP;
            IF server = NIL THEN {
                server _ NEW[ServerObject _ [serverList, address, port, initialServerTTL, FALSE]];
                serverList _ server;
                };
            };

        SweepServers: ENTRY PROC [seconds: CARD, lock: Lock _ serverLock] ~ {
            FOR server: Server _ serverList, server.next WHILE server # NIL DO
                server.ttl _ (IF server.ttl > seconds THEN server.ttl - seconds ELSE 0);
                ENDLOOP;
            };

        IsNullServer: PROC [server: Server] RETURNS [BOOL] ~ INLINE {
            RETURN [server.address = Arpa.nullAddress] };

        GetNullServer: ENTRY PROC [lock: Lock _ nullServerLock] RETURNS [server: Server] ~ {
            server _ NEW[ServerObject _ [nullServerList, Arpa.nullAddress, ArpaUDP.nullPort, initialServerTTL, FALSE]];
            nullServerList _ server;
            };

        SweepNullServers: ENTRY PROC [seconds: CARD, lock: Lock _ nullServerLock] ~ {
            prev, server: Server;
            prev _ NIL; server _ nullServerList;
            WHILE server # NIL DO
                IF server.ttl > seconds
                    THEN {
                        server.ttl _ server.ttl - seconds;
                        prev _ server;
                        }
                    ELSE {
                        server.ttl _ 0;
                        IF prev = NIL THEN nullServerList _ server.next ELSE prev.next _ server.next;
                        };
                server _ server.next;
                ENDLOOP;
            };

        GetServerForDomain: PROC [domain: ROPE] RETURNS [server: Server] ~ {
            server _ NARROW[SymTab.Fetch[serverTab, domain].val];
            DO
                SELECT TRUE FROM
                    (server = NIL) => {
                        address: Arpa.Address;
                        port: ArpaUDP.Port;
                        [address, port] _ BroadcastForServer[domain];
                        IF address # Arpa.nullAddress
                            THEN server _ GetServerByAddressAndPort[address, port]
                            ELSE server _ GetNullServer[];
                        [] _ SymTab.Store[serverTab, domain, server];
                        EXIT;
                        };
                    (server.ttl = 0) => {
                        IF NOT ServerResponding[server]
                        THEN { server _ NIL; LOOP };
                        EXIT;
                        };
                    ENDCASE => {
                        IF (server.down) AND (server.address # Arpa.nullAddress)
                        THEN { server _ NIL; LOOP };
                        EXIT;
                        };
                ENDLOOP;
            };

        BroadcastForServer: PROC [domain: ROPE]
        RETURNS [address: Arpa.Address, port: ArpaUDP.Port] ~ {
            <<Not yet implemented!>>
            ENABLE Error => { address _ Arpa.nullAddress; port _ ArpaUDP.nullPort; CONTINUE };
            server: Server ~ GetServerByAddress[[13,1,100,208], domain]; -- Palain
            address _ server.address; port _ server.port;
            };

        GetServerByAddress: PROC [address: Arpa.Address, domain: ROPE]
        RETURNS [server: Server] ~ {
            h: SunRPC.Handle _ SunRPC.Create[remoteAddress~address, remotePort~Basics.HFromCard16[SunPMap.udpPort]];
            c: SunRPCAuth.Conversation _ SunRPCAuth.Initiate[];
            errorCode: ATOM _ NIL;
            port: CARD;
            {
                ENABLE {
                    SunRPC.Error => { errorCode _ code; CONTINUE };
                    };
                port _ SunPMapClient.GetPort[h, c, SunYP.program, SunYP.programVersion, SunPMap.ipProtocolUDP];
                IF (errorCode = NIL) THEN {
                    IF port = 0
                        THEN {
                            errorCode _ $noYP;
                            }
                        ELSE {
                            h _ SunRPC.SetRemote[h, address, Basics.HFromCard16[port]];
                            IF NOT SunYPClient.Domain[h, c, domain] THEN errorCode _ $domainNotFound;
                            };
                    };
                };
            SunRPC.Destroy[h];
            SunRPCAuth.Terminate[c];
            IF errorCode = NIL
                THEN {
                    server _ GetServerByAddressAndPort[address, Basics.HFromCard16[port]];
                    server.down _ FALSE;
                    server.ttl _ initialServerTTL;
                    }
                ELSE {
                    ERROR Error[errorCode];
                    };
            };

        ServerResponding: PROC [server: Server] RETURNS [responding: BOOL _ TRUE] ~ {
            h: SunRPC.Handle;
            c: SunRPCAuth.Conversation;
            IF IsNullServer[server] THEN RETURN [FALSE];
            h _ SunRPC.Create[remoteAddress~server.address, remotePort~server.port];
            c _ SunRPCAuth.Initiate[];
            SunYPClient.Null[h, c
            ! SunRPC.Error => { responding _ FALSE; CONTINUE }];
            server.down _ NOT responding;
            server.ttl _ initialServerTTL;
            SunRPC.Destroy[h];
            SunRPCAuth.Terminate[c];
            };
    <<Default Domain>>
        <<ROPE assignment is atomic, so ... manipulate defaultDomainName without ML.>>

        GetDefaultDomain: PUBLIC PROC RETURNS [domainName: ROPE] ~ {
            RETURN [defaultDomainName];
            };

        SetDefaultDomain: PUBLIC PROC [domainName: ROPE] ~ {
            defaultDomainName _ domainName;
            };
    <<Handles>>
        Handle: TYPE ~ REF Object;
        Object: PUBLIC TYPE ~ RECORD [
            domain: ROPE,
            server: Server,
            rpcHandle: SunRPC.Handle,
            conversation: SunRPCAuth.Conversation
            ];

        ObtainHandle: PUBLIC PROC [domainName: ROPE, conversation: SunRPCAuth.Conversation, serverAddress: Arpa.Address] RETURNS [h: 
        Handle] ~ {
            server: Server;
            rpcHandle: SunRPC.Handle;
            IF domainName = NIL THEN domainName _ defaultDomainName;
            IF serverAddress = Arpa.nullAddress
                THEN {
                    server _ GetServerForDomain[domainName];
                    IF IsNullServer[server] THEN ERROR Error[$domainNotFound];
                    }
                ELSE {
                    server _ GetServerByAddress[serverAddress, domainName];
                    };
            IF conversation = NIL THEN conversation _ SunRPCAuth.Initiate[];
            rpcHandle _ SunRPC.Create[remoteAddress~server.address, remotePort~server.port];
            h _ NEW[Object _ [domain~domainName, server~server, rpcHandle~rpcHandle, conversation~conversation]];
            };

        RefreshHandle: PUBLIC PROC [h: Handle, conversation: SunRPCAuth.Conversation, serverAddress: Arpa.Address] ~ {
            server: Server;
            IF serverAddress = Arpa.nullAddress
                THEN {
                    server _ GetServerForDomain[h.domain];
                    IF IsNullServer[server] THEN ERROR Error[$domainNotFound];
                    }
                ELSE {
                    server _ GetServerByAddress[serverAddress, h.domain];
                    };
            SunRPCAuth.Terminate[h.conversation];
            h.conversation _ IF conversation # NIL THEN conversation ELSE SunRPCAuth.Initiate[];
            IF server # h.server THEN {
                h.server _ server;
                h.rpcHandle _ SunRPC.SetRemote[h.rpcHandle, server.address, server.port];
                };
            };

        ReleaseHandle: PUBLIC PROC [h: Handle] ~ {
            IF h.rpcHandle # NIL THEN { SunRPC.Destroy[h.rpcHandle]; h.rpcHandle _ NIL };
            h.server _ NIL;
            IF h.conversation # NIL THEN { SunRPCAuth.Terminate[h.conversation]; h.conversation _ NIL };
            };
    <<Match Response Cache>>
        CachedValue: TYPE ~ REF CachedValueObject;
        CachedValueObject: TYPE ~ RECORD [
            next, prev: CachedValue,
            ttl: CARDINAL _ initialCachedValueTTL,
            busy: CARDINAL _ 0,
            value: REF TEXT,
            key: ROPE,
            table: SymTab.Ref
            ];

        cachedValueLock: Lock ~ NEW[LockObject];
        cachedValueHead, cachedValueTail: CachedValue;
        numCachedValues: CARD _ 0;
        cachedValueAvailable: CONDITION;

        tabByDomain: SymTab.Ref ~ SymTab.Create[];

        RemoveCachedValueFromTable: PROC [cV: CachedValue] ~ {
            value: SymTab.Val ~ cV;
            DeleteValue: SymTab.UpdateAction -- [found, val] RETURNS [op, new] -- ~ {
                IF found AND val = value
                    THEN RETURN [delete, NIL]
                    ELSE RETURN [none, NIL];
                };
            IF (cV.table = NIL) OR (cV.key = NIL) THEN ERROR;
            SymTab.Update[cV.table, cV.key, DeleteValue];
            };

        RemoveCachedValueFromList: INTERNAL PROC [cV: CachedValue] ~ {
            IF cV = cachedValueTail
                THEN cachedValueTail _ cV.prev
                ELSE cV.next.prev _ cV.prev;
            IF cV = cachedValueHead
                THEN cachedValueHead _ cV.next
                ELSE cV.prev.next _ cV.next;
            };

        LookupCachedValue: ENTRY PROC [domainName, mapName, key: ROPE, lock: Lock _ cachedValueLock] RETURNS [cV: CachedValue] ~ {
            tabByMap, tabByKey: SymTab.Ref;
            GetTabByMap: SymTab.UpdateAction -- [found, val] RETURNS [op, new] -- ~ {
                IF found
                    THEN { tabByMap _ NARROW[val]; RETURN [none, NIL] }
                    ELSE { tabByMap _ SymTab.Create[]; RETURN [store, tabByMap] };
                };
            GetTabByKey: SymTab.UpdateAction -- [found, val] RETURNS [op, new] -- ~ {
                IF found
                    THEN { tabByKey _ NARROW[val]; RETURN [none, NIL] }
                    ELSE { tabByKey _ SymTab.Create[]; RETURN [store, tabByKey] };
                };
            SymTab.Update[tabByDomain, domainName, GetTabByMap];
            SymTab.Update[tabByMap, mapName, GetTabByKey];
            cV _ NARROW[SymTab.Fetch[tabByKey, key].val];
            SELECT TRUE FROM
                (cV = NIL) => {
                    DO
                        SELECT TRUE FROM
                            (numCachedValues < maxCachedValues) => {
                                cV _ NEW[CachedValueObject];
                                numCachedValues _ numCachedValues + 1;
                                EXIT;
                                };
                            (cachedValueHead = NIL) => {
                                WAIT cachedValueAvailable;
                                LOOP;
                                };
                            ENDCASE => {
                                cV _ cachedValueTail;
                                RemoveCachedValueFromTable[cV];
                                RemoveCachedValueFromList[cV];
                                EXIT;
                                };
                        ENDLOOP;
                        cV.ttl _ initialCachedValueTTL;
                        cV.key _ key;
                        cV.value _ NIL;
                        cV.table _ tabByKey;
                    };
                (cV.busy = 0) => {
                    RemoveCachedValueFromList[cV];
                    };
                ENDCASE;
        cV.busy _ cV.busy + 1;
            };

        CacheValue: ENTRY PROC [cV: CachedValue, newValue: REF TEXT _ NIL, lock: Lock _ cachedValueLock] ~ {
            IF newValue # NIL THEN {
                IF cV.busy # 1 THEN ERROR;
                cV.value _ newValue;
                [] _ SymTab.Store[cV.table, cV.key, cV];
                };
            IF (cV.busy _ cV.busy - 1) = 0 THEN {
                IF cachedValueHead = NIL
                    THEN {
                        cV.next _ cV.prev _ NIL;
                        cachedValueHead _ cachedValueTail _ cV;
                        NOTIFY cachedValueAvailable;
                        }
                    ELSE {
                        cV.next _ cachedValueHead;
                        cV.prev _ NIL;
                        cachedValueHead.prev _ cV;
                        cachedValueHead _ cV;
                        };
                };
            };

        FreeCachedValue: INTERNAL PROC [cV: CachedValue, lock: Lock] ~ {
            cV.key _ NIL;
            cV.value _ NIL;
            cV.table _ NIL;
            cV.next _ cV.prev _ NIL;
            numCachedValues _ numCachedValues - 1;
            NOTIFY cachedValueAvailable;
            };

        ReleaseCacheEntry: ENTRY PROC [cV: CachedValue, lock: Lock _ cachedValueLock] ~ {
            IF cV.busy # 1 THEN ERROR;
            FreeCachedValue[cV, lock];
            };

        SweepCachedValues: ENTRY PROC [seconds: CARD, lock: Lock _ cachedValueLock] ~ {
            p, next: CachedValue;
            FOR p _ cachedValueHead, next WHILE p # NIL DO
                next _ p.next;
                IF p.ttl > seconds
                    THEN {
                        p.ttl _ p.ttl - seconds;
                        }
                    ELSE {
                        IF p.busy # 0 THEN ERROR;
                        RemoveCachedValueFromTable[p];
                        RemoveCachedValueFromList[p];
                        FreeCachedValue[p, lock];
                        };
                ENDLOOP;
            };
    <<Public Procedures>>
        MapErrorCode: PROC [code: ATOM, h: Handle] RETURNS [mappedCode: ATOM] ~ {
        h.server.down _ TRUE;
        h.server.ttl _ initialServerTTL;
            mappedCode _ code;
            };

        MapErrorStatus: PROC [status: SunYP.Status, h: Handle] RETURNS [mappedCode: ATOM] ~ {
            h.server.down _ FALSE;
            h.server.ttl _ initialServerTTL;
            mappedCode _ (SELECT status FROM
                true => NIL,
                nomore => $noMoreEntries,
                nomap => $mapNotFound,
                nodomain => $domainNotFound,
                nokey => $keyNotFound,
                ENDCASE => $protocol);
            };

        Match: PUBLIC PROC [h: Handle, map: ROPE, key: ROPE] RETURNS [val: REF TEXT] ~ {
            cV: CachedValue;
            errorCode: ATOM _ NIL;
            response: SunYP.ResponseVal;
            cV _ LookupCachedValue[h.domain, map, key];
            IF cV.value # NIL THEN {
                val _ cV.value;
                CacheValue[cV];
                RETURN;
                };
            {
                ENABLE {
                    SunRPC.Error => { errorCode _ MapErrorCode[code, h]; CONTINUE };
                    };
                response _ SunYPClient.Match[h.rpcHandle, h.conversation, [domain~h.domain, map~map, key~Rope.ToRefText[key]]];
                errorCode _ MapErrorStatus[response.status, h];
                };
            IF errorCode = NIL
                THEN {
                    val _ response.val;
                    CacheValue[cV, val];
                    RETURN;
                    }
                ELSE {
                    ReleaseCacheEntry[cV];
                    ERROR Error[errorCode];
                    };
            };

        First: PUBLIC PROC [h: Handle, map: ROPE] RETURNS [key: ROPE, val: REF TEXT] ~ {
            response: SunYP.ResponseKeyVal;
            errorCode: ATOM _ NIL;
            {
                ENABLE {
                    SunRPC.Error => { errorCode _ MapErrorCode[code, h]; CONTINUE };
                    };
                response _ SunYPClient.First[h.rpcHandle, h.conversation, [domain~h.domain, map~map]];
                errorCode _ MapErrorStatus[response.status, h];
                };
            IF errorCode # NIL THEN ERROR Error[errorCode];
            RETURN [Rope.FromRefText[response.key], response.val];
            };

        Next: PUBLIC PROC [h: Handle, map: ROPE, keyBefore: ROPE]
        RETURNS [key: ROPE, val: REF TEXT] ~ {
            response: SunYP.ResponseKeyVal;
            errorCode: ATOM _ NIL;
            {
                ENABLE {
                    SunRPC.Error => { errorCode _ MapErrorCode[code, h]; CONTINUE };
                    };
                response _ SunYPClient.Next[h.rpcHandle, h.conversation, [domain~h.domain, map~map, key~Rope.ToRefText[keyBefore]]];
                errorCode _ MapErrorStatus[response.status, h];
                };
            IF errorCode # NIL THEN ERROR Error[errorCode];
            RETURN [Rope.FromRefText[response.key], response.val];
            };

        MapList: PUBLIC PROC [h: Handle, eachMap: SunYP.EachMapNameProc] ~ {
            status: SunYP.Status;
            errorCode: ATOM _ NIL;
            {
                ENABLE {
                    SunRPC.Error => { errorCode _ MapErrorCode[code, h]; CONTINUE };
                    };
                status _ SunYPClient.Maplist[h.rpcHandle, h.conversation, h.domain, eachMap];
                errorCode _ MapErrorStatus[status, h];
                };
            IF errorCode # NIL THEN ERROR Error[errorCode];
            };
    <<Utilities>>
        ExpandTextSeq: PROC [s: SunYPAgent.TextSeq] RETURNS [new: SunYPAgent.TextSeq] ~ {
            new _ NEW[SunYPAgent.TextSeqObject[2*s.maxLength]];
            FOR i: CARDINAL IN [0 .. s.length) DO
                new.refText[i] _ s.refText[i];
                ENDLOOP;
            };

        IsWhiteSpace: PROC [c: CHAR] RETURNS [isWhite: BOOL] ~ {
            OPEN Ascii;
            isWhite _ (SELECT c FROM
                TAB, LF, FF, CR, SP => TRUE,
                ENDCASE => FALSE);
            };

        TokenizeUsingSeparator: PUBLIC PROC [in: REF READONLY TEXT, sepChar: CHAR, trimLeadingSpace, trimTrailingSpace: BOOL] RETURNS [out: 
        SunYPAgent.TextSeq]
            ~ {
            i, iTo: CARDINAL;
            scratch: REF TEXT _ RefText.ObtainScratch[in.length];
            out _ NEW[SunYPAgent.TextSeqObject[10]];
            out.length _ 0;
            i _ 0;
            DO
                IF i >= in.length THEN EXIT;
                IF trimLeadingSpace AND IsWhiteSpace[in[i]] THEN { i _ i + 1; LOOP };
                iTo _ 0;
                DO
                    IF (i >= in.length) OR (in[i] = sepChar) THEN EXIT;
                    scratch[iTo] _ in[i];
                    i _ i + 1;
                    iTo _ iTo + 1;
                    ENDLOOP;
                IF trimTrailingSpace THEN
                    WHILE (iTo > 0) AND IsWhiteSpace[scratch[iTo-1]] DO iTo _ iTo - 1 ENDLOOP;
                scratch.length _ iTo;
                IF out.length >= out.maxLength THEN out _ ExpandTextSeq[out];
                out.refText[out.length] _ RefText.Append[to~RefText.New[scratch.length], from~scratch];
                out.length _ out.length + 1;
                i _ i + 1;
                ENDLOOP;
            RefText.ReleaseScratch[scratch];
            };

        Tokenize: PUBLIC PROC [in: REF READONLY TEXT]
        RETURNS [out: SunYPAgent.TextSeq]
            ~ {
            i, iTo: CARDINAL;
            scratch: REF TEXT _ RefText.ObtainScratch[in.length];
            out _ NEW[SunYPAgent.TextSeqObject[8]];
            out.length _ 0;
            i _ 0;
            DO
                IF i >= in.length THEN EXIT;
                iTo _ 0;
                DO
                    IF i >= in.length THEN EXIT;
                    IF IsWhiteSpace[in[i]] THEN EXIT;
                    scratch[iTo] _ in[i];
                    i _ i + 1;
                    iTo _ iTo + 1;
                    ENDLOOP;
                scratch.length _ iTo;
                IF out.length >= out.maxLength THEN out _ ExpandTextSeq[out];
                out.refText[out.length] _ RefText.Append[to~RefText.New[scratch.length], from~scratch];
                out.length _ out.length + 1;
                i _ i + 1;
                WHILE (i < in.length) AND (IsWhiteSpace[in[i]]) DO i _ i + 1 ENDLOOP;
                ENDLOOP;
            RefText.ReleaseScratch[scratch];
            };

    <<Daemon>>
        lastSweepTime: BasicTime.GMT _ BasicTime.earliestGMT;

        Daemon: PROC ~ {
            DO
                thisSweepTime: BasicTime.GMT ~ BasicTime.Now[];
                secondsSinceLastSweep: INT ~ BasicTime.Period[from~lastSweepTime, to~thisSweepTime];
                secs: CARD;
                IF secondsSinceLastSweep < 0 THEN ERROR;
                secs _ secondsSinceLastSweep;
                SweepCachedValues[secs];
                SweepServers[secs];
                SweepNullServers[secs];
                Process.PauseMsec[msecBetweenSweeps];
                ENDLOOP;
            };

        TRUSTED { Process.Detach[ FORK Daemon[] ] };

        }...