<> <> <> <> <<>> <> <<>> <> <<>> DIRECTORY BasicTime USING [GMT, earliestGMT, Now, Period, Update], Convert USING [IntFromRope, RopeFromInt], FS USING [ComponentPositions, ExpandName], IO USING [card, GetCard, GetInt, int, PutFR, RIS, rope, STREAM], LoganBerry USING [AttributeType, AttributeValue, Cursor, DeleteEntry, EndGenerate, Entry, Error, GenerateEntries, NextEntry, Open, OpenDB, ReadEntry, WriteEntry], Rope USING [Concat, Equal, Find, Replace, ROPE, Substr], Thrush USING [EncryptionKey], UserCredentials USING [Get], VoiceRopeDB; VoiceRopeDBImpl: CEDAR PROGRAM -- Should this be a monitor? IMPORTS BasicTime, Convert, FS, IO, Rope, UserCredentials, LoganBerry EXPORTS VoiceRopeDB ~ BEGIN OPEN VoiceRopeDB; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; <> <> <<>> Error: PUBLIC ERROR [ec: ATOM, explanation: Rope.ROPE _ NIL] = CODE; <<>> Open: PUBLIC PROC[dbName: Rope.ROPE] RETURNS [handle: Handle _ NIL] = { <> <sLB.DF.>> <InterestsLB.DF.>> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; vrDB, interestDB: ROPE; cp: FS.ComponentPositions; IF dbName = NIL THEN RETURN[NIL]; [vrDB, cp] _ FS.ExpandName[dbName]; IF cp.ext.length = 0 THEN vrDB _ Rope.Concat[vrDB, ".df"]; interestDB _ Rope.Replace[base: vrDB, start: cp.base.start+cp.base.length-3, len: 0, with: "Interest"]; handle _ NEW[HandleRec _ [voiceRopeDBName: vrDB, voiceInterestDBName: interestDB]]; handle.voiceRopeDB _ LoganBerry.Open[dbName: handle.voiceRopeDBName]; handle.voiceInterestDB _ LoganBerry.Open[dbName: handle.voiceInterestDBName]; }; ReadVoiceRope: PUBLIC PROC [handle: Handle, ropeID: ID] RETURNS [header: Header, struct: TuneList] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; header _ LoganBerry.ReadEntry[db: handle.voiceRopeDB, key: $VRID, value: ropeID].entry; struct _ EntryToTuneList[header]; }; <<>> WriteVoiceRope: PUBLIC PROC [handle: Handle, vr: VoiceRopeInfo] RETURNS [info: VoiceRopeInfo] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; entry: LoganBerry.Entry; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; IF vr.creator = NIL THEN vr.creator _ UserCredentials.Get[].name; IF vr.vrID = NIL THEN vr.vrID _ GenerateUniqueID[vr.creator]; entry _ PackHeader[vr]; LoganBerry.WriteEntry[db: handle.voiceRopeDB, entry: entry ! LoganBerry.Error => IF ec = $ValueNotUnique THEN {vr.vrID _ ReplaceID[entry, vr.creator]; RETRY}]; RETURN[vr]; }; DeleteVoiceRope: PUBLIC PROC [handle: Handle, ropeID: ID] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; LoganBerry.DeleteEntry[db: handle.voiceRopeDB, key: $VRID, value: ropeID]; }; VoiceRopeContainingTune: PUBLIC PROC [handle: Handle, tune: INT] RETURNS [header: Header] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; header _ LoganBerry.ReadEntry[db: handle.voiceRopeDB, key: $TID, value: Convert.RopeFromInt[tune]].entry; }; EnumerateVoiceRopes: PUBLIC PROC [handle: Handle, start: ID _ NIL, proc: EnumProc] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; continue: BOOLEAN _ TRUE; entry: LoganBerry.Entry; info: VoiceRopeInfo; cursor: LoganBerry.Cursor; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; cursor _ LoganBerry.GenerateEntries[db: handle.voiceRopeDB, key: $VRID, start: start]; entry _ LoganBerry.NextEntry[cursor: cursor]; UNTIL entry = NIL OR NOT continue DO info _ UnpackHeader[entry]; continue _ proc[info]; entry _ LoganBerry.NextEntry[cursor: cursor]; ENDLOOP; LoganBerry.EndGenerate[cursor: cursor]; }; <> <> <<>> <> SimpleTuneList: PUBLIC PROC [tune: TuneID, start: INT, length: INT, key: Thrush.EncryptionKey] RETURNS [list: TuneList] ~ { <> list _ LIST[[$TID, Convert.RopeFromInt[tune]], [$Key, MarshalKey[key]], [$SL, MarshalInterval[start, length]]]; }; NextTuneOnList: PUBLIC PROC [list: TuneList] RETURNS [tune: TuneID, start: INT, length: INT, key: Thrush.EncryptionKey, rest: TuneList] ~ { <> IF list = NIL THEN Error[$BadTuneList, "NIL tune list"]; tune _ Convert.IntFromRope[list.first.value]; key _ UnmarshalKey[list.rest.first.value]; [start, length] _ UnmarshalInterval[list.rest.rest.first.value]; rest _ list.rest.rest.rest; }; EntryToTuneList: PROC [entry: LoganBerry.Entry] RETURNS [struct: TuneList] ~ { <> IF entry = NIL THEN RETURN[NIL]; UNTIL entry.first.type = $TID DO entry _ entry.rest; IF entry = NIL THEN Error[$BadTuneList, "No TID in entry"]; ENDLOOP; struct _ entry; }; <<>> TuneListInterval: PUBLIC PROC [list: TuneList, start: INT _ 0, length: INT _ -1] RETURNS [new: TuneList] ~ { <> tuneStart, tuneLength: INT; -- 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; IF list = NIL THEN RETURN[NIL]; IF length > (LAST[INT] - start) THEN -- start + length would cause an integer overflow length _ -1; -- essentially want the whole length prevSamples _ 0; [tuneStart, tuneLength] _ UnmarshalInterval[list.rest.rest.first.value]; IF tuneLength < 0 THEN ERROR Error[$UnspecifiedInterval, "Some tune interval has length=-1"]; samples _ tuneLength; UNTIL samples > start DO prevSamples _ samples; list _ list.rest.rest.rest; IF list = NIL THEN RETURN[NIL]; [tuneStart, tuneLength] _ UnmarshalInterval[list.rest.rest.first.value]; IF tuneLength < 0 THEN ERROR Error[$UnspecifiedInterval, "Some tune interval has length=-1"]; samples _ samples + tuneLength; ENDLOOP; <> new _ list; IF prevSamples # start THEN { -- don't want first part of existing interval tuneStart _ tuneStart + (start - prevSamples); tuneLength _ tuneLength - (start - prevSamples); intervalMustChange _ TRUE; }; IF (length >= 0) AND (samples >= start + length) THEN { -- interval contained within a single tune interval tuneLength _ length; new.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[tuneStart, tuneLength]; IF (length < 0) OR (samples >= start + length) THEN -- no need to go on RETURN[new]; UNTIL samples >= start + length DO prevSamples _ samples; list _ list.rest.rest.rest; IF list = NIL THEN RETURN[new]; [tuneStart, tuneLength] _ UnmarshalInterval[list.rest.rest.first.value]; IF tuneLength < 0 THEN ERROR Error[$UnspecifiedInterval, "Some tune interval has length=-1"]; samples _ samples + tuneLength; ENDLOOP; <> IF samples # start + length THEN { -- want only first part of tune interval list.rest.rest.first.value _ MarshalInterval[tuneStart, start + length - prevSamples]; }; list.rest.rest.rest _ NIL; -- truncate list since we have has much as we need RETURN[new]; }; PackHeader: PROC [info: VoiceRopeInfo] RETURNS [header: Header] ~ { entry: LoganBerry.Entry; entry _ info.struct; entry _ CONS[[$Length, Convert.RopeFromInt[info.length]], entry]; <> entry _ CONS[[$Creator, info.creator], entry]; entry _ CONS[[$VRID, info.vrID], entry]; RETURN[entry]; }; ReplaceID: PROC [header: Header, userName: ROPE] RETURNS [newID: ID] ~ { newID _ BadUniqueID[userName]; header.first.value _ newID; }; UnpackHeader: PUBLIC PROC [header: Header] RETURNS [info: VoiceRopeInfo] ~ { <> list: LoganBerry.Entry _ header; IF header = NIL THEN RETURN; info.vrID _ list.first.value; list _ list.rest; <> list _ list.rest; info.length _ Convert.IntFromRope[list.first.value]; [info.creator, info.timestamp] _ ParseUniqueID[info.vrID]; info.struct _ list.rest; }; <> AddInterest: PUBLIC PROC [handle: Handle, interest: InterestInfo] RETURNS [info: InterestInfo] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; entry: LoganBerry.Entry _ NIL; oldEntry: LoganBerry.Entry; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; IF interest.creator = NIL THEN interest.creator _ UserCredentials.Get[].name; oldEntry _ ReadInterest[handle, interest.vrID, interest.class, interest.refID]; interest.interestID _ IF oldEntry = NIL THEN GenerateUniqueID[interest.creator] ELSE oldEntry.first.value; entry _ PackInterest[interest]; LoganBerry.WriteEntry[db: handle.voiceInterestDB, entry: entry, replace: oldEntry # NIL ! LoganBerry.Error => IF ec = $ValueNotUnique AND oldEntry = NIL THEN {interest.interestID _ ReplaceInterestID[entry, interest.creator]; RETRY}]; RETURN[interest]; }; DropInterest: PUBLIC PROC [handle: Handle, interest: InterestInfo] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; entry: LoganBerry.Entry; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; entry _ ReadInterest[handle, interest.vrID, interest.class, interest.refID]; IF entry = NIL THEN RETURN; LoganBerry.DeleteEntry[db: handle.voiceInterestDB, key: $IID, value: entry.first.value]; }; ReadInterest: PROC [handle: Handle, ropeID: ID _ NIL, class: Rope.ROPE _ NIL, refID: Rope.ROPE] RETURNS [entry: LoganBerry.Entry] ~ { <> info: InterestInfo; cursor: LoganBerry.Cursor _ LoganBerry.GenerateEntries[db: handle.voiceInterestDB, key: $RefID, start: refID, end: refID]; entry _ LoganBerry.NextEntry[cursor: cursor]; UNTIL entry = NIL DO info _ UnpackInterest[entry]; IF (ropeID = NIL OR Rope.Equal[info.refID, refID]) AND (class = NIL OR Rope.Equal[info.class, class]) THEN EXIT; entry _ LoganBerry.NextEntry[cursor: cursor]; ENDLOOP; LoganBerry.EndGenerate[cursor: cursor]; }; InterestForRef: PUBLIC PROC [handle: Handle, class: Rope.ROPE, refID: Rope.ROPE] RETURNS [interest: Interest] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; interest _ ReadInterest[handle: handle, class: class, refID: refID]; }; InterestInVoiceRope: PUBLIC PROC [handle: Handle, ropeID: ID] RETURNS [interest: Interest] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; interest _ LoganBerry.ReadEntry[db: handle.voiceInterestDB, key: $VRID, value: ropeID].entry; }; EnumerateInterestClass: PUBLIC PROC [handle: Handle, class: Rope.ROPE, proc: InterestProc] ~ { <> ENABLE LoganBerry.Error => ERROR Error[ec, explanation]; continue: BOOLEAN _ TRUE; entry: LoganBerry.Entry; info: InterestInfo; cursor: LoganBerry.Cursor; IF handle = NIL THEN Error[$BadHandle, "NIL handle"]; IF proc = NIL THEN Error[$NoProc, "No procedure passed to EnumerateInterestClass"]; cursor _ LoganBerry.GenerateEntries[db: handle.voiceInterestDB, key: $Class, start: class, end: class]; entry _ LoganBerry.NextEntry[cursor: cursor]; UNTIL entry = NIL OR NOT continue DO info _ UnpackInterest[entry]; continue _ proc[info]; entry _ LoganBerry.NextEntry[cursor: cursor]; ENDLOOP; LoganBerry.EndGenerate[cursor: cursor]; }; PackInterest: PUBLIC PROC [info: InterestInfo] RETURNS [interest: Interest] ~ { interest _ NIL; IF info.data # NIL THEN interest _ CONS[[$Data, info.data], interest]; interest _ CONS[[$RefID, info.refID], interest]; interest _ CONS[[$Class, info.class], interest]; interest _ CONS[[$VRID, info.vrID], interest]; interest _ CONS[[$IID, info.interestID], interest]; }; ReplaceInterestID: PROC [interest: Interest, userName: ROPE] RETURNS [newID: ID] ~ { newID _ BadUniqueID[userName]; interest.first.value _ newID; }; UnpackInterest: PUBLIC PROC [interest: Interest] RETURNS [info: InterestInfo] ~ { list: LoganBerry.Entry _ interest; IF interest = NIL THEN RETURN; info.interestID _ list.first.value; list _ list.rest; info.vrID _ list.first.value; list _ list.rest; info.class _ list.first.value; list _ list.rest; info.refID _ list.first.value; list _ list.rest; IF list # NIL THEN info.data _ list.first.value; [info.creator, info.timestamp] _ ParseUniqueID[info.interestID]; }; <> 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 [start: INT, length: INT] RETURNS [r: ROPE] ~ INLINE { <> r _ IO.PutFR["%g %g", IO.int[start], IO.int[length]]; }; <<>> UnmarshalInterval: PROC [r: ROPE] RETURNS [start: INT, length: INT] ~ INLINE { <> s: IO.STREAM _ IO.RIS[r]; start _ IO.GetInt[s]; length _ IO.GetInt[s]; }; <<>> <> <> <<>> <> counter: INT; kicks: INT; -- for instrumentation purposes GenerateUniqueID: PROC [userName: ROPE] 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 [userName: ROPE] RETURNS [id: ROPE] ~ { <> counter _ BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]+1; -- kick the counter kicks _ kicks + 1; id _ GenerateUniqueID[userName]; }; ParseUniqueID: PROC [id: ROPE] RETURNS [creator: ROPE, timestamp: BasicTime.GMT] ~ { seconds: INT; i: INT _ Rope.Find[s1: id, s2: "#"]; creator _ Rope.Substr[base: id, start: 0, len: i]; seconds _ Convert.IntFromRope[Rope.Substr[base: id, start: i+1]]; timestamp _ BasicTime.Update[BasicTime.earliestGMT, seconds]; }; InitUniqueID: PROC [] RETURNS [] ~ { counter _ BasicTime.Period[BasicTime.earliestGMT, BasicTime.Now[]]; kicks _ 0; }; <> InitUniqueID[]; <<>> END. <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> < LoganBerry>> <> <<>>