<> <> <> <<>> <> <<>> DIRECTORY FS USING [ComponentPositions, ExpandName], LoganBerry, LoganBerryExtras, LoganBerryRpcControl, RefID USING [Seal, Unseal], Rope USING [Equal, ROPE, Substr, Replace], RPC USING [ShortROPE, VersionRange, matchAllVersions, SecurityLevel, Conversation, EncryptionKey, MakeKey, StartConversation, AuthenticateFailed, AuthenticateFailure, CallFailed, CallFailure, ImportFailed, ImportFailure], UserCredentials USING [Get], LoganBerryStubExtras, LoganBerryStub; LoganBerryStubImpl: CEDAR PROGRAM IMPORTS FS, LoganBerry, LoganBerryExtras, LoganBerryRpcControl, RefID, Rope, RPC, UserCredentials EXPORTS LoganBerryStub, LoganBerryStubExtras ~ BEGIN OPEN LoganBerryStub; ROPE: TYPE = Rope.ROPE; loganBerryType: RPC.ShortROPE = "LoganBerry.Lark"; loganBerryVersion: RPC.VersionRange = RPC.matchAllVersions; securityLevel: RPC.SecurityLevel = authOnly; <<>> InstanceInterface: TYPE = REF InstanceInterfaceRecord; InstanceInterfaceRecord: TYPE = RECORD [ instance: RPC.ShortROPE, interface: LoganBerryRpcControl.InterfaceRecord, conv: RPC.Conversation ]; interfaceCache: LIST OF InstanceInterface; DBInterface: TYPE = REF DBInterfaceRecord; DBInterfaceRecord: TYPE = RECORD [ interface: LoganBerryRpcControl.InterfaceRecord, conv: RPC.Conversation, db: LoganBerry.OpenDB, instance: RPC.ShortROPE, dbName: ROPE ]; CursorInterface: TYPE = REF CursorInterfaceRecord; CursorInterfaceRecord: TYPE = RECORD [ dbi: DBInterface, cursor: LoganBerry.Cursor ]; <> Error: PUBLIC ERROR [ec: ErrorCode, explanation: ROPE _ NIL] = CODE; Open: PUBLIC PROC [conv: Conv _ NIL, dbName: ROPE] RETURNS [db: OpenDB] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, NIL]; RETRY;}; LoganBerry.Error => ERROR Error[ec, explanation]; }; instance: RPC.ShortROPE; interface: LoganBerryRpcControl.InterfaceRecord; conversation: RPC.Conversation; cp: FS.ComponentPositions; fullDBName: ROPE; remoteDB: LoganBerry.OpenDB; [fullDBName, cp] _ FS.ExpandName[dbName]; instance _ Rope.Substr[fullDBName, cp.server.start, cp.server.length]; fullDBName _ Rope.Replace[base: fullDBName, start: cp.server.start, len: cp.server.length, with: NIL]; [interface, conversation] _ ImportLoganBerry[instance]; IF conv # NIL THEN conversation _ conv; -- use the conversation presented if possible remoteDB _ interface.Open[conversation, fullDBName]; db _ SaveDBInterface[interface, conversation, remoteDB, instance, fullDBName]; }; ReadEntry: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; [entry, others] _ dbi.interface.ReadEntry[dbi.conv, dbi.db, key, value]; }; EnumerateEntries: PUBLIC PROC [db: OpenDB, key: AttributeType, start: AttributeValue _ NIL, end: AttributeValue _ NIL, proc: EntryProc] RETURNS [] ~ { <> ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; isLocal: BOOLEAN _ FALSE; dbi: DBInterface _ GetDBInterface[db]; FOR l: LIST OF InstanceInterface _ interfaceCache, l.rest WHILE l # NIL DO IF Rope.Equal[l.first.instance, ""] THEN { IF l.first.interface = dbi.interface THEN -- beware: pointer comparison isLocal _ TRUE; EXIT; }; ENDLOOP; IF NOT isLocal THEN ERROR Error[$BadDBHandle, "Enumerates can only be done on local databases."]; dbi.interface.EnumerateEntries[dbi.db, key, start, end, proc]; }; GenerateEntries: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB, key: AttributeType, start: AttributeValue _ NIL, end: AttributeValue _ NIL] RETURNS [cursor: Cursor] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; remoteCursor: LoganBerry.Cursor; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; remoteCursor _ dbi.interface.GenerateEntries[dbi.conv, dbi.db, key, start, end]; cursor _ SaveCursorInterface[dbi, remoteCursor]; }; NextEntry: PUBLIC PROC [conv: Conv _ NIL, cursor: Cursor, dir: CursorDirection _ increasing] RETURNS [entry: Entry] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetCursorInterface[cursor].dbi]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetCursorInterface[cursor].dbi]; RETRY;}; }; ci: CursorInterface _ GetCursorInterface[cursor]; IF conv # NIL THEN ci.dbi.conv _ conv; entry _ ci.dbi.interface.NextEntry[ci.dbi.conv, ci.cursor, dir]; }; EndGenerate: PUBLIC PROC [conv: Conv _ NIL, cursor: Cursor] RETURNS [] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetCursorInterface[cursor].dbi]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetCursorInterface[cursor].dbi]; RETRY;}; }; ci: CursorInterface _ GetCursorInterface[cursor]; IF conv # NIL THEN ci.dbi.conv _ conv; ci.dbi.interface.EndGenerate[ci.dbi.conv, ci.cursor]; }; WriteEntry: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB, entry: Entry, log: LogID _ activityLog, replace: BOOLEAN _ FALSE] RETURNS [] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; dbi.interface.WriteEntry[dbi.conv, dbi.db, entry, log, replace]; }; DeleteEntry: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; dbi.interface.DeleteEntry[dbi.conv, dbi.db, key, value]; }; Close: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB] RETURNS [] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; dbi.interface.Close[dbi.conv, dbi.db]; }; BuildIndices: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB] RETURNS [] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; dbi.interface.BuildIndices[dbi.conv, dbi.db]; }; CompactLogs: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB] RETURNS [] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; dbi.interface.CompactLogs[dbi.conv, dbi.db]; }; Describe: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB] RETURNS [info: SchemaInfo] ~ { ENABLE { RPC.CallFailed => {PostRpcCallError[why, GetDBInterface[db]]; RETRY;}; LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; info _ dbi.interface.Describe[dbi.conv, dbi.db]; }; <> Describe2: PUBLIC PROC [conv: Conv _ NIL, db: OpenDB] RETURNS [info: LoganBerryStubExtras.SchemaInfo] ~ { ENABLE { LoganBerry.Error => {PostLoganBerryError[ec, explanation, GetDBInterface[db]]; RETRY;}; }; dbi: DBInterface _ GetDBInterface[db]; IF conv # NIL THEN dbi.conv _ conv; info _ LoganBerryExtras.Describe2[dbi.conv, dbi.db]; }; <> <> <<>> ImportLoganBerry: PROC [instance: RPC.ShortROPE] RETURNS [interface: LoganBerryRpcControl.InterfaceRecord, conv: RPC.Conversation] ~ { <> interface _ NIL; FOR l: LIST OF InstanceInterface _ interfaceCache, l.rest WHILE l # NIL DO IF Rope.Equal[l.first.instance, instance] THEN { interface _ l.first.interface; conv _ l.first.conv; EXIT; }; ENDLOOP; IF interface = NIL THEN { IF Rope.Equal[instance, ""] THEN { -- need local interface interface _ NewLocalInterface[]; conv _ NIL; } ELSE { -- import remote interface interface _ LoganBerryRpcControl.ImportNewInterface[[type: loganBerryType, instance: instance, version: loganBerryVersion] ! RPC.ImportFailed => PostRpcImportError[why]]; conv _ NewConversation[instance]; }; interfaceCache _ CONS[NEW[InstanceInterfaceRecord _ [instance, interface, conv]], interfaceCache]; }; }; InvalidateInterface: PROC [instance: RPC.ShortROPE] RETURNS [] ~ { <> prev: LIST OF InstanceInterface _ NIL; FOR l: LIST OF InstanceInterface _ interfaceCache, l.rest WHILE l # NIL DO IF Rope.Equal[l.first.instance, instance] THEN IF prev = NIL THEN interfaceCache _ l.rest ELSE prev.rest _ l.rest; prev _ l; ENDLOOP; }; NewLocalInterface: PROC [] RETURNS [interface: LoganBerryRpcControl.InterfaceRecord] ~ { <> interface _ NEW[LoganBerryRpcControl.InterfaceRecordObject]; interface^ _ [Error: LoganBerry.Error, clientStubOpen: localOpen, clientStubDescribe: localDescribe, clientStubReadEntry: localReadEntry, clientStubEnumerateEntries: localEnumerateEntries, clientStubGenerateEntries: localGenerateEntries, clientStubNextEntry: localNextEntry, clientStubEndGenerate: localEndGenerate, clientStubWriteEntry: localWriteEntry, clientStubDeleteEntry: localDeleteEntry, clientStubClose: localClose, clientStubBuildIndices: localBuildIndices, clientStubCompactLogs: localCompactLogs]; }; <> localOpen: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, dbName: ROPE] RETURNS [db: OpenDB] ~ { RETURN[LoganBerry.Open[conv, dbName]]; }; localReadEntry: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN] ~ { [entry, others] _ LoganBerry.ReadEntry[conv, db, key, value]; }; localEnumerateEntries: PROC [interface: LoganBerryRpcControl.InterfaceRecord, db: OpenDB, key: AttributeType, start: AttributeValue _ NIL, end: AttributeValue _ NIL, proc: EntryProc] RETURNS [] ~ { LoganBerry.EnumerateEntries[db, key, start, end, proc]; }; localGenerateEntries: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB, key: AttributeType, start: AttributeValue _ NIL, end: AttributeValue _ NIL] RETURNS [cursor: Cursor] ~ { RETURN[LoganBerry.GenerateEntries[conv, db, key, start, end]]; }; localNextEntry: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, cursor: Cursor, dir: CursorDirection _ increasing] RETURNS [entry: Entry] ~ { RETURN[LoganBerry.NextEntry[conv, cursor, dir]]; }; localEndGenerate: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, cursor: Cursor] RETURNS [] ~ { LoganBerry.EndGenerate[conv, cursor]; }; localWriteEntry: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB, entry: Entry, log: LogID _ activityLog, replace: BOOLEAN _ FALSE] RETURNS [] ~ { LoganBerry.WriteEntry[conv, db, entry, log, replace]; }; localDeleteEntry: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [] ~ { LoganBerry.DeleteEntry[conv, db, key, value]; }; localClose: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB] RETURNS [] ~ { LoganBerry.Close[conv, db]; }; localBuildIndices: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB] RETURNS [] ~ { LoganBerry.BuildIndices[conv, db]; }; localCompactLogs: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB] RETURNS [] ~ { LoganBerry.CompactLogs[conv, db]; }; localDescribe: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: Conv _ NIL, db: OpenDB] RETURNS [info: SchemaInfo] ~ { RETURN[LoganBerry.Describe[conv, db]]; }; <> <> NewConversation: PROC [instance: RPC.ShortROPE] RETURNS [conv: RPC.Conversation] ~ { caller: ROPE _ UserCredentials.Get[].name; key: RPC.EncryptionKey _ RPC.MakeKey[UserCredentials.Get[].password]; conv _ RPC.StartConversation[caller: caller, key: key, callee: instance, level: securityLevel ! RPC.AuthenticateFailed => PostRpcAuthError[why]]; }; <> <> <> SaveDBInterface: PROC [interface: LoganBerryRpcControl.InterfaceRecord, conv: RPC.Conversation, db: LoganBerry.OpenDB, instance: RPC.ShortROPE, dbName: ROPE] RETURNS [localDB: LoganBerry.OpenDB] ~ { dbi: DBInterface _ NEW[DBInterfaceRecord _ [interface, conv, db, instance, dbName]]; RETURN[RefID.Seal[dbi]]; }; GetDBInterface: PROC [localDB: LoganBerry.OpenDB] RETURNS [dbi: DBInterface] ~ { ref: REF = RefID.Unseal[localDB]; IF ref = NIL THEN ERROR Error[$BadDBHandle, "NIL OpenDB handle."]; WITH ref SELECT FROM dbi: DBInterface => RETURN[dbi]; ENDCASE => ERROR Error[$BadDBHandle, "Invalid OpenDB handle."]; }; SaveCursorInterface: PROC [dbi: DBInterface, cursor: LoganBerry.Cursor] RETURNS [localCursor: LoganBerry.Cursor] ~ { ci: CursorInterface _ NEW[CursorInterfaceRecord _ [dbi, cursor]]; RETURN[RefID.Seal[ci]]; }; GetCursorInterface: PROC [localCursor: LoganBerry.Cursor] RETURNS [ci: CursorInterface] ~ { ref: REF = RefID.Unseal[localCursor]; IF ref = NIL THEN ERROR Error[$BadCursor, "NIL cursor handle."]; WITH ref SELECT FROM ci: CursorInterface => RETURN[ci]; ENDCASE => ERROR Error[$BadCursor, "Invalid cursor passed to NextEntry."]; }; <> <> <<>> PostLoganBerryError: PROC[ec: LoganBerry.ErrorCode, explanation: Rope.ROPE, dbi: DBInterface] RETURNS [] = { <> SELECT ec FROM $DBClosed, $BadDBHandle => { -- try to reopen database dbi.db _ dbi.interface.Open[dbi.conv, dbi.dbName ! LoganBerry.Error => PostLoganBerryError[ec, explanation, dbi]]; }; ENDCASE => { -- propagate the error as a LoganBerryStub.Error ERROR Error[ec, explanation]; }; }; PostRpcCallError: PROC[why: RPC.CallFailure, dbi: DBInterface] RETURNS [] = { <> SELECT why FROM $timeout => ERROR Error[$CallFailed, "no acknowledgement within reasonable time"]; $busy => ERROR Error[$CallFailed, "server says it is too busy"]; $runtimeProtocol => ERROR Error[$CallFailed, "user/server runtimes do not understand each other"]; $stubProtocol => ERROR Error[$CallFailed, "user/server stubs do not understand each other"]; $unbound => { -- try to reimport the interface IF dbi # NIL THEN { InvalidateInterface[dbi.instance]; [interface: dbi.interface] _ ImportLoganBerry[dbi.instance]; }; }; ENDCASE => ERROR Error[$CallFailed, "unknown reason"]; }; PostRpcAuthError: PROC [why: RPC.AuthenticateFailure] RETURNS [] ~ { explanation: ROPE _ SELECT why FROM $communications => "could not contact authentication server", $badCaller => "invalid caller name", $badKey => "incorrect caller password", $badCallee => "invalid callee name", ENDCASE => "unknown reason"; ERROR Error[$AuthenticateFailed, explanation]; }; PostRpcImportError: PROC [why: RPC.ImportFailure] RETURNS [] ~ { explanation: ROPE _ SELECT why FROM $communications => "could not access binding database", $badType => "unacceptable interface type name", $badInstance => "unacceptable interface instance name", $badVersion => "statically silly version range", $wrongVersion => "exported version not in required range", $unbound => "this instance not exported", $stubProtocol => "exporter protocol incompatible with importer", ENDCASE => "unknown reason"; ERROR Error[$ImportFailed, explanation]; }; END. <<>> <> <> <> <> <> <> <> <> <>