<> <> <> <<>> <> <<>> <> <<>> DIRECTORY BasicTime USING [earliestGMT, Now, Period], Convert USING [IntFromRope, RopeFromInt], IO USING [card, GetCard, GetInt, int, PutFR, RIS, rope, STREAM], LoganBerryStub USING [AttributeType, AttributeValue, Entry, Error, ErrorCode, Open, OpenDB, ReadEntry, WriteEntry], Rope USING [Concat, ROPE], Thrush USING [EncryptionKey, Tune, VoiceInterval], UserCredentials USING [CredentialsChangeProc, Get, RegisterForChange], VoiceRopeDB; VoiceRopeDBImpl: CEDAR PROGRAM -- Should this be a monitor? IMPORTS BasicTime, Convert, IO, Rope, UserCredentials, LoganBerry: LoganBerryStub EXPORTS VoiceRopeDB ~ BEGIN OPEN VoiceRopeDB; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; <> <> <<>> Open: PUBLIC PROC[dbName: Rope.ROPE] RETURNS [handle: Handle _ NIL, openEc: LoganBerry.ErrorCode _ NIL, expl: Rope.ROPE] = { ENABLE LoganBerry.Error => { openEc _ ec; expl _ explanation; CONTINUE; }; handle _ NEW[HandleRec _ [voiceRopeDBName: dbName.Concat[".df"], voiceInterestDBName: dbName.Concat["Refs.df"]]]; handle.voiceRopeDB _ LoganBerry.Open[dbName: handle.voiceRopeDBName]; <> }; Read: PUBLIC PROC [handle: Handle, ropeID: ID] RETURNS [header: Header, length: INT, struct: TuneList] ~ { <> header _ LoganBerry.ReadEntry[db: handle.voiceRopeDB, key: $VRID, value: ropeID].entry; [length, struct] _ EntryToTuneList[header]; }; <<>> Write: PUBLIC PROC [handle: Handle, struct: TuneList] RETURNS [ropeID: ID, length: INT] ~ { <> entry: LoganBerry.Entry; interval: Thrush.VoiceInterval; <> list: TuneList _ struct; length _ 0; UNTIL list = NIL DO [interval: interval, rest: list] _ NextTuneOnList[list]; length _ length + interval.length; ENDLOOP; ropeID _ GenerateUniqueID[]; entry _ struct; entry _ CONS[[$Length, Convert.RopeFromInt[length]], entry]; <> entry _ CONS[[$Creator, UserCredentials.Get[].name], entry]; entry _ CONS[[$VRID, ropeID], entry]; LoganBerry.WriteEntry[db: handle.voiceRopeDB, entry: entry ! LoganBerry.Error => IF ec = $ValueNotUnique THEN {ropeID _ BadUniqueID[]; entry.first.value _ ropeID; RETRY}]; }; <> <> SimpleTuneList: PUBLIC PROC [tune: Thrush.Tune, interval: Thrush.VoiceInterval, key: Thrush.EncryptionKey] RETURNS [list: TuneList] ~ { <> list _ LIST[[$TID, Convert.RopeFromInt[tune]], [$Key, MarshalKey[key]], [$SL, MarshalInterval[interval]]]; }; NextTuneOnList: PUBLIC PROC [list: TuneList] RETURNS [tune: Thrush.Tune, interval: Thrush.VoiceInterval, key: Thrush.EncryptionKey, rest: TuneList] ~ { <> tune _ Convert.IntFromRope[list.first.value]; key _ UnmarshalKey[list.rest.first.value]; interval _ UnmarshalInterval[list.rest.rest.first.value]; rest _ list.rest.rest.rest; }; EntryToTuneList: PROC [entry: LoganBerry.Entry] RETURNS [length: INT _ -1, struct: TuneList] ~ { <> IF entry = NIL THEN RETURN[struct: NIL]; UNTIL entry.first.type = $TID DO IF entry.first.type = $LENGTH THEN length _ Convert.IntFromRope[entry.first.value]; entry _ entry.rest; ENDLOOP; struct _ entry; }; <<>> TuneListInterval: PUBLIC PROC [list: TuneList, interval: Thrush.VoiceInterval] RETURNS [new: TuneList] ~ { <> tuneInterval: Thrush.VoiceInterval; -- the current tune's interval prevSamples: INT; -- number of samples in entry excluding the current tune interval samples: INT; -- number of samples in entry including the current tune interval intervalMustChange: BOOLEAN _ FALSE; prevSamples _ 0; tuneInterval _ UnmarshalInterval[list.rest.rest.first.value]; samples _ tuneInterval.length; UNTIL samples > interval.start DO prevSamples _ samples; list _ list.rest.rest.rest; IF list = NIL THEN RETURN[NIL]; tuneInterval _ UnmarshalInterval[list.rest.rest.first.value]; samples _ samples + tuneInterval.length; ENDLOOP; <> new _ list; IF prevSamples # interval.start THEN { -- don't want first part of existing interval tuneInterval.start _ tuneInterval.start + interval.start - prevSamples; tuneInterval.length _ tuneInterval.length - (interval.start - prevSamples); intervalMustChange _ TRUE; }; <> IF (interval.length # LAST[INT]) AND (samples >= interval.start + interval.length) THEN { -- interval contained within a single tune interval tuneInterval.length _ interval.length; list.rest.rest.rest _ NIL; -- truncate list since we have has much as we need intervalMustChange _ TRUE; }; IF intervalMustChange THEN new.rest.rest.first.value _ MarshalInterval[tuneInterval]; IF (interval.length = LAST[INT]) OR (samples >= interval.start + interval.length) THEN -- no need to go on RETURN[new]; UNTIL samples >= interval.start + interval.length DO prevSamples _ samples; list _ list.rest.rest.rest; IF list = NIL THEN RETURN[new]; tuneInterval _ UnmarshalInterval[list.rest.rest.first.value]; samples _ samples + tuneInterval.length; ENDLOOP; <> IF samples # interval.start + interval.length THEN { -- want only first part of tune interval list.rest.rest.first.value _ MarshalInterval[[start: tuneInterval.start, length: interval.start + interval.length - prevSamples]]; }; list.rest.rest.rest _ NIL; -- truncate list since we have has much as we need RETURN[new]; }; <<>> <> MarshalKey: PROC [key: Thrush.EncryptionKey] RETURNS [r: ROPE] ~ TRUSTED { cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE [LONG[@key]]; r _ IO.PutFR["%bB %bB", IO.card[cardKey[0]], IO.card[cardKey[1]]]; }; UnmarshalKey: PROC [r: ROPE] RETURNS [key: Thrush.EncryptionKey] ~ TRUSTED { cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL=LOOPHOLE[LONG[@key]]; keyStream: IO.STREAM _ IO.RIS[r]; cardKey[0] _ IO.GetCard[keyStream]; cardKey[1] _ IO.GetCard[keyStream]; }; MarshalInterval: PROC [interval: Thrush.VoiceInterval] RETURNS [r: ROPE] ~ INLINE { <> r _ IO.PutFR["%g %g", IO.int[interval.start], IO.int[interval.length]]; }; <<>> UnmarshalInterval: PROC [r: ROPE] RETURNS [interval: Thrush.VoiceInterval] ~ INLINE { <> s: IO.STREAM _ IO.RIS[r]; interval.start _ IO.GetInt[s]; interval.length _ IO.GetInt[s]; }; <<>> <> <> <<>> <> <<>> <> userName: ROPE; counter: INT; kicks: INT; -- for instrumentation purposes GenerateUniqueID: PROC [] RETURNS [id: ROPE] ~ { timestamp: INT _ MAX[counter, BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]]; id _ IO.PutFR["%g#%g", IO.rope[userName], IO.int[timestamp]]; counter _ counter + 1; }; BadUniqueID: PROC [] RETURNS [id: ROPE] ~ { <> counter _ BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]+1; -- kick the counter kicks _ kicks + 1; id _ GenerateUniqueID[]; }; NewUser: UserCredentials.CredentialsChangeProc ~ { userName _ UserCredentials.Get[].name; }; InitUniqueID: PROC [] RETURNS [] ~ { counter _ BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]; kicks _ 0; userName _ UserCredentials.Get[].name; UserCredentials.RegisterForChange[NewUser]; }; <> InitUniqueID[]; <<>> END. <<>> <> <> <> <> <> <<>> <<>> <<>> <<>>