
    <<RemoteFileImpl.mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Demers, November 9, 1987 10:37:44 am PST>>

    DIRECTORY
        Atom USING [GetPName],
        BasicTime USING [earliestGMT, GMT, Now, Period],
        Booting USING [RegisterProcs, RollbackProc],
        Process USING [Abort, Detach, EnableAborts, MsecToTicks, SetTimeout],
        RemoteFile USING [GetProcsProc, GetServerProc, ServerHandle, ServerObject, ServerProcs, ServerProcsObject, SweepProc, ValidateProc],
        Rope USING [Concat, EqualSubstrs, Length, ROPE, Substr],
        SymTab USING [Create, Delete, EachPairAction, Erase, Fetch, Pairs, Ref, Store],
        UserCredentials USING [CredentialsChangeProc, RegisterForChange]
        ;

    RemoteFileImpl: CEDAR MONITOR
        IMPORTS Atom, BasicTime, Booting, Process, Rope, SymTab, UserCredentials
        EXPORTS RemoteFile
        ~{
    <<Types>>
        GetServerProc: TYPE ~ RemoteFile.GetServerProc;
        GMT: TYPE ~ BasicTime.GMT;
        ROPE: TYPE ~ Rope.ROPE;
        ServerHandle: TYPE ~ RemoteFile.ServerHandle;
    <<Parameters>>
        secsBetweenSweeps: INT _ 6;
        downServerTTL: CARD _ 60; -- seconds
        waitForServerTimeout: INT _ 13; -- seconds
    <<Registration (Exported to RemoteFile)>>
        Registration: TYPE ~ REF RegistrationObject;
        RegistrationObject: TYPE ~ RECORD [
            next: Registration,
            flavor: ATOM,
            nameSuffix: ROPE, -- constructed from flavor
            getServer: GetServerProc
            ];

        registrations: Registration _ NIL;

        Register: PUBLIC ENTRY PROC [flavor: ATOM, getServer: GetServerProc] ~ {
            <<no ENABLE UNWIND>>
            p, prev: Registration;
            nameSuffix: ROPE _ Rope.Concat["-", Atom.GetPName[flavor]];
            FOR p _ registrations, p.next WHILE p # NIL DO
                IF p.flavor = flavor THEN {
                    IF prev = NIL THEN registrations _ p.next ELSE prev.next _ p.next;
                    EXIT;
                    };
                prev _ p;
                ENDLOOP;
            IF getServer # NIL
                THEN registrations _ NEW[RegistrationObject _ [registrations, flavor, nameSuffix, getServer]];
            };
    <<Server Handle Cache>>
        serverTab: SymTab.Ref _ SymTab.Create[case~FALSE];

        lastSweepTime: BasicTime.GMT _ BasicTime.earliestGMT;
        readyToSweep: CONDITION;

        Daemon: PROC ~ {
            seconds: INT;
            CallSweep: SymTab.EachPairAction -- [key, val] RETURNS [quit] -- ~ {
                h: ServerHandle ~ NARROW[val];
                h.procs.sweep[h, CARD[seconds]];
                RETURN [FALSE];
                };
            WaitReadyToSweep: ENTRY PROC ~ INLINE {
                ENABLE UNWIND => NULL;
                DO
                    thisSweepTime: BasicTime.GMT ~ BasicTime.Now[];
                    seconds _ BasicTime.Period[from~lastSweepTime, to~thisSweepTime];
                    IF seconds >= secsBetweenSweeps THEN {
                        lastSweepTime _ thisSweepTime;
                        EXIT;
                        };
                    WAIT readyToSweep;
                    ENDLOOP;
                };

            TRUSTED {
                Process.EnableAborts[@readyToSweep];
                Process.SetTimeout[@readyToSweep, Process.MsecToTicks[INT[1000]*secsBetweenSweeps]];
                };
            DO
                WaitReadyToSweep[];
                [] _ SymTab.Pairs[serverTab, CallSweep];
                ENDLOOP;
            };

        Rollback: ENTRY Booting.RollbackProc ~ {
            ENABLE UNWIND => NULL;
            SymTab.Erase[serverTab];
            lastSweepTime _ BasicTime.Now[];
            };

        CredentialsChange: ENTRY UserCredentials.CredentialsChangeProc ~ {
            ENABLE UNWIND => NULL;
            SymTab.Erase[serverTab];
            lastSweepTime _ BasicTime.Now[];
            };
    <<Finding a server (exported to RemoteFile)>>
        GetServerResponse: TYPE ~ REF GetServerResponseObject;
        GetServerResponseObject: TYPE ~ RECORD [
            nRunning: CARDINAL _ 0,
            wakeup: CONDITION,
            handle: ServerHandle _ NIL,
            downMsg: ROPE _ NIL
            ];

        GetServer: PUBLIC PROC [server: ROPE] RETURNS [h: ServerHandle] ~ {
            <<Raises Error if server is down.>>
            obsolete: BOOL;
            downMsg: ROPE;
            kids: LIST OF PROCESS _ NIL;
            response: GetServerResponse;
            theRegistration: Registration;
            started: GMT;

            MakeChild: ENTRY PROC [r: Registration] RETURNS [p: PROCESS] ~ --INLINE-- {
                ENABLE UNWIND => NULL;
                p _ FORK DoGetServer[r, server, response];
                response.nRunning _ response.nRunning + 1;
                };

            WaitForResponse: ENTRY PROC ~ --INLINE-- {
                ENABLE UNWIND => NULL;
                <<set [h, downMsg] ...>>
                WHILE (response.nRunning > 0) AND (response.handle = NIL) AND (response.downMsg = NIL) DO
                    sinceStarted: INT ~ BasicTime.Period[from~started, to~BasicTime.Now[]];
                IF sinceStarted >= waitForServerTimeout THEN EXIT;
                    TRUSTED { Process.SetTimeout[@response.wakeup, Process.MsecToTicks[1000*(waitForServerTimeout-sinceStarted)+500]] };
                    WAIT response.wakeup;
                    ENDLOOP;
                h _ response.handle;
                downMsg _ response.downMsg;
                };

            h _ NARROW[SymTab.Fetch[serverTab, server].val];
            IF h # NIL THEN {
                [obsolete, downMsg] _ h.procs.validate[h];
                IF NOT obsolete THEN {
                    IF downMsg # NIL THEN ErrorDownServer[h, downMsg];
                    RETURN;
                    };
                };

            response _ NEW [GetServerResponseObject];
            FOR theRegistration _ registrations, theRegistration.next WHILE theRegistration # NIL DO
                suffixLen, pos: INT;
                suffixLen _ Rope.Length[theRegistration.nameSuffix];
                pos _ Rope.Length[server] - suffixLen;
                IF (pos >= 0) AND Rope.EqualSubstrs[server, pos, suffixLen, theRegistration.nameSuffix, 0, suffixLen, FALSE]
                    THEN { server _ Rope.Substr[server, 0, pos]; EXIT };
                ENDLOOP;
            IF theRegistration # NIL
                THEN {
                    DoGetServer[theRegistration, server, response];
                    h _ response.handle;
                    IF h # NIL THEN h.name _ Rope.Concat[h.name, theRegistration.nameSuffix];
                    downMsg _ response.downMsg;
                    }
                ELSE {
                    started _ BasicTime.Now[];
                    TRUSTED { Process.EnableAborts[@response.wakeup] };
                    FOR each: Registration _ registrations, each.next WHILE each # NIL DO
                    kids _ CONS [MakeChild[each], kids];
                    ENDLOOP;
                    WaitForResponse[];
                    FOR kid: LIST OF PROCESS _ kids, kid.rest WHILE kid # NIL DO
                        TRUSTED { Process.Abort[kid.first] };
                        TRUSTED { Process.Detach[kid.first] };
                        ENDLOOP;
                    };
            IF h = NIL THEN {
                IF downMsg = NIL
                    THEN {
                        downMsg _ "unknown server";
                        h _ MakeDownServer[server, $serverNotKnown, downMsg];
                        }
                    ELSE {
                        h _ MakeDownServer[server, $serverNotAvailable, downMsg];
                        };
                };
            [] _ SymTab.Store[serverTab, h.name, h];
            IF downMsg # NIL THEN ErrorDownServer[h, downMsg];
            };

        DoGetServer: PROC [r: Registration, server: ROPE, response: GetServerResponse] ~ {
            h: ServerHandle _ NIL;
            downMsg: ROPE _ NIL;
            NotifyDone: ENTRY PROC ~ --INLINE-- {
                ENABLE UNWIND => NULL;
                response.nRunning _ response.nRunning - 1;
                IF (response.handle # NIL) OR (response.downMsg # NIL) THEN RETURN;
                SELECT TRUE FROM
                    (h # NIL) OR (downMsg # NIL) => -- found it -- {
                        response.handle _ h;
                        response.downMsg _ downMsg;
                        NOTIFY response.wakeup;
                        };
                    (response.nRunning = 0) => -- nobody will find it -- {
                        NOTIFY response.wakeup;
                        };
                    ENDCASE;
                };
            [h, downMsg] _ r.getServer[server ! Error -- can't happen--, ABORTED => CONTINUE];
            NotifyDone[];
            };

    <<Error>>
        Error: PUBLIC ERROR [code: ATOM, msg: ROPE] ~ CODE;

        ErrorDownServer: PROC [h: ServerHandle, downMsg: ROPE _ NIL] ~ {
            code: ATOM;
            WITH h.data SELECT FROM
                d: DownServerData => {
                    code _ d.errorCode;
                    IF downMsg = NIL THEN downMsg _ d.downMsg;
                    };
                ENDCASE => {
                    code _ $serverNotAvailable;
                    };
            ERROR Error[code, downMsg];
            };
    <<Controlling the flavor of a cached server (Exported to RemoteFile)>>
        SetCachedServer: PUBLIC PROC [server: ROPE, flavor: ATOM] ~ {
            r: Registration;
            h: ServerHandle;
            downMsg: ROPE;
            FOR r _ registrations, r.next WHILE (r # NIL) AND (r.flavor # flavor) DO NULL ENDLOOP;
            IF r = NIL THEN RETURN;
            [h, downMsg] _ r.getServer[server];
            IF h = NIL THEN {
                code: ATOM;
                IF downMsg = NIL
                    THEN { downMsg _ "unknown server"; code _ $serverNotKnown }
                    ELSE { code _ $serverNotAvailable };
                h _ MakeDownServer[server, code, downMsg];
                };
            [] _ SymTab.Store[serverTab, server, h];
            };

        ClearCachedServer: PUBLIC PROC [server: ROPE] ~ {
            [] _ SymTab.Delete[serverTab, server];
            };
    <<Down server implementation>>
        DownServerData: TYPE ~ REF DownServerDataObject;
        DownServerDataObject: TYPE ~ RECORD [
            ttl: CARD,
            errorCode: ATOM,
            downMsg: ROPE
            ];

        downServerProcs: RemoteFile.ServerProcs _
            NEW[RemoteFile.ServerProcsObject _ [
                sweep~SweepDownServer,
                validate~ValidateDownServer,
                getProcs~GetProcsDownServer
                ]
            ];

        MakeDownServer: PROC [name: ROPE, errorCode: ATOM, downMsg: ROPE] RETURNS [h: ServerHandle] ~ {
            d: DownServerData _ NEW[DownServerDataObject _ [downServerTTL, errorCode,  downMsg]];
            h _ NEW[RemoteFile.ServerObject _ [$DOWN, name, downServerProcs, d]];
            };

        SweepDownServer: RemoteFile.SweepProc -- [h: ServerHandle, seconds: CARD] -- ~ {
            d: DownServerData _ NARROW[h.data];
            IF d.ttl > seconds THEN d.ttl _ d.ttl - seconds ELSE d.ttl _ 0;
            };

        ValidateDownServer: RemoteFile.ValidateProc -- [h: ServerHandle] RETURNS [obsolete: BOOL, down: BOOL] -- ~ {
            d: DownServerData _ NARROW[h.data];
            RETURN[(d.ttl = 0), d.downMsg];
            };

        GetProcsDownServer: RemoteFile.GetProcsProc -- [h: ServerHandle, view: ATOM] RETURNS [procs: REF] -- ~ {
            ErrorDownServer[h];
            RETURN [NIL];
            };

    <<Initialization>>
        Booting.RegisterProcs[r~Rollback];
        UserCredentials.RegisterForChange[proc~CredentialsChange];
        TRUSTED { Process.Detach[ FORK Daemon[] ] };

        }...