<> <> <> DIRECTORY Atom USING [ MakeAtom ], BasicTime USING [ FromNSTime, GMT, Now, nullGMT, Period, ToNSTime, Update ], Commander USING [ CommandProc, Handle, Register ], CommandTool USING [ NextArgument ], Convert USING [ CardFromRope ], DESFace USING [ CorrectParity, EncryptBlock ], IO, GVNames USING [ AuthenticateKey, GetConnect, Outcome ], LoganBerry USING [ Error, Open, OpenDB, ReadEntry, WriteEntry ], NameDB USING [ AttributeSeq, Authenticity ], Process USING [ Detach ], RefID USING [ nullID ], RefTab USING [ Create, Fetch, Ref, Store ], Rope USING [ Equal, Find, Length, ROPE, SkipOver, Substr ], RPC USING [ Conversation, ConversationLevel, EncryptionKey, StartConversation, unencrypted ], UserProfile USING [ Token ], VoiceUtils USING [ CurrentRName, CurrentPasskey, NetAddress, NetAddressFromRope, nullNetAddress, RnameToRspec ] ; NameDBImpl: CEDAR MONITOR <> IMPORTS Atom, BasicTime, Commander, CommandTool, Convert, DESFace, GVNames, IO, LoganBerry, Process, RefTab, Rope, RPC, UserProfile, VoiceUtils EXPORTS NameDB = { <> <<>> ROPE: TYPE= Rope.ROPE; AttributeSeq: TYPE = NameDB.AttributeSeq; -- LoganBerry.Entry = LIST OF [$attribute, value] OpenDB: TYPE = LoganBerry.OpenDB; nullDB: OpenDB = RefID.nullID; Error: PUBLIC ERROR [ec: ATOM, explanation: Rope.ROPE _ NIL] = CODE; <> DBHandle: TYPE = RECORD [ -- In case there ever have to be instances dbPrefix: Rope.ROPE, conversation: RPC.Conversation_RPC.unencrypted, white: OpenDB_nullDB, -- Name/number database blue: OpenDB_nullDB, -- Name/Lark/Workstation/Preferences database red: OpenDB_nullDB -- GV cache database ]; dbHandle: DBHandle; -- There is but one instance now. minQueryInterval: INT _ 60; <> conversationLevel: RPC.ConversationLevel _ ECB; <> GetAttributes: PUBLIC PROC[rName: ROPE, key: ATOM_$rname, dbType: ATOM_$white] RETURNS [value: AttributeSeq_NIL] = { ENABLE LoganBerry.Error => Error[ec, explanation]; openDB: OpenDB = DBFromType[dbType]; IF openDB#nullDB THEN value _ LoganBerry.ReadEntry[conv: dbHandle.conversation, db: DBFromType[dbType].openDB, key: key, value: rName].entry; }; <<>> GetAttribute: PUBLIC PROC[ rName: ROPE, attribute: ATOM, default: ROPE_NIL, key: ATOM_$rname] RETURNS [value: ROPE_NIL] = { ENABLE LoganBerry.Error => Error[ec, explanation]; dbKType: ATOM; dbType: ATOM; openDB: OpenDB; attributes: AttributeSeq; <> [dbKType, , openDB] _ WhichDB[key]; IF dbKType#$noProbe THEN { attributes _ LoganBerry.ReadEntry[conv: dbHandle.conversation, db: openDB, key: key, value: rName].entry; rName _ FetchAttribute[attributes, $rname, NIL].value; IF rName=NIL THEN RETURN; }; <> [dbType, , openDB] _ WhichDB[attribute]; SELECT dbType FROM = $noProbe => RETURN[rName]; # dbKType => attributes _ LoganBerry.ReadEntry[conv: dbHandle.conversation, db: openDB, key: $rname, value: rName].entry; ENDCASE; <> value _ FetchAttribute[attributes, attribute, default].value; <> IF value.Equal["#"] THEN { value _ FetchAttribute[attributes, TAttr[attribute, "time"]].value; value _ FetchAttribute[attributes, TAttr[attribute, (IF value#NIL AND RelTime[value] > 0 THEN "timed" ELSE "untimed")], default].value; }; <> IF dbType#$red THEN RETURN; IF attributes=NIL THEN value _ DoGVUpdate[rName, attributes] ELSE ConsiderGVUpdate[rName, attributes]; }; SetAttribute: PUBLIC PROC[rName: ROPE, attribute: ATOM, value: ROPE] = { ENABLE LoganBerry.Error => Error[ec, explanation]; dbType: ATOM; openDB: OpenDB; attributes: AttributeSeq; wasTimed: BOOL_FALSE; IF value#NIL THEN SELECT attribute FROM $larkhost, $workstationhost => { <> oldRname: ROPE=GetAttribute[value, $rname, NIL, attribute]; IF oldRname#NIL THEN SetAttribute[rName: oldRname, attribute: attribute, value: NIL]; }; ENDCASE; [dbType, , openDB] _ WhichDB[attribute]; IF dbType=$noProbe THEN RETURN; <> IF attributes=NIL THEN attributes _ LIST[[$rname, rName]]; attributes _ GetAttributes[rName, $rname, dbType]; wasTimed _ Rope.Equal[FetchAttribute[attributes, attribute].value, "#"]; attributes _ StoreAttribute[attributes, attribute, value]; IF wasTimed THEN { -- Remove the timed values attributes _ StoreAttribute[attributes, TAttr[attribute, "timed"], NIL]; attributes _ StoreAttribute[attributes, TAttr[attribute, "untimed"], NIL]; attributes _ StoreAttribute[attributes, TAttr[attribute, "time"], NIL]; }; LoganBerry.WriteEntry[conv: dbHandle.conversation, db: openDB, entry: attributes, replace: TRUE]; }; SetAttributeTimed: PUBLIC PROC[ rName: Rope.ROPE, attribute: ATOM, value: Rope.ROPE, time: BasicTime.GMT_BasicTime.nullGMT, interval: INT_0] = { ENABLE LoganBerry.Error => Error[ec, explanation]; dbType: ATOM; keyClass: KeyClass; openDB: OpenDB; attributes: AttributeSeq; untimedValue: Rope.ROPE; wasUntimed: BOOL; IF time=BasicTime.nullGMT THEN time _ BasicTime.Update[BasicTime.Now[], interval]; [dbType, keyClass, openDB] _ WhichDB[attribute]; IF keyClass#$notKey THEN Error[$InvalidAttribute, "SetAttributeTimed cannot be applied to an attribute that is also a key"]; IF attributes=NIL THEN attributes _ LIST[[$rname, rName]]; attributes _ GetAttributes[rName, $rname, dbType]; untimedValue _ FetchAttribute[attributes, attribute].value; wasUntimed _ ~Rope.Equal[untimedValue, "#"]; IF wasUntimed AND untimedValue#NIL THEN attributes _ StoreAttribute[attributes, TAttr[attribute, "untimed"], untimedValue]; attributes _ StoreAttribute[attributes, TAttr[attribute, "timed"], value]; attributes _ StoreAttribute[attributes, TAttr[attribute, "time"], TimeRope[time]]; IF wasUntimed THEN attributes _ StoreAttribute[attributes, attribute, "#"]; LoganBerry.WriteEntry[conv: dbHandle.conversation, db: openDB, entry: attributes, replace: TRUE]; }; Authenticate: PUBLIC PROC[rName: ROPE, key: RPC.EncryptionKey] RETURNS [authenticity: NameDB.Authenticity] = { attributes: AttributeSeq _ GetAttributes[rName: rName, dbType: $red]; authRope: ROPE; IF attributes = NIL THEN attributes _ LIST[[$rname, rName]]; authRope _ FetchAttribute[attributes, $authenticity].value; authenticity _ IF authRope=NIL THEN NIL ELSE Atom.MakeAtom[authRope]; <> SELECT authenticity FROM NIL, $unknown, $perhaps, $bogus => authenticity _ DoGVAuthenticate[rName, key, attributes]; $nonexistent => NULL; $authentic => authenticity _ GVCheckKey[key, attributes].authenticity; ENDCASE => ERROR; ConsiderGVAuthenticate[rName, key, attributes]; <> }; IsAuthenticated: PUBLIC PROC[rName: ROPE] RETURNS [authenticity: NameDB.Authenticity _ $unknown] = { attributes: AttributeSeq _ GetAttributes[rName, $rname, $red]; IF attributes#NIL THEN authenticity _ Atom.MakeAtom[FetchAttribute[attributes, $authenticity, "perhaps"].value]; ConsiderGVUpdate[rName, attributes]; }; HostFromInstance: PUBLIC PROC[instance: Rope.ROPE] RETURNS [VoiceUtils.NetAddress_VoiceUtils.nullNetAddress] = { netAddressAsRope: ROPE = GetAttribute[instance, $connect]; IF netAddressAsRope#NIL THEN RETURN[VoiceUtils.NetAddressFromRope[netAddressAsRope]]; }; <<>> <> ConsiderGVUpdate: PROC[rName: ROPE, attributes: AttributeSeq] = { timeStamp: ROPE = FetchAttribute[attributes, TAttr[$connect, "timestamp"]].value; IF timeStamp#NIL AND (-RelTime[timeStamp]) < minQueryInterval THEN RETURN; TRUSTED { Process.Detach[FORK ForkGVUpdate[rName, attributes]]; }; }; ForkGVUpdate: PROC[rName: ROPE, attributes: AttributeSeq] = { ENABLE Error => CONTINUE; -- Should report it, I guess. [] _ DoGVUpdate[rName, attributes]; }; DoGVUpdate: PROC[rName: ROPE, attributes: AttributeSeq] RETURNS[value: ROPE_NIL] = { ENABLE LoganBerry.Error => Error[ec, explanation]; info: GVNames.Outcome_notFound; [info, value] _ GVNames.GetConnect[rName]; IF info#individual THEN RETURN[NIL]; -- Didn't happen. IF attributes=NIL THEN attributes _ LIST[[$rname, rName]]; IF value#NIL THEN attributes _ StoreAttribute[attributes, $connect, value]; attributes _ StoreAttribute[attributes, TAttr[$connect, "timestamp"], TimeRope[]]; LoganBerry.WriteEntry[conv: dbHandle.conversation, db: dbHandle.red, entry: attributes, replace: TRUE]; }; ConsiderGVAuthenticate: PROC[ rName: ROPE, key: RPC.EncryptionKey, attributes: AttributeSeq] = { timeStamp: ROPE = FetchAttribute[attributes, TAttr[$key, "timestamp"]].value; IF timeStamp#NIL AND (-RelTime[timeStamp]) < minQueryInterval THEN RETURN; TRUSTED { Process.Detach[FORK ForkGVAuthenticate[rName, key, attributes]]; }; }; ForkGVAuthenticate: PROC[rName:ROPE, key:RPC.EncryptionKey, attributes:AttributeSeq] = { ENABLE Error => CONTINUE; -- Should report it, I guess. [] _ DoGVAuthenticate[rName, key, attributes]; }; DoGVAuthenticate: PROC[rName: ROPE, key: RPC.EncryptionKey, attributes: AttributeSeq] RETURNS[authenticity: NameDB.Authenticity_$perhaps] = { ENABLE LoganBerry.Error => Error[ec, explanation]; SELECT GVNames.AuthenticateKey[rName, key] FROM group, notFound => authenticity _ $nonexistent; individual => authenticity _ $authentic; protocolError => Error[$GVNamesProtocolViolation, "GV Names protocol violation"]; wrongServer, allDown => authenticity _ $unknown; badPwd => authenticity _ $bogus; ENDCASE => Error[$GVNamesProtocolViolation, "Unknown return code"]; IF attributes=NIL THEN attributes _ LIST[[$rname, rName]]; attributes _ StoreAttribute[attributes, $authenticity, IO.PutR[[atom[authenticity]]]]; attributes _ StoreAttribute[attributes, $key, GVCheckKey[key, attributes].keyRope]; attributes _ StoreAttribute[attributes, TAttr[$key, "timestamp"], TimeRope[]]; LoganBerry.WriteEntry[conv: dbHandle.conversation, db: dbHandle.red, entry: attributes, replace: TRUE]; }; GVCheckKey: PROC[key: RPC.EncryptionKey, attributes: AttributeSeq] RETURNS[keyRope: ROPE, authenticity: NameDB.Authenticity _ $perhaps] = TRUSTED { encryptedKey: RPC.EncryptionKey; cpKey: RPC.EncryptionKey _ key; retrievedEncryptedKey: RPC.EncryptionKey; retrievedKeyRope: ROPE; rkrStream: IO.STREAM; halves: LONG POINTER TO RECORD[firstHalf: CARD, secondHalf: CARD] _ LOOPHOLE[LONG[@encryptedKey]]; DESFace.CorrectParity[LOOPHOLE[LONG[@cpKey]]]; DESFace.EncryptBlock[key: LOOPHOLE[cpKey], from: @key, to: LOOPHOLE[halves]]; keyRope _ IO.PutFR["%bB %bB", [cardinal[halves.firstHalf]], [cardinal[halves.secondHalf]]]; halves _ LOOPHOLE[LONG[@retrievedEncryptedKey]]; retrievedKeyRope _ FetchAttribute[attributes, $key].value; IF retrievedKeyRope=NIL THEN RETURN; rkrStream _ IO.RIS[retrievedKeyRope]; halves.firstHalf _ Convert.CardFromRope[IO.GetCedarTokenRope[rkrStream].token]; halves.secondHalf _ Convert.CardFromRope[IO.GetCedarTokenRope[rkrStream].token]; authenticity _ IF encryptedKey = retrievedEncryptedKey THEN $authentic ELSE $bogus; }; <> <<>> FetchAttribute: PROC[ attributes: AttributeSeq, attribute: ATOM, default: ROPE_NIL] RETURNS [value: ROPE, valueLoc: AttributeSeq_NIL] = { value _ default; FOR aL: AttributeSeq _ attributes, aL.rest WHILE aL#NIL DO IF aL.first.type = attribute THEN RETURN[aL.first.value, aL]; ENDLOOP; }; ExtractAttribute: PROC[ attributes: AttributeSeq, attribute: ATOM] RETURNS [newAttributes: AttributeSeq_NIL] = { IF attributes=NIL THEN RETURN; IF attributes.first.type=attribute THEN RETURN[attributes.rest]; newAttributes _ attributes; FOR aL: AttributeSeq _ attributes, aL.rest WHILE aL.rest#NIL DO IF aL.rest.first.type # attribute THEN LOOP; aL.rest _ aL.rest.rest; RETURN; ENDLOOP; }; StoreAttribute: PROC[attributes: AttributeSeq, attribute: ATOM, value: ROPE] RETURNS[newAttributes: AttributeSeq] = { oldLoc: AttributeSeq; IF value=NIL OR value.Length[]=value.SkipOver[skip: "\'015\'011"] THEN RETURN[ExtractAttribute[attributes, attribute]]; newAttributes _ attributes; oldLoc _ FetchAttribute[attributes, attribute].valueLoc; IF oldLoc#NIL THEN oldLoc.first _ [attribute, value] ELSE newAttributes _ Append[attributes, LIST[[attribute, value]]]; }; Append: PROC[ a1, a2: AttributeSeq] RETURNS [newAttributes: AttributeSeq] = { IF a2=NIL THEN RETURN[a1]; IF a1=NIL THEN RETURN[a2]; newAttributes _ a1; FOR aL: AttributeSeq _ a1, aL.rest WHILE aL#NIL DO IF aL.rest#NIL THEN LOOP; aL.rest _ a2; RETURN; ENDLOOP; ERROR; }; <<>> DBFromType: PROC[dbType: ATOM] RETURNS [openDB: OpenDB _ nullDB] = { IF dbHandle.white=nullDB THEN Open[]; RETURN[SELECT dbType FROM $white => dbHandle.white, $blue => dbHandle.blue, $red => dbHandle.red, ENDCASE => nullDB ]; }; WhichDB: PROC[keyType: ATOM] RETURNS [ dbType: ATOM_$blue, keyClass: KeyClass_$notKey, openDB: OpenDB _ nullDB] = { mer: MapEntry _ NARROW[dbMap.Fetch[keyType].val, MapEntry]; IF mer#NIL THEN { dbType _ mer.dbType; keyClass _ mer.keyClass; }; openDB _ DBFromType[dbType]; }; RelTime: PROC[ropeTime: ROPE] RETURNS [relativeToNow: INT] = { RETURN[BasicTime.Period[from: BasicTime.Now[], to: BasicTime.FromNSTime[Convert.CardFromRope[ropeTime]]]]; }; TimeRope: PROC [time: BasicTime.GMT _ BasicTime.nullGMT] RETURNS[nowRope: ROPE] = { IF time = BasicTime.nullGMT THEN time _ BasicTime.Now[]; RETURN[IO.PutFR["%bB", [cardinal[BasicTime.ToNSTime[time]]]]]; }; TAttr: PROC[attribute: ATOM, prefix: Rope.ROPE] RETURNS [tAttr: ATOM] = { RETURN[Atom.MakeAtom[IO.PutFR["%g.%g", [rope[prefix]], [atom[attribute]]]]]; }; Open: PROC = { ENABLE LoganBerry.Error => Error[ec, explanation]; prefixValue: IO.Value _ [rope[dbHandle.dbPrefix]]; index: INT _ Rope.Find[dbHandle.dbPrefix, "/", 0]; IF index#0 THEN index_ -1; IF dbHandle.conversation#RPC.unencrypted AND index#-1 THEN { <> instanceValue: ROPE = dbHandle.dbPrefix.Substr[start: 1, len: index-1]; dotIndex: INT = Rope.Find[dbHandle.dbPrefix, ".", 1]; IF dotIndex # -1 AND dotIndex < index THEN dbHandle.conversation _ RPC.StartConversation[ VoiceUtils.CurrentRName[], VoiceUtils.CurrentPasskey[], instanceValue, conversationLevel]; }; dbHandle.white _ LoganBerry.Open[ conv: dbHandle.conversation, dbName: IO.PutFR["%gWhitePages.df", prefixValue]]; dbHandle.blue _ LoganBerry.Open[ conv: dbHandle.conversation, dbName: IO.PutFR["%gBluePages.df", prefixValue]]; dbHandle.red _ LoganBerry.Open[ conv: dbHandle.conversation, dbName: IO.PutFR["%gRedPages.df", prefixValue]]; }; <> <<>> CmdDBOpen: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> dbHandle.dbPrefix _ CommandTool.NextArgument[cmd]; Open[]; }; CmdDBDetails: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> DoDetails[cmd, CommandTool.NextArgument[cmd]]; }; DoDetails: PROC[cmd: Commander.Handle, rName: ROPE] = { attributes: AttributeSeq _ LIST [[$rname, rName]]; moreAttributes: AttributeSeq _ GetAttributes[rName, $rname, $white]; IF moreAttributes#NIL THEN attributes _ Append[attributes, moreAttributes.rest]; moreAttributes _ GetAttributes[rName, $rname, $blue]; IF moreAttributes#NIL THEN attributes _ Append[attributes, moreAttributes.rest]; moreAttributes _ GetAttributes[rName, $rname, $red]; IF moreAttributes#NIL THEN attributes _ Append[attributes, moreAttributes.rest]; FOR attr: AttributeSeq _ attributes, attr.rest WHILE attr#NIL DO IO.PutF[cmd.out, "%g: %g\n", [atom[attr.first.type]], [rope[attr.first.value]]]; ENDLOOP; IO.PutChar[cmd.out, '\n]; }; CmdLarkDebug: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> larkNumber: ROPE _ CommandTool.NextArgument[cmd]; instance: ROPE _ CommandTool.NextArgument[cmd]; IF instance=NIL THEN instance _ UserProfile.Token[key: "LarktestInstance", default: "Einstein.lark"]; DoOperate[cmd, larkNumber, "D", instance]; }; CmdLarkOperate: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> larkNumber: ROPE _ CommandTool.NextArgument[cmd]; instance: ROPE _ CommandTool.NextArgument[cmd]; IF instance=NIL THEN instance _ UserProfile.Token[key: "ThrushClientServerInstance", default: "Strowger.lark"]; DoOperate[cmd, larkNumber, "O", instance]; }; DoOperate: PROC[cmd: Commander.Handle, larkNumber: ROPE, mode: ROPE, instance: ROPE] = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> rName: ROPE; IF larkNumber=NIL THEN RETURN; larkNumber _ IO.PutFR["173#%g#", [rope[larkNumber]]]; rName _ GetAttribute[larkNumber, $rname, NIL, $larkhost]; IF rName=NIL THEN RETURN; SetAttribute[rName, $mode, mode]; SetAttribute[rName, $instance, instance]; DoDetails[cmd, rName]; }; <<>> <> <<>> KeyClass: TYPE = { primary, secondary, notKey }; MapEntry: TYPE = REF MER; MER: TYPE = RECORD [ dbType: ATOM, keyClass: KeyClass_$notKey ]; dbMap: RefTab.Ref _ RefTab.Create[]; <> [] _ dbMap.Store[$rname, NEW[MER _ [$noProbe, $primary]]]; <> [] _ dbMap.Store[$name, NEW[MER _ [$white, $secondary]]]; [] _ dbMap.Store[$fnm, NEW[MER _ [$white, $secondary]]]; [] _ dbMap.Store[$rgnm, NEW[MER _ [$white, $secondary]]]; [] _ dbMap.Store[$fstnm, NEW[MER _ [$white, $secondary]]]; [] _ dbMap.Store[$officenumber, NEW[MER _ [$white]]]; [] _ dbMap.Store[$homenumber, NEW[MER _ [$white]]]; [] _ dbMap.Store[$officeaddress, NEW[MER _ [$white]]]; [] _ dbMap.Store[$homeaddress, NEW[MER _ [$white]]]; <> [] _ dbMap.Store[$larkhost, NEW[MER _ [$blue, $secondary]]]; [] _ dbMap.Store[$workstationhost, NEW[MER _ [$blue, $secondary]]]; [] _ dbMap.Store[$dotune, NEW[MER _ [$blue]]]; [] _ dbMap.Store[$instance, NEW[MER _ [$blue]]]; [] _ dbMap.Store[$interface, NEW[MER _ [$blue]]]; [] _ dbMap.Store[$mode, NEW[MER _ [$blue]]]; [] _ dbMap.Store[$multiring, NEW[MER _ [$blue]]]; [] _ dbMap.Store[$program, NEW[MER _ [$blue]]]; [] _ dbMap.Store[$ringmode, NEW[MER _ [$blue]]]; [] _ dbMap.Store[$ringtune, NEW[MER _ [$blue]]]; <> <> [] _ dbMap.Store[$connect, NEW[MER _ [$red]]]; [] _ dbMap.Store[$key, NEW[MER _ [$red]]]; [] _ dbMap.Store[$authenticity, NEW[MER _ [$red]]]; -- useful only for IsAuthenticated <> dbHandle.dbPrefix _ UserProfile.Token["ThrushClientServerInstance", "Strowger.Lark"]; dbHandle.dbPrefix _ IO.PutFR["/%g//%g/", [rope[dbHandle.dbPrefix]], [rope[VoiceUtils.RnameToRspec[dbHandle.dbPrefix].simpleName]]]; <> Commander.Register["NameDBOpen", CmdDBOpen, "Specify location of system databases. Usage: NameDBOpen Example: NameDBOpen /Strowger.lark//Strowger/ Example: NameDBOpen ///Users/self.pa/ (first example is the default)\n"]; Commander.Register["NameDBDetails", CmdDBDetails, "Print entire merged DB listing. Usage: NameDBDetails \n"]; Commander.Register["LarkDebug", CmdLarkDebug, "Tune Lark into development server, debug mode. Usage: LarkDebug [] Example: LarkDebug 110 (default instance is UserProfile.LarkTestInstance[]) Example: LarkDebug 110 Curie.lark\n"]; Commander.Register["LarkOperate", CmdLarkOperate, "Tune Lark into operational server, operational mode. Usage: LarkOperate [] Example: LarkOperate 110 (default instance is UserProfile.ThrushClientServerInstance[]) Example: LarkOperate 110 Curie.lark\n"]; }.