
    <<GVNamesImpl.mesa - communication with registration server>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Andrew Birrell  August 25, 1983 5:09 pm>>
        <<Levin, September 22, 1983 11:57 am>>
        <<Taft, November 28, 1983 5:22 pm>>
        <<Hal Murray, May 12, 1986 8:39:19 pm PDT>>

    DIRECTORY
        GVBasics USING [Connect, GVString, maxGVStringLength, maxRNameLength, oldestTime, Password, Remark, RName, Timestamp],
        GVLocate USING [FindRegServer, FoundServerInfo],
        GVNames USING [AuthenticateInfo, ConnectInfo, ExpandInfo, GetEntryInfo, GetEntryList, ListType, MembershipGrade, MemberInfo, 
        MembershipLevel, Membership, NameType, Outcome, RemarkInfo, ReporterProc, RListHandle, RSOperation, SetServerInfo, 
        StampInfo],
        GVProtocol USING [Close, CreateStream, Enquire, Failed, GetSocket, Handle, ReceiveBoolean, ReceiveConnect, ReceiveCount, 
        ReceiveFunnyString, ReceivePassword, ReceiveRC, ReceiveRemark, ReceiveRList, ReceiveRName, ReceiveTimestamp, ReturnCode, 
        RNameType, SendByte, SendNow, SendPassword, SendRName, SendRSOperation],
        PrincOps USING [BytePC, FrameHandle, GlobalFrameHandle],
        PrincOpsUtils USING [GetReturnFrame],
        Pup USING [Address],
        PupName USING [Code, Error, HisName, NameLookup],
        Rope USING [Equal, Find, Length, ROPE, Substr];

    GVNamesImpl: CEDAR MONITOR
        IMPORTS GVLocate, GVProtocol, PrincOpsUtils, PupName, Rope
        EXPORTS GVNames = {

    Expand: PUBLIC PROC[
        name: GVBasics.RName,
        oldStamp: GVBasics.Timestamp _ GVBasics.oldestTime,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS[ GVNames.ExpandInfo ] = {
        info: GVNames.NameType;
        list: GVNames.RListHandle;
        count: INT;
        stamp: GVBasics.Timestamp;
        [info, stamp, list, count] _ GetCompound[name, oldStamp, Expand, reporter];
        SELECT info FROM
            noChange => RETURN[[noChange[]]];
            group => RETURN[[group[list, stamp, count]]];
            individual => RETURN[[individual[list, stamp, count]]];
            notFound => RETURN[[notFound[]]];
            protocolError => RETURN[[protocolError[]]];
            wrongServer => RETURN[[wrongServer[]]];
            allDown => RETURN[[allDown[]]];
        ENDCASE => RETURN[[protocolError[]]];
        };

    GetList: PUBLIC PROC [
        name: GVBasics.RName,
        oldStamp: GVBasics.Timestamp,
        list: GVNames.ListType,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS [GVNames.MemberInfo] = {
        info: GVNames.NameType;
        members: GVNames.RListHandle;
        count: INT;
        stamp: GVBasics.Timestamp;
        [info, stamp, members, count] _ GetCompound[name, oldStamp, SELECT list FROM
            members => ReadMembers, owners => ReadOwners, friends => ReadFriends,
            ENDCASE => ERROR,
            reporter];
        SELECT info FROM
            noChange => RETURN[[noChange[]]];
            group => RETURN[[group[members, stamp, count]]];
            individual => RETURN[[individual[]]];
            notFound => RETURN[[notFound[]]];
            protocolError => RETURN[[protocolError[]]];
            wrongServer => RETURN[[wrongServer[]]];
            allDown => RETURN[[allDown[]]];
        ENDCASE => RETURN[[protocolError[]]];
        };


    ReceiveRList: PROC[str: GVProtocol.Handle] RETURNS[list: GVNames.RListHandle, count: INT] = {
        tail: GVNames.RListHandle _ NIL;
        ReceiveRListWork: PROC[name: GVBasics.RName] = {
            new: GVNames.RListHandle = CONS[first: name, rest: NIL];
            IF tail = NIL THEN list _ new ELSE tail.rest _ new;
            tail _ new;
            count _ count+1;
            };
        list _ NIL;
        count _ 0;
        GVProtocol.ReceiveRList[str, ReceiveRListWork];
        };

    ReceiveStampList: PROC[str: GVProtocol.Handle] RETURNS[list: LIST OF GVBasics.Timestamp] = {
        words: CARDINAL _ GVProtocol.ReceiveCount[str];
        tail: LIST OF GVBasics.Timestamp _ NIL;
        list _ NIL;
        WHILE words > 0
        DO stamp: GVBasics.Timestamp = GVProtocol.ReceiveTimestamp[str];
            words _ words - SIZE[GVBasics.Timestamp];
            IF tail = NIL
            THEN { list _ CONS[stamp,NIL]; tail _ list }
            ELSE { tail.rest _ CONS[stamp,NIL]; tail _ tail.rest };
        ENDLOOP;
        };

    GetCompound: PROC [
        name: GVBasics.RName,
        stamp: GVBasics.Timestamp,
        op: GVNames.RSOperation,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS [
            info: GVNames.NameType,
            newStamp: GVBasics.Timestamp,
            list: GVNames.RListHandle,
            count: INT] = {
        GetCompoundWork: PROC[str: GVProtocol.Handle]
            RETURNS[rc: GVProtocol.ReturnCode] = {
            [rc, newStamp] _ GVProtocol.Enquire[str, op, name, stamp];
            };
        list _ NIL;
        count _ 0;
        info _ Enquire[name, GetCompoundWork, reporter];
        IF ( info=individual AND ( op=Expand OR op=ReadMailboxes)) OR info=group THEN
            [list, count] _ ReceiveRList[str ! GVProtocol.Failed => GOTO notQuite];
        ReleaseStream[];
        EXITS notQuite => { CloseStream[]; ReleaseStream[]; info _ allDown; }
        };

    GetEntry: PUBLIC PROC[name: GVBasics.RName, reporter: GVNames.ReporterProc _ NIL] RETURNS[ rc: GVNames.NameType[group..allDown], 
    info: REF GVNames.GetEntryInfo] = {
        [rc, info] _ AuthenticatedGetEntry[name: name, reporter: reporter];
        };

    AuthenticatedGetEntry: PUBLIC PROC [user: GVBasics.RName _ NIL, password: GVBasics.Password _ [,,,], name: GVBasics.RName, 
    reporter: GVNames.ReporterProc _ NIL] RETURNS[ rc: GVNames.NameType[group..allDown], info: REF GVNames.GetEntryInfo] = {
        rcOK: BOOL _ FALSE;
        GetEntryWork: PROC[str: GVProtocol.Handle] RETURNS [rc: GVProtocol.ReturnCode] = {
            rc _ PresentCredentials[user, password];
            IF rc = [done, individual] THEN [rc, ] _ GVProtocol.Enquire[str, ReadEntry, name];
            rcOK _ rc.code = done; };
        info _ NEW[GVNames.GetEntryInfo _ [,,notFound[]]];
        rc _ Enquire[name, GetEntryWork, reporter];
        IF rcOK THEN {
            ENABLE GVProtocol.Failed => GOTO NotQuite;
            ReceiveList: PROC RETURNS [list: GVNames.GetEntryList] = {
                list.current _ ReceiveRList[str].list;
                list.currentStamps _ ReceiveStampList[str];
                list.deleted _ ReceiveRList[str].list;
                list.deletedStamps _ ReceiveStampList[str]; };
            type: GVProtocol.RNameType;
            stamp: GVBasics.Timestamp;
            [] _ GVProtocol.ReceiveCount[str]; -- number of components
            [] _ GVProtocol.ReceiveCount[str]; -- component length
            stamp _ GVProtocol.ReceiveTimestamp[str];
            type _ LOOPHOLE[GVProtocol.ReceiveCount[str]];
            info _ NEW[GVNames.GetEntryInfo _ SELECT type FROM
                group => [,,group[,,,]],
                individual => [,,individual[,,,,,]],
                notFound => [,,notFound[]],
                dead => [,,dead[]],
                ENDCASE => ERROR];
            info.name _ GVProtocol.ReceiveRName[str];
            info.stamp _ stamp;
            TRUSTED {
                WITH i: info SELECT FROM
                    group => {
                        [] _ GVProtocol.ReceiveCount[str]; -- component length
                        i.remarkStamp _ GVProtocol.ReceiveTimestamp[str];
                        i.remark _ GVProtocol.ReceiveFunnyString[str];
                        i.members _ ReceiveList[];
                        i.owners _ ReceiveList[];
                        i.friends _ ReceiveList[]; };
                    individual => {
                        [] _ GVProtocol.ReceiveCount[str]; -- component length
                        i.passwordStamp _ GVProtocol.ReceiveTimestamp[str];
                        i.password _ GVProtocol.ReceivePassword[str];
                        [] _ GVProtocol.ReceiveCount[str]; -- component length
                        i.connectStamp _ GVProtocol.ReceiveTimestamp[str];
                        i.connect _ GVProtocol.ReceiveFunnyString[str];
                        i.forward _ ReceiveList[];
                        i.sites _ ReceiveList[]; };
                ENDCASE => NULL; }; };
        ReleaseStream[];
        EXITS NotQuite => {
            CloseStream[];
            ReleaseStream[];
            info _ NEW[GVNames.GetEntryInfo _ [,,notFound[]]]; };
        };

    GetConnect: PUBLIC PROC [
        name: GVBasics.RName,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS [info: GVNames.ConnectInfo, connect: GVBasics.Connect _ NIL] = {
        ConnectWork: PROC [str: GVProtocol.Handle] RETURNS [rc: GVProtocol.ReturnCode] = {
            [rc,] _ GVProtocol.Enquire[str, ReadConnect, name]; };
        info _ Enquire[name, ConnectWork, reporter];
        IF info = individual THEN
            connect _ GVProtocol.ReceiveConnect[str ! GVProtocol.Failed => GOTO NotQuite];
        ReleaseStream[];
        SELECT info FROM
            IN GVNames.ConnectInfo => NULL;
            ENDCASE => info _ protocolError;
        EXITS NotQuite => { CloseStream[]; ReleaseStream[]; info _ allDown; };
        };

    GetRemark: PUBLIC PROC [
        name: GVBasics.RName,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS [info: GVNames.RemarkInfo, remark: GVBasics.Remark _ NIL] = {
        RemarkWork: PROC [str: GVProtocol.Handle] RETURNS [rc: GVProtocol.ReturnCode] = {
            [rc,] _ GVProtocol.Enquire[str, ReadRemark, name]; };
        info _ Enquire[name, RemarkWork, reporter];
        IF info = group THEN
            remark _ GVProtocol.ReceiveRemark[str ! GVProtocol.Failed => GOTO NotQuite ];
        ReleaseStream[];
        SELECT info FROM
            IN GVNames.RemarkInfo => NULL;
            ENDCASE => info _ protocolError;
        EXITS NotQuite => { CloseStream[]; ReleaseStream[]; info _ allDown; };
        };

    CheckStamp: PUBLIC PROC [
        name: GVBasics.RName,
        oldStamp: GVBasics.Timestamp _ GVBasics.oldestTime,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS [GVNames.StampInfo] = {
        info: GVNames.NameType;
        CheckStampWork: PROC[str: GVProtocol.Handle] RETURNS [rc: GVProtocol.ReturnCode] = {
            [rc,] _ GVProtocol.Enquire[str, CheckStamp, name, oldStamp]; };
        info _ Enquire[name, CheckStampWork, reporter];
        ReleaseStream[];
        SELECT info FROM
            IN GVNames.StampInfo => RETURN[info];
            ENDCASE => RETURN[protocolError];
        };

    AuthenticateKey: PUBLIC PROC[name: GVBasics.RName, key: GVBasics.Password, reporter: GVNames.ReporterProc _ NIL] 
    RETURNS[GVNames.AuthenticateInfo ] = {
        AuthWork: PROC[str: GVProtocol.Handle] RETURNS [rc: GVProtocol.ReturnCode] = {
            GVProtocol.SendRSOperation[str, Authenticate];
            GVProtocol.SendRName[str, name];
            GVProtocol.SendPassword[str: str, pw: key];
            GVProtocol.SendNow[str];
            rc _ GVProtocol.ReceiveRC[str];
            };
        info: GVNames.NameType = Enquire[name, AuthWork, reporter];
        ReleaseStream[];
        SELECT info FROM
            IN GVNames.AuthenticateInfo => RETURN[info];
            ENDCASE => RETURN[protocolError];
        };

    IsInList: PUBLIC PROC[name,
        member: GVBasics.RName,
        level: GVNames.MembershipLevel,
        grade: GVNames.MembershipGrade,
        acl: GVNames.ListType,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS [res: GVNames.Membership] = {
        IsInListWork: PROC[str: GVProtocol.Handle] RETURNS [rc: GVProtocol.ReturnCode] = {
            GVProtocol.SendRSOperation[str, IsInList];
            GVProtocol.SendRName[str, name];
            GVProtocol.SendRName[str, member];
            GVProtocol.SendByte[str, LOOPHOLE[grade]];
            GVProtocol.SendByte[str, LOOPHOLE[acl]];
            GVProtocol.SendByte[str, LOOPHOLE[level]];
            GVProtocol.SendNow[str];
            rc _ GVProtocol.ReceiveRC[str]; };
        info: GVNames.NameType = Enquire[name, IsInListWork, reporter];
        SELECT info FROM
            group => {
                member: BOOL _ GVProtocol.ReceiveBoolean[str ! GVProtocol.Failed => GOTO NotQuite];
                res _ IF member THEN yes ELSE no; };
            individual, notFound => res _ notGroup;
            ENDCASE => res _ allDown; -- includes various protocol errors
        ReleaseStream[];
        EXITS NotQuite => { CloseStream[]; ReleaseStream[]; res _ allDown; }
        };

    Update: PUBLIC PROC[
        user: GVBasics.RName,
        password: GVBasics.Password,
        op: GVNames.RSOperation,
        target: GVBasics.RName,
        value: GVBasics.GVString _ NIL,
        newPwd: GVBasics.Password _ NULL,
        list: GVNames.RListHandle _ NIL,
        reporter: GVNames.ReporterProc _ NIL]
        RETURNS [info: GVNames.Outcome] = {
        UpdateWork: PROC [str: GVProtocol.Handle] RETURNS [rc: GVProtocol.ReturnCode] = {
            rc _ PresentCredentials[user, password];
            IF rc = [done, individual] THEN {
                GVProtocol.SendRSOperation[str, op];
                GVProtocol.SendRName[str, target];
                SELECT op FROM
                    CreateGroup, DeleteIndividual, DeleteGroup, AddSelf, DeleteSelf =>
                        NULL;
                    ChangePassword, CreateIndividual =>
                        GVProtocol.SendPassword[str, newPwd];
                ENDCASE => GVProtocol.SendRName[str, value];
                GVProtocol.SendNow[str];
                rc _ GVProtocol.ReceiveRC[str];
                <<Yuckko.... Enquire is trying to be too helpful>>
                IF op = NewName AND rc.code = BadRName THEN rc.code _ BadProtocol; }; };
        IF user.Length[] > GVBasics.maxRNameLength THEN RETURN[badPwd];
        IF value.Length[] > GVBasics.maxGVStringLength THEN
            value _ Rope.Substr[value, 0, GVBasics.maxGVStringLength];
        <<target.Length[] is checked inside Enquire>>
        info _ Enquire[target, UpdateWork, reporter];
        ReleaseStream[];
        };

    authUser: GVBasics.RName _ NIL; -- authenticated credentials for Grapevine access
    authPassword: GVBasics.Password;
    PresentCredentials: PROC [user: GVBasics.RName, password: GVBasics.Password]
        RETURNS [rc: GVProtocol.ReturnCode] = {
        IF user=NIL OR (Rope.Equal[user, authUser, FALSE] AND password=authPassword) THEN
            rc _ [done, individual]
        ELSE {
            GVProtocol.SendRSOperation[str, IdentifyCaller];
            GVProtocol.SendRName[str, user];
            GVProtocol.SendPassword[str, password];
            GVProtocol.SendNow[str];
            rc _ GVProtocol.ReceiveRC[str];
            SELECT rc FROM
                [done, individual] => {authUser _ user; authPassword _ password};
                [BadRName, group] => rc _ [BadRName,notFound];
                ENDCASE; };
        };

    <<There is a cache of one stream and one address.>>
    <<Access to this is under mutual exclusion, enforced by calls>>
    <<on ClaimStream and ReleaseStream>>

    released: CONDITION;
    free: BOOLEAN _ TRUE;
    str: GVProtocol.Handle _ NIL; -- cached R-Server stream
    cacheAddr: Pup.Address; -- address of cached stream
    addrHint: BOOLEAN _ FALSE; -- whether to use cached address as a hint

    <<Bug hunting. There seems to be a missing ReleaseStream.>>
    depth: CARDINAL = 10;
    frames: ARRAY [0..depth) OF PrincOps.GlobalFrameHandle;
    pcs: ARRAY [0..depth) OF PrincOps.BytePC;

    ClaimStream: ENTRY PROC = {
        UNTIL free DO WAIT released ENDLOOP;
        free _ FALSE;
        TRUSTED {
            frame: PrincOps.FrameHandle _ PrincOpsUtils.GetReturnFrame[];
            frames _ ALL[NIL];
            FOR i: CARDINAL IN [0..depth) DO
                frames[i] _ frame.accesslink;
                pcs[i] _ frame.pc;
                IF frame.returnlink.frame = NIL THEN EXIT;
                IF frame.returnlink.proc THEN EXIT;
                IF frame.returnlink.indirect THEN EXIT;
                frame _ frame.returnlink.frame;
                ENDLOOP;
            };
        };

    ReleaseStream: ENTRY PROC = {
        free _ TRUE;
        NOTIFY released;
        };

    <<"SetServer" allows a client (typically Maintain) to provide a server name as a hint.>>

    SetServer: PUBLIC PROC [name: Rope.ROPE] RETURNS [GVNames.SetServerInfo ] = {
        pupName: Rope.ROPE;
        addr: Pup.Address;
        ec: PupName.Code;
        trouble: BOOL _ FALSE;
        IF Rope.Find[name, "."] >= 0 THEN {
            info: GVNames.ConnectInfo;
            [info, pupName] _ GetConnect[name];
            SELECT info FROM
                individual => NULL;
                allDown => RETURN[allDown];
            ENDCASE => RETURN[badName]; }
        ELSE pupName _ name;
        addr _ PupName.NameLookup[pupName, GVProtocol.GetSocket[RSEnquiry] !
            PupName.Error => { ec _ code; trouble _ TRUE; CONTINUE; } ];
        IF trouble THEN SELECT ec FROM
            noRoute => RETURN[noRoute];
            noResponse => RETURN[allDown];
            errorFromServer => RETURN[badName];
            ENDCASE => ERROR;
        ClaimStream[];
        cacheAddr _ addr;
        addrHint _ TRUE;
        ReleaseStream[];
        RETURN[ok];
        };

    Enquire: PROC [name: GVBasics.RName,
        work: PROC [GVProtocol.Handle] RETURNS [GVProtocol.ReturnCode],
        reporter: GVNames.ReporterProc _ NIL ]
        RETURNS [info: GVNames.Outcome] = {
        <<Slightly subtle optimization: If we don't have a stream, or the stream we have times out, we'll need to get one to an R-Server 
        for GV. Getting one early might save us from having to call FindRegServer later.>>
        Create: PROC = {
            IF reporter # NIL THEN reporter[PupName.HisName[cacheAddr]];
            str _ GVProtocol.CreateStream[cacheAddr, RSEnquiry];
            };
        rc: GVProtocol.ReturnCode;
        oldBad: BOOLEAN _ FALSE;
        IF name.Length[] > GVBasics.maxRNameLength THEN RETURN[notFound];
        ClaimStream[];
        BEGIN
            AcceptGV: PROC[addr: Pup.Address]RETURNS[BOOLEAN] = {
                IF str # NIL THEN ERROR;
                cacheAddr _ addr;
                Create[! GVProtocol.Failed => GOTO failed ];
                RETURN[TRUE];
                EXITS failed => { CloseStream[]; RETURN[FALSE]; }; };
            IF addrHint THEN -- cached address hint set by client, so try it
                { addrHint _ FALSE; CloseStream[]; [] _ AcceptGV[cacheAddr]; };
            IF str # NIL THEN { -- try cached stream first
                rc _ work[str ! GVProtocol.Failed => GOTO StreamGone];
                EXITS StreamGone => CloseStream[]; };
            IF str = NIL THEN {
                <<Don't use cached address, so that we return to a near server>>
                <<Note: The following call of FindRegServer doesn't call us back recursively!>>
                [] _ GVLocate.FindRegServer["x.GV", AcceptGV];
                IF str = NIL THEN { info _ allDown; RETURN };
                rc _ work[str ! GVProtocol.Failed => GOTO NotThere]; };
            IF rc.code = WrongServer THEN { oldBad _ TRUE; IF reporter # NIL THEN reporter["wrong server"] }
            ELSE oldBad _ FALSE;
        EXITS NotThere => { CloseStream[]; oldBad _ TRUE; };
        END;
        IF oldBad THEN { -- need to find the correct R-Server
            Accept: PROC[addr: Pup.Address]RETURNS[BOOLEAN] = {
                ClaimStream[];
                IF str # NIL AND cacheAddr # addr THEN CloseStream[];
                IF str = NIL THEN {
                    cacheAddr _ addr;
                    Create[! GVProtocol.Failed => GOTO Failed]; };
                RETURN[TRUE];
                EXITS Failed => { CloseStream[]; ReleaseStream[]; RETURN[FALSE] }; };
            foundInfo: GVLocate.FoundServerInfo;
            ReleaseStream[]; -- for FindRegServer
            TRUSTED { foundInfo _ GVLocate.FindRegServer[name, Accept]; };
            WITH foundInfo SELECT FROM
                notFound => { info _ notFound; ClaimStream[]; RETURN };
                allDown => { info _ allDown; ClaimStream[]; RETURN };
                found => {
                    <<stream was claimed inside "Accept">>
                    rc _ work[str ! GVProtocol.Failed => GOTO Down ];
                    EXITS Down => { CloseStream[]; info _ allDown; RETURN }; };
            ENDCASE => ERROR; };
        info _ SELECT rc.code FROM
            noChange => noChange,
            done, BadRName =>
                SELECT rc.type FROM
                    individual => individual,
                    group => group,
                ENDCASE => notFound -- includes dead --,
            BadOperation, BadProtocol => protocolError,
            WrongServer => wrongServer,
            AllDown => allDown,
            BadPassword => badPwd,
            outOfDate => outOfDate,
            NotAllowed => notAllowed,
            ENDCASE => allDown;
        };

    CloseStream: PROC = {
        IF str = NIL THEN RETURN;
        GVProtocol.Close[str];
        str _ NIL;
        authUser _ NIL;
        };

    }.