<> <> <> DIRECTORY BasicTime USING [ Now ], Convert USING [ IntFromRope ], IO, LoganBerry USING [ AttributeType, AttributeValue, DeleteEntry, Entry, Error, ErrorCode, Open, OpenDB, ReadEntry, WriteEntry ], LoganBerryRpcControl USING [ ImportInterface, UnimportInterface ], LupineRuntime USING [ BindingError ], RefID USING [ nullID ], Rope USING [ Concat, Equal, ROPE ], RPC USING [ CallFailed, CallFailure, ImportFailed ], Thrush USING [EncryptionKey, nullKey, Tune, VoiceInterval], VoiceDB USING [ ErrorCode ], VoiceUtils USING [ CurrentRName ] ; VoiceDBImpl: CEDAR PROGRAM IMPORTS BasicTime, Convert, IO, LoganBerry, LoganBerryRpcControl, LupineRuntime, Rope, RPC, VoiceUtils EXPORTS VoiceDB = { OPEN IO; <> <<>> VoiceDBHandle: TYPE = REF VoiceDBHandleRec; VoiceDBHandleRec: PUBLIC TYPE = RECORD [ <> tunesDB: LoganBerry.OpenDB_RefID.nullID, tuneRefDB: LoganBerry.OpenDB_RefID.nullID, tunesDBName: Rope.ROPE, tuneRefDBName: Rope.ROPE, instance: Rope.ROPE, imported: BOOL_FALSE ]; nullKey: Thrush.EncryptionKey _ Thrush.nullKey; <> Error: PUBLIC ERROR[ec: VoiceDB.ErrorCode, explanation: Rope.ROPE_NIL] = CODE; Open: PUBLIC PROC[ dbName, instance, localName: Rope.ROPE ] RETURNS [ handle: VoiceDBHandle_NIL, openEc: VoiceDB.ErrorCode_NIL, expl: Rope.ROPE ] = { ENABLE { RPC.CallFailed => []_PostRPCError[handle, why, TRUE]; <<{>> <> <> <> <<};>> Error => { openEc _ ec; expl _ explanation; GOTO ReturnAnyway; }; LoganBerry.Error => []_PostLBError[ec, explanation, TRUE, dbName]; <> }; handle _ NEW[VoiceDBHandleRec _ [ tunesDBName: dbName.Concat[".df"], tuneRefDBName: dbName.Concat["Refs.df"]]]; handle.instance _ instance; <<
This version of VoiceDBImpl only knows how to open remote instances. We get into binder fun and games to do the local/remote thing. >> dbName _ handle.tunesDBName; handle.tunesDB _ OpenLB[handle: handle, dbName: handle.tunesDBName]; dbName _ handle.tuneRefDBName; handle.tuneRefDB _ OpenLB[handle: handle, dbName: handle.tuneRefDBName]; EXITS ReturnAnyway => NULL; -- return incomplete handle. }; Create: PUBLIC PROC[ handle: VoiceDBHandle, tune: INT, creator: Rope.ROPE, interval: Thrush.VoiceInterval, key: Thrush.EncryptionKey, otherAttributes: LoganBerry.Entry ] RETURNS [voiceFileID: Rope.ROPE_NIL, entry: LoganBerry.Entry_NIL] = TRUSTED { reopening: BOOL_FALSE; { ENABLE { RPC.CallFailed => IF (reopening _ PostRPCError[handle, why, reopening]) THEN RETRY; <> <> LoganBerry.Error => IF (reopening _ PostLBError[ec, explanation, reopening, handle.tunesDBName]) THEN RETRY; }; cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE [LONG[@key]]; keyRope: Rope.ROPE = IO.PutFR["%bB %bB", IO.card[cardKey[0]], IO.card[cardKey[1]]]; voiceFileID _ IO.PutFR["%g %g", int[tune], time[BasicTime.Now[]]]; IF creator=NIL THEN creator _ VoiceUtils.CurrentRName[]; entry _ CONS[ [$vid, voiceFileID], CONS[ [$cre, creator], CONS[ [$sta, IO.PutFR["%g", int[interval.start]]], CONS[ [$num, IO.PutFR["%g", int[interval.length]]], CONS[ [$key, keyRope], otherAttributes ]]]]]; IF reopening THEN handle.tunesDB _ OpenLB[handle:handle, dbName:handle.tunesDBName]; reopening _ FALSE; LoganBerry.WriteEntry[ db: handle.tunesDB, entry: entry]; }; }; Retain: PUBLIC PROC[ handle: VoiceDBHandle, voiceFileID: Rope.ROPE, refID: Rope.ROPE, refIDType: Rope.ROPE, creator: Rope.ROPE, otherAttributes: LoganBerry.Entry ] RETURNS [entry: LoganBerry.Entry_NIL] = { reopening: BOOL_FALSE; { ENABLE { RPC.CallFailed => IF (reopening _ PostRPCError[handle, why, reopening]) THEN RETRY; < Error[$communications,>> <> LoganBerry.Error => IF (reopening _ PostLBError[ec, explanation, reopening, handle.tuneRefDBName]) THEN RETRY; <> }; newTim, newVid: BOOL_FALSE; IF creator=NIL THEN creator _ VoiceUtils.CurrentRName[]; IF reopening THEN handle.tuneRefDB _ OpenLB[handle: handle, dbName: handle.tuneRefDBName]; reopening _ FALSE; entry _ Query[handle, NIL, refID, refIDType].refEntry; IF entry = NIL THEN entry _ CONS[ [$rid, refID], CONS[ [$rtp, refIDType], CONS[ [$cre, creator], otherAttributes ]]]; [entry, newTim] _ IncludeAttr[entry, $tim, IO.PutFR["%g", time[BasicTime.Now[]]], TRUE]; [entry, newVid] _ IncludeAttr[entry, $vid, voiceFileID, FALSE]; IF newTim OR newVid THEN Replace[handle.tuneRefDB, $rid, entry]; }; }; IncludeAttr: PROC[ entry: LoganBerry.Entry, key: LoganBerry.AttributeType, value: LoganBerry.AttributeValue, replace: BOOL <> ] RETURNS [newEntry: LoganBerry.Entry, isNew: BOOL_TRUE] = { FOR e: LoganBerry.Entry _ entry, e.rest WHILE e#NIL DO IF key=e.first.type THEN { IF replace THEN { e.first.value _ value; RETURN[entry, TRUE]; }; IF value#NIL AND value.Equal[e.first.value, FALSE] THEN RETURN[entry, FALSE]; }; ENDLOOP; newEntry _ CONS[ [key, value], entry]; }; Forget: PUBLIC PROC[ handle: VoiceDBHandle, refID: Rope.ROPE, refIDType: Rope.ROPE ] = { reopening: BOOL_FALSE; { ENABLE { RPC.CallFailed => IF (reopening _ PostRPCError[handle, why, reopening]) THEN RETRY; < Error[$communications,>> <> LoganBerry.Error => IF (reopening _ PostLBError[ec, explanation, reopening, handle.tuneRefDBName]) THEN RETRY; <> }; IF reopening THEN handle.tuneRefDB _ OpenLB[handle: handle, dbName: handle.tuneRefDBName]; reopening _ FALSE; LoganBerry.DeleteEntry[db: handle.tuneRefDB, key: $rid, value: refID! LoganBerry.Error => IF ec=$NoIndex THEN CONTINUE]; }; }; Query: PUBLIC PROC [ handle: VoiceDBHandle, voiceFileID: Rope.ROPE, refID: Rope.ROPE, refIDType: Rope.ROPE ] RETURNS [ tune: Thrush.Tune_-1, interval: Thrush.VoiceInterval, key: Thrush.EncryptionKey_Thrush.nullKey, voiceEntry: LoganBerry.Entry_NIL, refEntry: LoganBerry.Entry_NIL ] = TRUSTED { reopening: BOOL_FALSE; { ENABLE { RPC.CallFailed => IF (reopening _ PostRPCError[handle, why, reopening]) THEN RETRY; < Error[$communications,>> <> LoganBerry.Error => IF (reopening _ PostLBError[ec, explanation, reopening, handle.tuneRefDBName]) THEN RETRY; <> }; cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE[LONG[@key]]; keyStream: IO.STREAM; IF (refID#NIL AND refIDType=NIL) OR ((refID=NIL) = (voiceFileID=NIL)) THEN Error[$clientError, "\nQuery specifies both refID and voiceFileID, or refIDType omitted."]; IF refID#NIL THEN { IF reopening THEN handle.tuneRefDB _OpenLB[handle: handle, dbName:handle.tuneRefDBName]; reopening _ FALSE; refEntry _ LoganBerry.ReadEntry[db: handle.tuneRefDB, key: $rid, value: refID! LoganBerry.Error => IF ec=$NoIndex THEN CONTINUE].entry; IF refEntry=NIL THEN RETURN; IF ~GetAttr[refEntry, $rtp].Equal[refIDType] THEN Error[$clientError, "\nWrong refIDType specified."]; voiceFileID _ GetAttr[refEntry, $vid]; }; { -- Now refID scene is OK; separate LoganBerry error management for voiceFileID ENABLE LoganBerry.Error => IF (reopening _ PostLBError[ec, explanation, reopening, handle.tunesDBName]) THEN RETRY; IF voiceFileID=NIL THEN RETURN; IF reopening THEN handle.tunesDB_OpenLB[handle: handle, dbName: handle.tunesDBName]; reopening _ FALSE; voiceEntry _ LoganBerry.ReadEntry[db: handle.tunesDB, key: $vid, value: voiceFileID! LoganBerry.Error => IF ec=$NoIndex THEN CONTINUE].entry; IF voiceEntry=NIL THEN RETURN; tune _ Convert.IntFromRope[voiceFileID]; interval _ [ Convert.IntFromRope[GetAttr[voiceEntry, $sta]], Convert.IntFromRope[GetAttr[voiceEntry, $num]]]; keyStream _ IO.RIS[GetAttr[voiceEntry, $key]]; cardKey[0] _ IO.GetCard[keyStream]; cardKey[1] _ IO.GetCard[keyStream]; }; }; }; Replace: PROC[ db: LoganBerry.OpenDB, key: LoganBerry.AttributeType, entry: LoganBerry.Entry] = { LoganBerry.WriteEntry[ db: db, entry: entry! LoganBerry.Error => IF ec=$ValueNotUnique THEN GOTO DeleteFirst]; EXITS DeleteFirst => { LoganBerry.DeleteEntry[db: db, key: key, value: GetAttr[entry, key]]; LoganBerry.WriteEntry[ db: db, entry: entry]; }; }; GetAttr: PROC[entry: LoganBerry.Entry, key: LoganBerry.AttributeType] RETURNS[value: LoganBerry.AttributeValue_NIL] = { FOR ls: LoganBerry.Entry _ entry, ls.rest WHILE ls # NIL DO IF ls.first.type = key THEN RETURN[ls.first.value]; ENDLOOP; }; PostLBError: PROC[ ec: LoganBerry.ErrorCode, explanation: Rope.ROPE, reopening: BOOL, dbName: Rope.ROPE ] RETURNS[retry: BOOL_FALSE] = { SELECT ec FROM $CantOpenSchema, $CantOpenLog, $CantOpenIndex=> Error[$dbNotFound, IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]]; $BadSchema, $BadLogEntry, $BadIndex, $LogReadOnly => Error[$invalid, IO.PutFR["%g: %g", rope[dbName], rope[explanation]]]; $DBNotAvailable => Error[$notAvailable, IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]]; $DBClosed, $BadDBHandle => IF reopening THEN { Error[$notAvailable, IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]] } ELSE RETURN[retry: TRUE]; $ValueNotUnique => Error[$voiceIDNotUnique, IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]]; $NoIndex => Error[$refIDNotFound, IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]]; $NoPrimaryKey => Error[$clientError, IO.PutFR["\n%g: %g", rope[dbName], rope[explanation]]] ENDCASE; -- All others expected to propagate as uncaught signals }; PostRPCError: PROC[ handle: VoiceDBHandle, why: RPC.CallFailure, reopening: BOOL ] RETURNS[retry: BOOL] = { SELECT why FROM $timeout, $busy => Error[$communications, IO.PutFR["\nNo response from voice message database %g", rope[handle.instance]]]; $runtimeProtocol, $stubProtocol => Error[$invalid, "\nProtocol violation in communications with voice message database"]; $unbound => IF ~reopening THEN { -- Force reopening of all databases handle.tunesDB _ handle.tuneRefDB _ RefID.nullID; handle.imported _ FALSE; RETURN[TRUE]; } ELSE Error[$invalid, IO.PutFR["\nCan't bind to voice message database instance %g", rope[handle.instance]]]; ENDCASE=>ERROR; }; OpenLB: PROC[handle: VoiceDBHandle, dbName: Rope.ROPE] RETURNS [db: LoganBerry.OpenDB] = { <> IF ~handle.imported THEN ImportLoganberry[handle]; db _ LoganBerry.Open[dbName: dbName]; }; ImportLoganberry: PROC[handle: VoiceDBHandle] = { ENABLE { RPC.ImportFailed => Error[$NotFound, IO.PutFR["Could not import Loganberry from %g", rope[handle.instance]]]; }; TRUSTED { LoganBerryRpcControl.UnimportInterface[!LupineRuntime.BindingError => CONTINUE];}; LoganBerryRpcControl.ImportInterface[["Loganberry.Lark", handle.instance]]; handle.tunesDB _ handle.tuneRefDB _ RefID.nullID; handle.imported _ TRUE; }; }. <> <> <> <<>>