<<>> <> <> <> <> <> DIRECTORY Atom USING [ MakeAtom ], BasicTime USING [ FromNSTime, GMT, Now, nullGMT, Period, ToNSTime, Update ], Commander USING [ CommandProc, Handle, Register ], CommanderOps USING [ NextArgument ], Convert USING [ CardFromRope ], DESFace USING [ CorrectParity, EncryptBlock ], IO, LoganBerry USING [ AttributeType, AttributeValue, Close, DeleteEntry, Error, IsLocal, Open, OpenDB, ReadEntry, RegisterWriteProc, WriteEntry, WriteProc ], NameDB USING [ AttributeSeq, Authenticity ], NameDBBackDoor, Process USING [ Detach ], RefID USING [ nullID ], RefTab USING [ Create, Fetch, Ref, Store ], Rope USING [ Equal, Length, ROPE, SkipOver ], RPC USING [ EncryptionKey ], SymTab USING [ Create, Delete, Erase, Fetch, Ref, Store ], UserProfile USING [ Token ] ; NameDBImpl: CEDAR MONITOR <> IMPORTS Atom, BasicTime, Commander, CommanderOps, Convert, DESFace, IO, LoganBerry, Process, RefTab, Rope, SymTab, UserProfile EXPORTS NameDB, NameDBBackDoor = { <> <<>> ROPE: TYPE= Rope.ROPE; AttributeSeq: TYPE = NameDB.AttributeSeq; -- LoganBerry.Entry = LIST OF [$attribute, value] OpenDB: TYPE = REF OpenDBBody; nullDB: OpenDB = NIL; OpenDBBody: TYPE = RECORD [ db: LoganBerry.OpenDB¬RefID.nullID, dbCache: DBCache ¬ NIL, timeoutCache: BOOL¬TRUE, -- TRUE if should time out entries based on timeToLive timeToLive: INT ¬ 20 -- Seconds duration of NameDB cache entries. ]; Error: PUBLIC ERROR [ec: ATOM, explanation: Rope.ROPE ¬ NIL] = CODE; <> DBCache: TYPE = SymTab.Ref; DBHandle: TYPE = RECORD [ -- In case there ever have to be instances dbPrefix: Rope.ROPE, <> white: OpenDB¬nullDB, -- Name/number database blue: OpenDB¬nullDB, -- Name/Lark/Workstation/Preferences database red: OpenDB¬nullDB, -- GV cache database doCache: BOOL ¬ TRUE, whiteTTL: INT ¬ 60*60*4, -- 4 hours cache duration blueTTL: INT ¬ 20, -- short cache duration redTTL: INT ¬ 60*60 -- 1 hour cache duration ]; dbHandle: DBHandle; -- There is but one instance now. minQueryInterval: INT ¬ 60; <> <> <> GetAttributes: PUBLIC PROC[rName: ROPE, key: ATOM¬$rname, dbType: ATOM¬$white] RETURNS [value: AttributeSeq¬NIL] = { ENABLE { UNWIND => NULL; LoganBerry.Error => Error[ec, explanation]; }; RETURN[ReadEntry[db: DBFromType[dbType], key: key, value: rName].attributes]; }; <<>> GetAttribute: PUBLIC PROC[ rName: ROPE, attribute: ATOM, default: ROPE¬NIL, key: ATOM¬$rname] RETURNS [value: ROPE¬NIL] = { ENABLE { UNWIND => NULL; LoganBerry.Error => Error[ec, explanation]; }; dbKType: ATOM; dbType: ATOM; openDB: OpenDB; cached: BOOL¬FALSE; attributes: AttributeSeq; <> [dbKType, , openDB] ¬ WhichDB[key]; IF dbKType#$noProbe THEN { attributes ¬ ReadEntry[db: openDB, key: key, value: rName].attributes; rName ¬ FetchAttribute[attributes, $rname, NIL].value; IF rName=NIL THEN RETURN[default]; }; <> [dbType, , openDB] ¬ WhichDB[attribute]; SELECT dbType FROM $red => RETURN[GetGVAttribute[rName, attribute, default]]; $noProbe => RETURN[rName]; #dbKType => attributes ¬ ReadEntry[db: openDB, key: $rname, value: rName].attributes; 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; }; }; SetAttribute: PUBLIC PROC[rName: ROPE, attribute: ATOM, value: ROPE] = { ENABLE { UNWIND => NULL; LoganBerry.Error => Error[ec, explanation]; }; dbType: ATOM; openDB: OpenDB; attributes: AttributeSeq; previousValue: ROPE; 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; <> attributes ¬ ReadEntry[openDB, $rname, rName, FALSE].attributes; <> IF attributes=NIL THEN attributes ¬ LIST[[$rname, rName]]; previousValue ¬ FetchAttribute[attributes, attribute].value; IF previousValue.Equal[value] THEN RETURN; -- previous was untimed and equal attributes ¬ StoreAttribute[attributes, attribute, value]; IF previousValue.Equal["#"] 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[db: openDB.db, 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"]; attributes ¬ ReadEntry[openDB, $rname, rName, FALSE].attributes; -- No trust cache IF attributes=NIL THEN attributes ¬ LIST[[$rname, rName]]; 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[db: openDB.db, entry: attributes, replace: TRUE]; }; Authenticate: PUBLIC PROC[rName: ROPE, key: RPC.EncryptionKey] RETURNS [authenticity: NameDB.Authenticity¬$unknown] = { ENABLE { LoganBerry.Error => Error[ec, explanation]; Error => IF ec = $GVServersDown THEN CONTINUE; }; keyRope: ROPE ¬ GetGVAttribute[rName, $key, NIL, TRUE, key]; RETURN[SELECT TRUE FROM keyRope=NIL => $nonexistent, keyRope.Equal["?"] => $bogus, ENDCASE => $authentic ]; }; IsAuthenticated: PUBLIC PROC[rName: ROPE] RETURNS [authenticity: NameDB.Authenticity ¬ $unknown] = { ENABLE { LoganBerry.Error => Error[ec, explanation]; Error => IF ec = $GVServersDown THEN CONTINUE; }; key: ROPE ¬ GetGVAttribute[rName, $key, NIL]; RETURN[SELECT TRUE FROM key=NIL => $nonexistent, key.Equal["?"] => $perhaps, ENDCASE => $authentic ]; }; <> nullKey: RPC.EncryptionKey = ALL[0]; GetGVAttribute: PROC[ rName: ROPE, attribute: ATOM, default: ROPE, keySupplied: BOOL¬FALSE, encryptionKey: RPC.EncryptionKey¬nullKey] RETURNS[value: ROPE¬NIL] = { openDB: OpenDB ¬ DBFromType[$red]; attributes: AttributeSeq; cached: BOOL; [attributes, cached] ¬ ReadEntry[openDB, $rname, rName]; IF attributes=NIL OR (attribute=$key AND keySupplied AND ~FetchAttribute[attributes, $key, "?"].value.Equal[KeyRope[encryptionKey]]) THEN [attributes, cached] ¬ GetGVUpdate[rName, keySupplied, encryptionKey]; value ¬ FetchAttribute[attributes, attribute, default].value; IF ~cached THEN QueueGVUpdate[rName, keySupplied, encryptionKey]; }; GetGVUpdate: PROC[ rName: ROPE, keySupplied: BOOL¬FALSE, encryptionKey: RPC.EncryptionKey¬nullKey] RETURNS[attributes: AttributeSeq¬NIL, cached: BOOL¬FALSE] = { <> <> <> <> <> <> <<[info, connect] _ GVNames.GetConnect[rName];>> <> < IF connect=NIL OR connect.Length[]=0 THEN connect _ "?";>> < connect _ DeleteGVEntry[rName];>> < Error[$GVServersDown, "All GV servers down"];>> < Error[$GVNamesProtocolViolation, "GV Names protocol violation"];>> < Error[$GVNamesProtocolViolation, "Unknown return code"];>> <> <> <> < keyRope _ DeleteGVEntry[rName];>> < keyRope _ KeyRope[encryptionKey];>> < Error[$GVNamesProtocolViolation, "GV Names protocol violation"];>> < Error[$GVServersDown, "All GV servers down"];>> < keyRope _ "?";>> < Error[$GVNamesProtocolViolation, "Unknown return code"];>> <> <<};>> <> <<-- attributes _ ReadEntry[openDB, $rname, rName, FALSE].attributes;>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> }; DeleteGVEntry: PROC[rName: ROPE] RETURNS [nilRope: ROPE¬NIL] = { IF dbHandle.white=nullDB OR rName=NIL THEN RETURN; LoganBerry.DeleteEntry[db: DBFromType[$red].db, key: $rname, value: rName]; }; QueueGVUpdate: PROC[ rName: ROPE, keySupplied: BOOL¬FALSE, encryptionKey: RPC.EncryptionKey] = TRUSTED { Process.Detach[FORK ForkGVUpdate[rName, keySupplied, encryptionKey]]; }; ForkGVUpdate: PROC[rName: ROPE, keySupplied: BOOL¬FALSE, encryptionKey: RPC.EncryptionKey] = { ENABLE Error => CONTINUE; -- Should report it, I guess. [] ¬ GetGVUpdate[rName, keySupplied, encryptionKey]; }; KeyRope: PUBLIC -- to back door -- PROC[key: RPC.EncryptionKey] RETURNS[keyRope: ROPE] = TRUSTED { encryptedKey: RPC.EncryptionKey; cpKey: RPC.EncryptionKey ¬ key; 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]]]; }; <> <<>> ReadEntry: PROC[ db: OpenDB, key: LoganBerry.AttributeType, value: LoganBerry.AttributeValue, useCache: BOOL¬TRUE] RETURNS [attributes: AttributeSeq¬NIL, cached: BOOL¬FALSE] = { IF dbHandle.doCache AND useCache THEN IF key=$rname THEN attributes¬ReadCache[db, value]; IF attributes#NIL THEN RETURN[attributes, TRUE]; attributes ¬ LoganBerry.ReadEntry[db: db.db, key: key, value: value].entry; IF dbHandle.doCache AND attributes#NIL THEN IF useCache THEN RecordCache[db, attributes] ELSE DeleteFromCache[db, attributes]; }; FetchAttribute: PUBLIC -- to back door -- 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: PUBLIC -- to back door -- 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: PUBLIC -- to back door -- 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: PUBLIC -- to back door -- 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: PUBLIC -- to back door -- PROC[ropeTime: ROPE] RETURNS [relativeToNow: INT] = { RETURN[BasicTime.Period[from: BasicTime.Now[], to: BasicTime.FromNSTime[Convert.CardFromRope[ropeTime]]]]; }; TimeRope: PUBLIC -- to back door -- PROC [time: BasicTime.GMT ¬ BasicTime.nullGMT] RETURNS[nowRope: ROPE] = { IF time = BasicTime.nullGMT THEN time ¬ BasicTime.Now[]; RETURN[IO.PutFR1["%bB", [cardinal[BasicTime.ToNSTime[time]]]]]; }; TAttr: PUBLIC -- to back door -- PROC[attribute: ATOM, prefix: Rope.ROPE] RETURNS [tAttr: ATOM] = { RETURN[Atom.MakeAtom[IO.PutFR["%g.%g", [rope[prefix]], [atom[attribute]]]]]; }; Open: PROC[forceOpen: BOOL¬FALSE] = { ENABLE LoganBerry.Error => Error[ec, explanation]; prefixValue: IO.Value ¬ [rope[dbHandle.dbPrefix]]; IF forceOpen THEN { IF dbHandle.white#nullDB THEN LoganBerry.Close[db: dbHandle.white.db]; IF dbHandle.blue#nullDB THEN LoganBerry.Close[db: dbHandle.blue.db]; IF dbHandle.red#nullDB THEN LoganBerry.Close[db: dbHandle.red.db]; }; dbHandle.white ¬ LBOpen[IO.PutFR1["%gWhitePages.df", prefixValue], dbHandle.whiteTTL]; dbHandle.blue ¬ LBOpen[IO.PutFR1["%gBluePages.df", prefixValue], dbHandle.blueTTL]; dbHandle.red ¬ LBOpen[IO.PutFR1["%gRedPages.df", prefixValue], dbHandle.redTTL, TRUE]; }; LBOpen: PROC[dbName: ROPE, timeToLive: INT, alwaysTimeout: BOOL¬FALSE] RETURNS [ openDB: OpenDB] = { openDB ¬ NEW[OpenDBBody ¬ []]; openDB.dbCache ¬ SymTab.Create[case: FALSE]; openDB.db ¬ LoganBerry.Open[dbName: dbName]; LoganBerry.RegisterWriteProc[ proc: RecordWrite, db: openDB.db, ident: $nameDB, clientData: openDB]; openDB.timeoutCache ¬ alwaysTimeout OR ~LoganBerry.IsLocal[openDB.db]; openDB.timeToLive ¬ timeToLive; }; <> <<>> CacheEntry: TYPE = REF CacheEntryBody; CacheEntryBody: TYPE = RECORD [ attributes: AttributeSeq ¬ NIL, lastValid: BasicTime.GMT ¬ BasicTime.nullGMT ]; ReadCache: PROC[openDB: OpenDB, keyValue: LoganBerry.AttributeValue] RETURNS[attributes: AttributeSeq¬NIL] = { cacheEntry: CacheEntry; IF openDB=NIL OR ~dbHandle.doCache THEN RETURN; cacheEntry ¬ NARROW[SymTab.Fetch[openDB.dbCache, keyValue].val]; IF cacheEntry=NIL OR (openDB.timeoutCache AND BasicTime.Period[from: cacheEntry.lastValid, to: BasicTime.Now[]] > openDB.timeToLive) THEN RETURN; RETURN[cacheEntry.attributes]; }; RecordCache: PROC[openDB: OpenDB, attributes: AttributeSeq] = { cacheEntry: CacheEntry; rName: ROPE ¬ FetchAttribute[attributes, $rname, NIL].value; IF openDB=NIL OR rName = NIL THEN RETURN; cacheEntry ¬ NARROW[SymTab.Fetch[openDB.dbCache, rName].val]; IF cacheEntry = NIL THEN { cacheEntry ¬ NEW[CacheEntryBody ¬ []]; [] ¬ SymTab.Store[openDB.dbCache, rName, cacheEntry]; }; cacheEntry.attributes ¬ attributes; cacheEntry.lastValid ¬ BasicTime.Now[]; }; RecordWrite: -- INTERNAL -- LoganBerry.WriteProc = { <> DeleteFromCache[NARROW[clientData], entry]; }; DeleteFromCache: -- INTERNAL -- PROC[openDB: OpenDB, attributes: AttributeSeq] = { rName: ROPE; IF attributes=NIL OR openDB=NIL THEN RETURN; rName ¬ FetchAttribute[attributes, $rname, NIL].value; IF rName#NIL THEN []¬SymTab.Delete[openDB.dbCache, rName]; }; <> <<>> CmdDBOpen: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> arg: ROPE ¬ CommanderOps.NextArgument[cmd]; IF arg#NIL THEN dbHandle.dbPrefix ¬ arg; Open[TRUE]; }; CmdDBDetails: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> DoDetails[cmd, CommanderOps.NextArgument[cmd]]; }; DoDetails: PROC[cmd: Commander.Handle, rName: ROPE] = { DoSomeDetails[cmd, rName, $white, TRUE]; DoSomeDetails[cmd, rName, $blue]; DoSomeDetails[cmd, rName, $red]; IO.PutChar[cmd.out, '\n]; }; DoSomeDetails: PROC[ cmd: Commander.Handle, rName: ROPE, dbType: ATOM, includeRName: BOOL¬FALSE] = { attributes: AttributeSeq ¬ GetAttributes[rName, $rname, dbType]; IF attributes#NIL AND ~includeRName THEN attributes ¬ attributes.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; }; CmdLarkDebug: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> larkNumber: ROPE ¬ CommanderOps.NextArgument[cmd]; instance: ROPE ¬ CommanderOps.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 ¬ CommanderOps.NextArgument[cmd]; instance: ROPE ¬ CommanderOps.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.PutFR1["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]; }; CmdLarkOwner: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> larkNumber: ROPE ¬ CommanderOps.NextArgument[cmd]; newOwner: ROPE ¬ CommanderOps.NextArgument[cmd]; IF larkNumber=NIL OR newOwner=NIL THEN RETURN; larkNumber ¬ IO.PutFR1["173#%g#", [rope[larkNumber]]]; SetAttribute[newOwner, $larkhost, larkNumber]; DoDetails[cmd, newOwner]; }; CmdLarkDBGet: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> rName: ROPE ¬ CommanderOps.NextArgument[cmd]; attribute: ROPE ¬ CommanderOps.NextArgument[cmd]; value: ROPE; IF rName=NIL OR attribute=NIL THEN RETURN; value ¬ GetAttribute[rName, Atom.MakeAtom[attribute]]; IO.PutF[cmd.out, "Name: %g\n%g: %g\n\n", [rope[rName]], [rope[attribute]], [rope[value]]]; }; CmdLarkDBSet: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> rName: ROPE ¬ CommanderOps.NextArgument[cmd]; attribute: ROPE ¬ CommanderOps.NextArgument[cmd]; value: ROPE ¬ CommanderOps.NextArgument[cmd]; IF rName=NIL OR attribute=NIL THEN RETURN; SetAttribute[rName, Atom.MakeAtom[attribute], value]; DoDetails[cmd, rName]; }; CmdDBFlush: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> IF dbHandle.white#NIL THEN SymTab.Erase[dbHandle.white.dbCache]; IF dbHandle.blue#NIL THEN SymTab.Erase[dbHandle.blue.dbCache]; IF dbHandle.red#NIL THEN SymTab.Erase[dbHandle.red.dbCache]; }; CmdGVUpdate: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> rName: ROPE ¬ CommanderOps.NextArgument[cmd]; []¬DeleteGVEntry[rName]; 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["ThrushSunDBPrefix", "/Growler-SUN///Strowger/"]; <> Commander.Register["NameDBOpen", CmdDBOpen, "Specify location of system databases. Usage: NameDBOpen Example: NameDBOpen /Growler-SUN///Strowger/ 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"]; Commander.Register["LarkOwner", CmdLarkOwner, "Change assignment of Lark to user. Usage: LarkOwner Example: LarkOwner 155 Swinehart.pa\n"]; Commander.Register["NameDBSet", CmdLarkDBSet, "Change Name database attribute. Usage: NameDBSet Example: NameDBSet Swinehart.pa ringmode S\n"]; Commander.Register["NameDBGet", CmdLarkDBGet, "Query Name database attribute. Usage: NameDBGet Example: NameDBGet Swinehart.pa ringmode\n"]; Commander.Register["NameDBFlushCache", CmdDBFlush, "Flush local DB cache. Usage: NameDBFlushCache\n"]; Commander.Register["NameDBGVUpdate", CmdGVUpdate, "Restore GV values from Grapevine. Usage: NameDBGVUpdate Example: NameDBGVUpdate Curie.lark\n"]; }. <> <> <> <> <> <> <> <> <> <> <> <<>> <<>>