<<>>
<<LoganBerrySunStubImpl.mesa>>
    <<Copyright Ó 1985, 1989, 1992 by Xerox Corporation.  All rights reserved.>>
    <<Doug Terry, February 10, 1991 6:59 pm PST>>
    <<Brian Oki, March 30, 1990 4:38 pm PST>>
    <<Willie-s, April 23, 1992 5:14 pm PDT>>
    <<>>
    <<Allows one to invoke operations on LoganBerry servers using SUN RPC.  >>
    <<>>
    DIRECTORY
        Arpa USING [Address, nullAddress],
        Atom USING [GetPName, MakeAtom],
        Basics USING [HFromCard16, LowHalf],
        Convert USING [ArpaAddressFromRope],
        IO USING [rope, PutFR1],
        LoganBerry,
        LoganBerryClass USING [Class, ClassObject, Register],
        LoganBerrySunRPC,
        LoganBerrySunRPCClient,
        RefID USING [Seal, Unseal],
        Rope USING [Concat, Find, FromRefText, Length,  Replace, ROPE, Substr],
        SunPMap USING [ipProtocolUDP, udpPort],
        SunPMapClient USING [GetPort],
        SunRPC USING [Error, Handle],
        SunRPCOnUDP USING [Create, SetRemote],
        SunRPCAuth USING [Initiate],
        SunYPAgent USING [Error, Handle, Match, ObtainHandle, ReleaseHandle, Tokenize];

    LoganBerrySunStubImpl: CEDAR MONITOR LOCKS dbinfo USING dbinfo: OpenDBInfo
        <<-- Operations are monitored to avoid concurrent callers using the same RPC handle.>>
    IMPORTS  Atom, Basics, Convert, IO, LoganBerry, LoganBerryClass, LoganBerrySunRPCClient, RefID, Rope, SunPMapClient, SunRPC, 
    SunRPCAuth, SunRPCOnUDP, SunYPAgent
    <<EXPORTS LoganBerry indirectly by registering with LoganBerryClass>>
    ~ BEGIN

    ROPE: TYPE = Rope.ROPE;
        Conv: TYPE ~ LoganBerry.Conv;
        OpenDB: TYPE ~ LoganBerry.OpenDB;
        AttributeType: TYPE ~ LoganBerry.AttributeType;
        AttributeValue: TYPE ~ LoganBerry.AttributeValue;
        Entry: TYPE ~ LoganBerry.Entry;
        EntryProc: TYPE ~ LoganBerry.EntryProc;
        Cursor: TYPE ~ LoganBerry.Cursor;
        CursorDirection: TYPE ~ LoganBerry.CursorDirection;
        LogID: TYPE ~ LoganBerry.LogID;
        activityLog: LogID ~ LoganBerry.activityLog;
        SchemaInfo: TYPE ~ LoganBerry.SchemaInfo;

    nilconv: INT = 0;

    OpenDBInfo: TYPE = REF OpenDBRecord;
    OpenDBRecord: TYPE = MONITORED RECORD [
    h: SunRPC.Handle Ź NIL,
    db: CARD32            
    ];

    CursorInfo: TYPE = REF CursorRecord;
    CursorRecord: TYPE = RECORD[
    dbinfo: OpenDBInfo,  
    cursor: CARD32    
    ];
<<Naming>>
    <<Database name should be of the form: /server-Sun/rest/...LB.df.  
    This becomes: server="server", nameOnServer="//rest/...LB.df".>>

    CheckName: PROC [dbName: ROPE] RETURNS [accept: BOOLEAN, server: ROPE, nameOnServer: ROPE] ~ {
        fullPathName: ROPE;
        serverIndex: INT;
        sunName: BOOL Ź TRUE;
        fullPathName Ź dbName;

        accept Ź FALSE;

        serverIndex Ź Rope.Find[s1: fullPathName, s2: "-SUN", case: FALSE];
        IF serverIndex = -1 THEN {
            sunName Ź FALSE;
            serverIndex Ź Rope.Find[s1: fullPathName, s2: "-ARPA", case: FALSE]};

        IF serverIndex > -1 THEN {  -- found either -sun or -arpa suffix
            newlength: INT;
            fullServerName: ROPE;
            serverNameLength: INT Ź serverIndex - 1;
            accept Ź TRUE;
            server Ź Rope.Substr[base: fullPathName, start: 1, len: serverNameLength];

            IF sunName THEN
                fullServerName Ź Rope.Concat[base: server, rest: "-SUN"]
                ELSE fullServerName Ź Rope.Concat[base: server, rest: "-ARPA"];

            <<Now the full server name is of the form name-sun or name-arpa. Now from this extract the full path name to get the actual name on 
            server.>>
            newlength Ź Rope.Length[fullServerName] ;
            nameOnServer Ź NIL;
            nameOnServer Ź Rope.Replace[base: fullPathName, start: 1, len: newlength, with: NIL];
            newlength Ź Rope.Length[nameOnServer];
            nameOnServer Ź Rope.Substr[base: nameOnServer, start: 1, len: newlength];

            };
        };

    ypMap: ROPE Ź "hosts.byname";

    SunYPNameToAddress: PROC [name: ROPE] RETURNS [addr: Arpa.Address Ź Arpa.nullAddress] ~ {
        ENABLE SunYPAgent.Error => CONTINUE;
        mapEntry: REF TEXT Ź NIL;
        h: SunYPAgent.Handle Ź SunYPAgent.ObtainHandle[];  -- use default domain
        mapEntry Ź SunYPAgent.Match[h, ypMap, name];
        SunYPAgent.ReleaseHandle[h];
        IF mapEntry # NIL THEN {
            <<map entry is something like "13.0.208.72 baobab baobab.parc.xerox.com">>
            addrText: REF TEXT Ź SunYPAgent.Tokenize[mapEntry][0];  -- address is at front of mapEntry
            addr Ź Convert.ArpaAddressFromRope[Rope.FromRefText[addrText]];
            };
        };
<<Class methods>>
    Open: PROC [conv: Conv Ź NIL, dbName: ROPE] RETURNS [db: OpenDB] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        accept: BOOLEAN;
        server, nameOnServer: ROPE;
        dbinfo: OpenDBInfo;
        addr: Arpa.Address;
        port: CARD;

        [accept, server, nameOnServer] Ź CheckName[dbName];
        IF NOT accept THEN RETURN[LoganBerry.nullDB];

        dbinfo Ź NEW[OpenDBRecord];
        addr Ź SunYPNameToAddress[server];
        IF ( addr = Arpa.nullAddress ) THEN 
            ERROR LoganBerry.Error[$CantOpenSchema, IO.PutFR1["Unknown server: %g.", IO.rope[server]]];
        dbinfo.h Ź SunRPCOnUDP.Create[addr, Basics.HFromCard16[SunPMap.udpPort]];
        port Ź SunPMapClient.GetPort[dbinfo.h, SunRPCAuth.Initiate[], 390905, 1, SunPMap.ipProtocolUDP ! SunRPC.Error => ERROR 
        LoganBerry.Error[$CantOpenSchema, IO.PutFR1["Can't contact remote server: %g.", IO.rope[server]]]];
        IF port = 0 THEN 
            ERROR LoganBerry.Error[$CantOpenSchema, IO.PutFR1["LoganBerry not exported on server: %g.", IO.rope[server]]];

        dbinfo.h Ź SunRPCOnUDP.SetRemote[dbinfo.h, addr, Basics.HFromCard16[Basics.LowHalf[port]]];
        dbinfo.db Ź LoganBerrySunRPCClient.Open[dbinfo.h, nilconv, nameOnServer];
        RETURN[RefID.Seal[dbinfo]];
        };

    ReadEntry: PROC [conv: Conv Ź NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN] ~ 
    {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        dbinfo: OpenDBInfo Ź GetInfo[db];
        [entry, others] Ź ReadEntryI[dbinfo, key, value];
        RETURN[entry, others];
        };

    ReadEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: 
    BOOLEAN] ~ {
        ENABLE UNWIND => NULL;
        srEntry: LoganBerrySunRPC.Entry;
        [srEntry, others] Ź LoganBerrySunRPCClient.ReadEntry[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], value];
        entry Ź SrToEntry[srEntry];
        };

    EnumerateEntries: PROC [db: OpenDB, key: AttributeType, start: AttributeValue Ź NIL, end: AttributeValue Ź NIL, proc: EntryProc] 
    RETURNS [] ~ {
        entry: Entry;
        c: Cursor Ź GenerateEntries[NIL, db, key, start, end];
        entry Ź NextEntry[NIL, c];
        WHILE entry # NIL DO 
            IF NOT proc[entry] THEN EXIT;
            entry Ź NextEntry[NIL, c];
            ENDLOOP;
        EndGenerate[NIL, c];
        };

    GenerateEntries: PROC [conv: Conv Ź NIL, db: OpenDB, key: AttributeType, start: AttributeValue Ź NIL, end: AttributeValue Ź NIL] 
    RETURNS [cursor: Cursor] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        cinfo: CursorInfo;
        dbinfo: OpenDBInfo Ź GetInfo[db];
        cinfo Ź GenerateEntriesI[dbinfo, key, start, end];
        RETURN[RefID.Seal[cinfo]];
        };

    GenerateEntriesI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, key: AttributeType, start: AttributeValue Ź NIL, end: AttributeValue Ź 
    NIL] RETURNS [cinfo: CursorInfo] ~ {
        ENABLE UNWIND => NULL;
        cinfo Ź NEW[CursorRecord];
        cinfo.dbinfo Ź dbinfo;
        cinfo.cursor Ź LoganBerrySunRPCClient.GenerateEntries[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], start, end];
        };

    NextEntry: PROC [conv: Conv Ź NIL, cursor: Cursor, dir: CursorDirection Ź increasing] RETURNS [entry: Entry] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        cinfo: CursorInfo Ź GetCursorInfo[cursor];
        entry Ź NextEntryI[cinfo.dbinfo, cinfo, dir];
        RETURN[entry];
        };

    NextEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, cinfo: CursorInfo, dir: CursorDirection Ź increasing] RETURNS [entry: Entry] ~ {
        ENABLE UNWIND => NULL;
        srEntry: LoganBerrySunRPC.Entry;
        srEntry Ź LoganBerrySunRPCClient.NextEntry[cinfo.dbinfo.h, nilconv, cinfo.cursor, IF dir=increasing THEN increasing ELSE 
        decreasing];
        entry Ź SrToEntry[srEntry];
        };

    EndGenerate: PROC [conv: Conv Ź NIL, cursor: Cursor] RETURNS [] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        cinfo: CursorInfo Ź GetCursorInfo[cursor];
        EndGenerateI[cinfo.dbinfo, cinfo];
        };

    EndGenerateI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, cinfo: CursorInfo] RETURNS [] ~ {
        ENABLE UNWIND => NULL;
        LoganBerrySunRPCClient.EndGenerate[cinfo.dbinfo.h, nilconv, cinfo.cursor];
        };

    WriteEntry: PROC [conv: Conv Ź NIL, db: OpenDB, entry: Entry, log: LogID Ź activityLog, replace: BOOLEAN Ź FALSE] RETURNS [] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        dbinfo: OpenDBInfo Ź GetInfo[db];
        WriteEntryI[dbinfo, entry, log, replace];
        };

    WriteEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, entry: Entry, log: LogID Ź activityLog, replace: BOOLEAN Ź FALSE] RETURNS [] ~ {
        ENABLE UNWIND => NULL;
        LoganBerrySunRPCClient.WriteEntry[dbinfo.h, nilconv, dbinfo.db, EntryToSr[entry], log, replace];
        };

    DeleteEntry: PROC [conv: Conv Ź NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [deleted: Entry] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        dbinfo: OpenDBInfo Ź GetInfo[db];
        deleted Ź DeleteEntryI[dbinfo, key, value];
        RETURN[deleted];
        };

    DeleteEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, key: AttributeType, value: AttributeValue] RETURNS [deleted: Entry] ~ {
        ENABLE UNWIND => NULL;
        srEntry: LoganBerrySunRPC.Entry;
        srEntry Ź LoganBerrySunRPCClient.ReadEntry[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], value].entry;
        LoganBerrySunRPCClient.DeleteEntry[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], value];
        deleted Ź SrToEntry[srEntry];
        };

    Close: PROC [conv: Conv Ź NIL, db: OpenDB] RETURNS [] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        dbinfo: OpenDBInfo Ź GetInfo[db];
        CloseI[dbinfo];
        };

    CloseI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [] ~ {
        ENABLE UNWIND => NULL;
        LoganBerrySunRPCClient.Close[dbinfo.h, nilconv, dbinfo.db];
        };

    BuildIndices: PROC [conv: Conv Ź NIL, db: OpenDB] RETURNS [] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        dbinfo: OpenDBInfo Ź GetInfo[db];
        BuildIndicesI[dbinfo];
        };

    BuildIndicesI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [] ~ {
        ENABLE UNWIND => NULL;
        LoganBerrySunRPCClient.BuildIndices[dbinfo.h, nilconv, dbinfo.db];
        };

    CompactLogs: PROC [conv: Conv Ź NIL, db: OpenDB] RETURNS [] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        dbinfo: OpenDBInfo Ź GetInfo[db];
        CompactLogsI[dbinfo];
        };

    CompactLogsI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [] ~ {
        ENABLE UNWIND => NULL;
        LoganBerrySunRPCClient.CompactLogs[dbinfo.h, nilconv, dbinfo.db];
        };

    Describe: PROC [conv: Conv Ź NIL, db: OpenDB] RETURNS [info: SchemaInfo] ~ {
        ENABLE {
            SunRPC.Error => PostSunError[code];
            LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
            };
        dbinfo: OpenDBInfo Ź GetInfo[db];
        info Ź DescribeI[dbinfo];
        RETURN[info];
        };

    DescribeI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [info: SchemaInfo] ~ {
        ENABLE UNWIND => NULL;
        srInfo: LoganBerrySunRPC.SchemaInfo;
        srInfo Ź LoganBerrySunRPCClient.Describe[dbinfo.h, nilconv, dbinfo.db];
        info Ź SrToSchemaInfo[srInfo];
        };

    IsLocal: PROC [db: LoganBerry.OpenDB] RETURNS [local: BOOL Ź TRUE] = {
        RETURN[FALSE];
        };

    PostSunError: PROC [code: ATOM] RETURNS [] ~ {
    <<Simply turn SUN RPC errors into LoganBerry errors.>>
        ERROR LoganBerry.Error[$CallFailed, IO.PutFR1["SUN RPC stub problem - %g.", IO.rope[SELECT code FROM
            $timeout, $unreachable => "server unreachable",
            $protocolError => "protocol error",
            $wrongRPCVersion, $wrongProgram, $wrongProgramVersion, $wrongProc => "using wrong program, version, or procedure",
            ENDCASE => "unknown error"
            ]]];
        };
<<Handles>>
    GetInfo: PROC [db: OpenDB] RETURNS [OpenDBInfo] ~ INLINE {
        <<Unseals the database handle and ensures that it's valid.>>
        ref: REF = RefID.Unseal[db];
        IF ref = NIL THEN
            ERROR LoganBerry.Error[$BadDBHandle, "NIL OpenDB handle."];
        WITH ref SELECT FROM
            dbinfo: OpenDBInfo => {
                RETURN[dbinfo];
                };
            ENDCASE => ERROR LoganBerry.Error[$BadDBHandle, "Invalid OpenDB handle."];
        };

    GetCursorInfo: PROC [cursor: Cursor] RETURNS [CursorInfo] ~ INLINE {
        <<Unseals the cursor and ensures that it's valid.>>
        ref: REF = RefID.Unseal[cursor];
        IF ref = NIL THEN
            ERROR LoganBerry.Error[$BadCursor, "NIL cursor."];
        WITH ref SELECT FROM
            cinfo: CursorInfo => {
                RETURN[cinfo];
                };
            ENDCASE => ERROR LoganBerry.Error[$BadCursor, "Invalid cursor."];
        };

<<Data conversion>>
    SrToEntry: PROC [srEntry: LoganBerrySunRPC.Entry] RETURNS [entry: LoganBerry.Entry] ~ {
        entry Ź NIL;
        FOR i: CARDINAL DECREASING IN [0..srEntry.length) DO
            attr: LoganBerry.Attribute Ź [Atom.MakeAtom[srEntry[i].type], srEntry[i].value];
            entry Ź CONS[attr, entry];
            ENDLOOP;
        };

    EntryToSr: PROC [entry: LoganBerry.Entry] RETURNS [srEntry: LoganBerrySunRPC.Entry] ~ {
        count: CARDINAL Ź 0;
        FOR e: Entry Ź entry, e.rest WHILE e # NIL DO
            count Ź count + 1;
            ENDLOOP;
        srEntry Ź NEW[LoganBerrySunRPC.EntryObject[count]];
        count Ź 0;
        FOR e: Entry Ź entry, e.rest WHILE e # NIL DO
            srEntry[count].type Ź Atom.GetPName[e.first.type];
            srEntry[count].value Ź e.first.value;
            count Ź count + 1;
            ENDLOOP;
        };

    SrToSchemaInfo: PROC [srInfo: LoganBerrySunRPC.SchemaInfo] RETURNS [info: LoganBerry.SchemaInfo] ~ {
        SrToLogList: PROC [srLogs: LoganBerrySunRPC.LogList] RETURNS [logs: LIST OF LoganBerry.LogInfo] ~ {
            logs Ź NIL;
            FOR i: CARDINAL DECREASING IN [0..srLogs.length) DO
                loginfo: LoganBerry.LogInfo Ź NEW[LoganBerry.LogInfoRec Ź [srLogs[i].id, srLogs[i].file]];
                logs Ź CONS[loginfo, logs];
                ENDLOOP;
            };
        SrToIndexList: PROC [srIndices: LoganBerrySunRPC.IndexList] RETURNS [indices: LIST OF LoganBerry.IndexInfo] ~ {
            indices Ź NIL;
            FOR i: CARDINAL DECREASING IN [0..srIndices.length) DO
                indexinfo: LoganBerry.IndexInfo Ź NEW[LoganBerry.IndexInfoRec Ź [Atom.MakeAtom[srIndices[i].key], srIndices[i].file, 
                Atom.MakeAtom[srIndices[i].order]]];
                indices Ź CONS[indexinfo, indices];
                ENDLOOP;
            };
        info Ź NEW[LoganBerry.SchemaInfoRec Ź [srInfo.dbName, SrToLogList[srInfo.logs], SrToIndexList[srInfo.indices]]];
        };


<<Class registration>>
    class: LoganBerryClass.Class;

    Init: PROC ~ {
        LoganBerryClass.Register[name: class.name, class: class];
        };


    class Ź NEW[LoganBerryClass.ClassObject Ź [
        name: $SunRPCStub, 
        open: Open,
        describe: Describe,
        readEntry: ReadEntry,
        enumerateEntries: EnumerateEntries,
        generateEntries: GenerateEntries,
        nextEntry: NextEntry,
        endGenerate: EndGenerate,
        writeEntry: WriteEntry,
        deleteEntry: DeleteEntry,
        close: Close,
        buildIndices: BuildIndices,
        compactLogs: CompactLogs,
        isLocal: IsLocal,
        classData: NIL
        ]];

    Init[];

    END.
    <<>>