NamesGVImpl.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Last modified by Swinehart, October 24, 1985 4:36:45 pm PDT
Last Edited by: Pier, May 20, 1984 7:08:08 pm PDT
DIRECTORY
Atom USING [ GetPName, GetProp, PutProp ],
Basics USING [ Comparison ],
BasicTime USING [ GMT, Now, Period, Update ],
Commander USING [ CommandProc, Register ],
Convert USING [ RopeFromInt, IntFromRope ],
FS USING [ StreamOpen ],
GVNames USING [ AddForward, AuthenticateKey, CreateIndividual, Expand, ExpandInfo, GetConnect, Outcome, RemoveForward, RListHandle, SetConnect ],
IO,
MBQueue USING [ Action, Create, DequeueAction, Flush, Queue, QueueClientAction ],
NamesGV,
Process USING [ Detach --, Pause, SecondsToTicks-- ],
RefTab USING [ Create, EachPairAction, Fetch, GetSize, Pairs, Ref, Store ],
SymTab USING [ Create, EachPairAction, Fetch, Pairs, Ref, Store ],
Rope USING [ Cat, Concat, Find, Index, Length, ROPE, Substr ],
RPC USING [ EncryptionKey ],
VoiceUtils USING [ CurrentRName, CurrentPasskey, MakeAtom, Report ]
;
NamesGVImpl:
CEDAR
MONITOR
IMPORTS Atom, BasicTime, Commander, Convert, FS, GVNames, IO, MBQueue, Process, RefTab, SymTab, Rope, VoiceUtils
EXPORTS NamesGV = {
OPEN IO;
Data
ROPE: TYPE= Rope.ROPE;
larkRegistry: ROPE=".Lark";
Results: TYPE = {ok, notFound, error};
ModeNotFound: TYPE = { ok, create, error }; -- create not available
CacheBehavior: TYPE = { lookupAfter, lookupFirst, lookInCacheOnly };
Authenticity: TYPE = NamesGV.Authenticity; -- { unknown, authentic, bogus };
AttributeSeq: TYPE = NamesGV.AttributeSeq;
AttributeSeqRec: TYPE = NamesGV.AttributeSeqRec;
GVDetails: TYPE=REF GVDetailsR;
GVDetailsR:
TYPE=
RECORD [
rName: ROPE,
attributes: DetailsAttributes←NIL,
authenticity: Authenticity←unknown,
key: RPC.EncryptionKey←NULL,
valid: BOOL←FALSE,
canCreate: BOOL←FALSE, -- GetDetails can make one if it isn't there.
mustAuthenticate: BOOL←FALSE,
lastTimeValid: BasicTime.GMT,
recording: BOOL←FALSE, -- Attribute update is illegal while this is TRUE
dirty: BOOL←FALSE, -- Some attribute has been changed by the client
refreshMode: BOOL←FALSE, -- See Note, below
done: CONDITION
];
Note: There are two ways to store GV entries: in GV and in a local cache file. If the entry is not dirty, a cache-file version will look a lot like the GV version, and anyway, the GV version is preferred. But for cached dirty values the idea is that they should be believed first. Unfortunately, one eventually needs to know what GV thinks before one can properly update the GV entries. RefreshAllEntries sets the refreshMode bit. When the bit is set and the entry's dirty, the current GV entry is read, but only into the "formerValue" fields. Now an update operation can clear dirty and write the proper values. After fetching the former values, the refreshMode condition is cleared.
NB: When you're counting on this kind of thing, you're playing with fire. There are no interlocks to be sure all the reads are done before you do the write, and that sort of thing. Be sure to use Squawk mode, or do GVWaits, or something, to be sure things are adequately synchronized. DCS 10/7/84.
DetailsAttribute: TYPE = REF DetailsAttributeR;
DetailsAttributeR:
TYPE =
RECORD [
attributeValue: ROPE, -- NIL only when this attribute is being deleted.
formerValue: ROPE←NIL -- Non-NIL only when this attribute has changed.
];
DetailsCache: TYPE = SymTab.Ref;
DetailsAttributes: TYPE = RefTab.Ref;
cacheMod: CARDINAL ← 37;
squawking: BOOL ← FALSE;
queuesEmpty: BOOL←TRUE;
queuesEmptyCond: CONDITION;
gvCacheVersion: ATOM ← $V1;
cache: DetailsCache←NIL;
cacheQueue: MBQueue.Queue;
refreshCacheQueue: MBQueue.Queue;
useCurrentValue: ROPE = "Use Current Value, but replace former value, in StoreAttribute";
assumedValidInterval: INT ← 60; -- GV updates done elsewhere may take a minute, and two calls, to be noticed.
assumedValidIntervalAfterChange: INT ← 600; -- GV updates done elsewhere may take a minute, and two calls, to be noticed. GV updates done elsewhere after a change here may take up to ten minutes to get noticed unless you explicitly flush the local cache.
realOldTime: BasicTime.GMT ← ValidUntil[-1];
GV Procedures exported to VoiceUtils
GVGetAttribute:
PUBLIC
ENTRY
PROC[rName:
ROPE, attribute:
ATOM, default:
ROPE←
NIL]
RETURNS [value: ROPE] = {
ENABLE UNWIND => NULL;
details: GVDetails ← GetGVDetails[rName].details;
IF ~details.valid THEN RETURN[default];
IF attribute=$dirty THEN RETURN[IF details.dirty THEN "TRUE" ELSE NIL];
value ← FetchAttribute[details, attribute];
IF value=NIL THEN value�ult;
};
GVSetAttribute:
PUBLIC
ENTRY
PROC[rName:
ROPE, attribute:
ATOM, value:
ROPE] = {
ENABLE UNWIND => NULL;
details: GVDetails ← GetGVDetails[rName: rName, mode: create].details;
detailsAttribute: DetailsAttribute;
IF ~details.valid THEN RETURN;
IF (~details.dirty)
OR details.recording
THEN
UNTIL queuesEmpty DO WAIT queuesEmptyCond; ENDLOOP; -- GVWait
IF details.recording THEN ERROR; -- Sanity check
details.dirty ← TRUE;
IF details.attributes #
NIL
THEN
detailsAttribute ← NARROW[details.attributes.Fetch[key: attribute].val];
IF value#NIL AND value.Length[]=0 THEN value←NIL;
IF detailsAttribute = NIL THEN StoreAttribute[details, attribute, value, NIL]
ELSE detailsAttribute.attributeValue ← value;
};
GVIsAuthenticated:
PUBLIC
ENTRY
PROC[rName:
ROPE]
RETURNS [authenticity: Authenticity] = {
ENABLE UNWIND => NULL;
details: GVDetails ← GetGVDetails[rName].details;
RETURN[details.authenticity];
};
GVAuthenticate:
PUBLIC
ENTRY
PROC[rName:
ROPE, key:
RPC.EncryptionKey]
RETURNS [authenticity: Authenticity] = {
ENABLE UNWIND => NULL;
details: GVDetails ← GetGVDetails[rName: rName, mode: error, key: key, authenticate: TRUE].details;
RETURN[details.authenticity];
};
GVGetAttributeSeq:
PUBLIC
PROC [rName:
ROPE, attribute:
ATOM]
RETURNS [value: AttributeSeq] = {
attributeValue: ROPE ← GVGetAttribute[rName, attribute];
index: INT𡤀
IF attributeValue = NIL THEN RETURN[NIL];
value ← NEW[AttributeSeqRec[10]];
WHILE index < attributeValue.Length[]
DO
newIndex: INT ← attributeValue.Index[pos1: index, s2: ", "];
value[value.length].attributeValue ← attributeValue.Substr[index, newIndex-index];
value.length ← value.length+1;
index ← newIndex+2;
ENDLOOP;
};
GVSetAttributeSeq:
PUBLIC
PROC[rName:
ROPE, attribute:
ATOM, value: AttributeSeq] = {
attVal: ROPE←NIL;
FOR i:
INT
IN [0..value.length)
DO
attVal ← Rope.Cat[attVal, value[i].attributeValue, ", "]; ENDLOOP;
IF attVal#NIL THEN attVal ← attVal.Substr[len: attVal.Length[]-2];
GVSetAttribute[rName, attribute, attVal];
};
GVGetAttributes:
PUBLIC
ENTRY
PROC[rName:
ROPE]
RETURNS [value: AttributeSeq←
NIL] = {
ENABLE UNWIND => NULL;
details: GVDetails ← GetGVDetails[rName: rName, mode: create].details;
len: CARDINAL;
i: CARDINAL𡤀
GetEachAttribute: RefTab.EachPairAction = {
quit←FALSE;
value[i] ← [NARROW[key], NARROW[val, DetailsAttribute].attributeValue];
i←i+1;
};
IF ~details.valid THEN RETURN;
IF details.attributes#NIL THEN len ← details.attributes.GetSize[];
IF details.dirty THEN len←len+1;
IF len=0 THEN RETURN;
value ← NEW[AttributeSeqRec[len]];
value.length ← len;
[]�tails.attributes.Pairs[GetEachAttribute];
IF details.dirty THEN value[len-1] ← [$dirty, "TRUE"];
};
GVWait:
PUBLIC
ENTRY PROC = {
ENABLE UNWIND => NULL;
UNTIL queuesEmpty DO WAIT queuesEmptyCond; ENDLOOP;
};
GVUpdate:
PUBLIC
ENTRY
PROC[rName:
ROPE] = {
ENABLE UNWIND => NULL;
SetGVDetails[GetGVDetails[rName, error].details];
};
GVUpdateAll:
PUBLIC
ENTRY
PROC = {
ENABLE UNWIND => NULL;
UpdateEachRName:
INTERNAL SymTab.EachPairAction = {
details: GVDetails ← NARROW[val];
IF details.dirty
AND ~details.recording
THEN
QueueAction[refreshCacheQueue, SetNewDetails, details];
quit←FALSE;
};
[]←SymTab.Pairs[cache, UpdateEachRName];
};
GVFlushCache:
PUBLIC
ENTRY
PROC = {
ENABLE UNWIND => NULL;
GetGVCache[TRUE]; -- Old one fades into oblivion
};
GVSaveCache: PUBLIC ENTRY PROC = {
The following nonsense truncates the log file before beginning to write.
ENABLE UNWIND => NULL;
s: IO.STREAM;
SaveEachRName:
INTERNAL SymTab.EachPairAction = {
details: GVDetails ← NARROW[val];
SaveEachAttribute: RefTab.EachPairAction = {
attributeName: ATOM ← NARROW[key];
detailsAttribute: DetailsAttribute ← NARROW[val];
quit←FALSE;
IF detailsAttribute.attributeValue=
NIL
OR detailsAttribute.attributeValue.Length[]=0
THEN RETURN;
s.PutF["%s: %s\n",
rope[Atom.GetPName[attributeName]], rope[detailsAttribute.attributeValue]];
};
quit←FALSE;
IF details.recording
THEN
UNTIL queuesEmpty DO WAIT queuesEmptyCond; ENDLOOP; -- GVWait
IF ~details.valid OR details.authenticity=bogus THEN RETURN;
s.PutF["rname: %s\n", rope[details.rName]];
IF details.authenticity = authentic
THEN
TRUSTED {
key: RPC.EncryptionKey ← details.key;
cardKey: LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL = LOOPHOLE[LONG[@key]];
s.PutF["key: %bB %bB\n", card[cardKey[0]], card[cardKey[1]]];
};
IF details.attributes#NIL THEN []�tails.attributes.Pairs[SaveEachAttribute];
IF details.dirty THEN s.PutRope["dirty: TRUE\n"];
s.PutChar['\n];
};
GetGVCache[FALSE];
s ← FS.StreamOpen["GVCacheLog.txt", $create];
IF s=NIL THEN { VoiceUtils.Report["GV:** Couldn't create GVCacheLog.txt", $System]; RETURN; };
[]�he.Pairs[SaveEachRName];
s.Close[];
};
GVRestoreCache:
PUBLIC
ENTRY
PROC = {
ENABLE UNWIND => NULL;
s: IO.STREAM;
GetGVCache[FALSE];
s ← FS.StreamOpen["GVCacheLog.txt"];
IF s=NIL THEN { VoiceUtils.Report["GV:** Couldn't find GVCacheLog.txt", $System]; RETURN; };
GetGVCache[TRUE]; -- Old one fades into oblivion
WHILE ~s.EndOf[] DO RestoreEntry[s]; ENDLOOP;
s.Close[];
};
RestoreEntry:
SAFE
PROC[logStream:
IO.
STREAM] = {
details: GVDetails;
DO
line: ROPE←ReadLine[logStream];
key: ATOM;
val: ROPE;
IF line=NIL OR line.Length[]=0 THEN RETURN;
[key, val] ← ParseAttribute[line];
SELECT key
FROM
$rname => {
IF details#NIL THEN ERROR;
details ←
NEW[GVDetailsR←[
rName: val, lastTimeValid: realOldTime, valid: TRUE, authenticity: perhaps]];
[]�he.Store[key: val, val: details];
};
$key =>
TRUSTED {
keyStream: IO.STREAM ← IO.RIS[val];
key: RPC.EncryptionKey;
cardKey:LONG POINTER TO ARRAY[0..2) OF LONG CARDINAL = LOOPHOLE[LONG[@key]];
cardKey[0] ← IO.GetCard[keyStream];
cardKey[1] ← IO.GetCard[keyStream];
IF details=NIL THEN ERROR;
details.key ← key;
IO.Close[keyStream];
details.mustAuthenticate ← TRUE; details.authenticity ← authentic;
};
$dirty =>
TRUSTED {
IF details=NIL THEN ERROR;
details.dirty ← TRUE; -- inhibits GV refreshes!!!
};
NIL => ERROR; -- Didn't find a key!
ENDCASE => {
IF details=NIL THEN ERROR;
StoreAttribute[details, key, val, NIL];
};
ENDLOOP;
};
GV Utilities
GetGVDetails:
INTERNAL
PROC[rName:
ROPE, mode: ModeNotFound←ok, behavior: CacheBehavior←lookupAfter, authenticate:
BOOL←
FALSE, key:
RPC.EncryptionKey←
NULL]
RETURNS [results: Results←ok, details: GVDetails←
NIL] =
TRUSTED {
GetGVCache[FALSE];
details ← NARROW[cache.Fetch[rName].val];
IF details=
NIL
THEN
IF behavior=lookInCacheOnly THEN RETURN[notFound, NIL]
ELSE []�he.Store[rName, details ←
NEW[GVDetailsR←[rName: rName, lastTimeValid: realOldTime]]];
details.mustAuthenticate ← details.mustAuthenticate OR authenticate;
IF authenticate THEN details.key ← key;
details.canCreate ← ~details.valid AND mode=create;
SELECT behavior
FROM
lookupFirst => {
QueueAction[cacheQueue, LookupDetails, details];
WAIT details.done;
};
lookupAfter => {
dontKnow:
BOOL = ~details.valid
OR (details.mustAuthenticate
AND
(SELECT details.authenticity FROM unknown, perhaps=>TRUE, ENDCASE=>FALSE));
IF (details.mustAuthenticate
AND dontKnow)
OR
GMTComp[BasicTime.Now[], details.lastTimeValid]=greater
THEN {
DontKnow: cached copy doesn't exist, is incorrect, or is incomplete.
details.lastTimeValid ← ValidUntil[assumedValidInterval];
At most one refresh try per interval
QueueAction[
(IF dontKnow THEN cacheQueue ELSE refreshCacheQueue), LookupDetails, details];
IF dontKnow THEN WAIT details.done;
};
};
ENDCASE;
details.canCreate ← FALSE;
IF ~details.valid
THEN
RETURN[
IF mode=ok THEN notFound ELSE Report[notFound, notFound, details], details];
IF squawking THEN VoiceUtils.Report[IO.PutFR["GV: Found %g", rope[rName]], $System];
};
SetGVDetails:
INTERNAL PROC[details: GVDetails] = {
GetGVCache[FALSE];
IF details=NIL OR details.dirty = FALSE THEN RETURN;
details.lastTimeValid ← ValidUntil[assumedValidIntervalAfterChange];
details.recording ← TRUE;
QueueAction[refreshCacheQueue, SetNewDetails, details];
IF squawking THEN VoiceUtils.Report[IO.PutFR["GV: Modified %g", rope[details.rName]], $System];
};
Queued GV Utilities
LookupDetails:
SAFE
PROC[reallyDetails:
REF
ANY] =
TRUSTED {
details: GVDetails ← NARROW[reallyDetails];
authenticity: Authenticity�tails.authenticity;
rName: ROPE = details.rName;
connect: ROPE;
expandInfo: GVNames.ExpandInfo ← [notFound []];
info, aInfo: GVNames.Outcome←notFound;
entries: GVNames.RListHandle←NIL;
valid: BOOL←FALSE;
RecordDetails:
ENTRY
PROC =
CHECKED INLINE {
details.rName ← rName;
details.valid ← valid;
details.lastTimeValid ← ValidUntil[
IF details.canCreate AND details.valid THEN assumedValidIntervalAfterChange
ELSE assumedValidInterval];
details.authenticity ← authenticity;
details.canCreate ← FALSE;
ParseDetails[details, entries];
details.refreshMode ← FALSE;
NOTIFY details.done;
};
IF details.dirty
AND ~details.refreshMode
THEN {
IF squawking THEN VoiceUtils.Report[IO.PutFR["GV:---Not seeking %g (dirty)", rope[rName]], $System];
RETURN;
};
IF squawking THEN VoiceUtils.Report[IO.PutFR["GV:---Seeking %g", rope[rName]], $System];
[info, connect] ← GVNames.GetConnect[rName];
valid ← info=individual;
IF ~valid
THEN
IF info=notFound THEN { info ← DoCreate[details, "MFLFLX"]; valid ← info=individual; }
ELSE []←Report[info, error, details]
ELSE {
expandInfo ← GVNames.Expand[rName];
WITH expandInfo
SELECT FROM
group => entries←members;
noChange, individual => NULL;
ENDCASE => []←Report[type, error, details];
};
IF connect#
NIL
THEN {
connect ← Rope.Concat["connect: ", connect];
IF entries=NIL THEN entries ← LIST[ connect ]
ELSE entries ← CONS[connect, entries];
};
IF valid
AND (
SELECT details.authenticity
FROM
bogus, authentic, nonexistent => FALSE, unknown, perhaps =>TRUE, ENDCASE=>ERROR)
THEN
IF details.mustAuthenticate
THEN {
IF squawking
THEN
VoiceUtils.Report[IO.PutFR["GV:---Authenticating %g", rope[rName]], $System];
SELECT (aInfo←GVNames.AuthenticateKey[rName, details.key])
FROM
badPwd => authenticity𡤋ogus;
individual => authenticity𡤊uthentic;
ENDCASE => []←Report[aInfo, error, details];
}
ELSE authenticity ← perhaps;
IF info=notFound THEN authenticity ← nonexistent;
RecordDetails[];
IF squawking THEN VoiceUtils.Report[IO.PutFR["GV:---End %g", rope[rName]], $System];
};
SetNewDetails:
SAFE
PROC[reallyDetails:
REF
ANY] =
TRUSTED {
details: GVDetails ← NARROW[reallyDetails];
outcome: GVNames.Outcome;
somethingStillDirty: BOOL←FALSE;
EachAttribute: RefTab.EachPairAction =
TRUSTED {
attribute: DetailsAttribute ← NARROW[val];
attributeName: ATOM ← NARROW[key];
quit←FALSE;
IF attribute.attributeValue=attribute.formerValue THEN RETURN;
Special case: connect attribute is really RName's connect field.
IF attributeName=$connect
THEN {
outcome ← GVNames.SetConnect[
user: VoiceUtils.CurrentRName[], password: VoiceUtils.CurrentPasskey[],
individual: details.rName, connect: attribute.attributeValue];
SELECT outcome
FROM
noChange, individual => attribute.formerValue ← attribute.attributeValue;
ENDCASE=> {
[]←Report[outcome, error, details, TRUE];
somethingStillDirty ← TRUE;
RETURN; };
};
IF attribute.formerValue #
NIL
AND attribute.formerValue.Length[]#0
THEN {
oldFwd: ROPE← Atom.GetPName[attributeName].Cat[": ", attribute.formerValue];
outcome ← GVNames.RemoveForward[
user: VoiceUtils.CurrentRName[], password: VoiceUtils.CurrentPasskey[],
individual: details.rName, dest: oldFwd];
SELECT outcome
FROM
noChange, individual => attribute.formerValue ← NIL;
ENDCASE=> {
[]←Report[outcome, error, details, TRUE];
somethingStillDirty ← TRUE;
RETURN; };
};
IF attribute.attributeValue #
NIL
AND attribute.attributeValue.Length[]#0
THEN {
newFwd: ROPE← Atom.GetPName[NARROW[key]].Cat[": ", attribute.attributeValue];
outcome ← GVNames.AddForward[
user: VoiceUtils.CurrentRName[], password: VoiceUtils.CurrentPasskey[],
individual: details.rName, dest: newFwd];
SELECT outcome
FROM
noChange, individual => attribute.formerValue ← attribute.attributeValue;
ENDCASE=> {
[]←Report[outcome, error, details, TRUE];
somethingStillDirty ← TRUE;
RETURN; };
};
};
{
ENABLE UNWIND => details.recording ← FALSE;
IF squawking
THEN
VoiceUtils.Report[IO.PutFR["GV:---Change attributes for %g", rope[details.rName]], $System];
IF details.attributes # NIL THEN []←RefTab.Pairs[details.attributes, EachAttribute];
details.recording ← FALSE;
details.dirty ← somethingStillDirty;
IF squawking THEN VoiceUtils.Report["GV:---End update", $System];
};
};
DoCreate:
PROC[details: GVDetails, password:
ROPE]
RETURNS [info: GVNames.Outcome] =
TRUSTED {
IF ~details.canCreate THEN RETURN[notFound];
IF squawking
THEN
VoiceUtils.Report[IO.PutFR["GV:---Creating %g", rope[details.rName]], $System];
info ← GVNames.CreateIndividual[
user: VoiceUtils.CurrentRName[], password: VoiceUtils.CurrentPasskey[],
individual: details.rName, newPwd: VoiceUtils.CurrentPasskey[password]];
SELECT info
FROM
individual => NULL;
ENDCASE => []←Report[info, error];
};
ParseDetails:
INTERNAL
PROC[details: GVDetails, entries: GVNames.RListHandle] = {
attributeTable: RefTab.Ref←NIL;
IF ~details.refreshMode THEN details.attributes←NIL;
IF ~details.valid THEN RETURN;
FOR e: GVNames.RListHandle ← entries, e.rest
WHILE e#
NIL
DO
key: ATOM;
val: ROPE;
[key, val] ← ParseAttribute[e.first];
IF key=NIL THEN LOOP; -- Not the right syntax for an entry
StoreAttribute[details, key, IF details.refreshMode THEN useCurrentValue ELSE val, val];
ENDLOOP;
};
ParseAttribute:
PROC[attributeSpec:
ROPE]
RETURNS [key:
ATOM←
NIL, val:
ROPE←
NIL] = {
index: INT ← attributeSpec.Find[": "];
IF index<0 THEN RETURN; -- Not the right syntax for an entry
key ← VoiceUtils.MakeAtom[rName: attributeSpec.Substr[start: 0, len: index], case: FALSE];
val ← attributeSpec.Substr[start: index+2];
};
StoreAttribute:
PROC[details: GVDetails, key:
ATOM, val:
ROPE, oldVal:
ROPE] = {
val=useCurrentValue: update only oldVal field, unless there's no current attribute.
detailsAttribute: DetailsAttribute;
IF val=useCurrentValue THEN val ← FetchAttribute[details, key];
detailsAttribute ← NEW[DetailsAttributeR ← [val, oldVal]];
IF details.attributes = NIL THEN details.attributes ← RefTab.Create[];
[] ← details.attributes.Store[key: key, val: detailsAttribute];
};
FetchAttribute:
PROC[details: GVDetails, key:
ATOM]
RETURNS [attributeValue:
ROPE] = {
detailsAttribute: DetailsAttribute;
IF details.attributes=NIL THEN RETURN[NIL];
detailsAttribute ← NARROW[details.attributes.Fetch[key: key].val];
RETURN[IF detailsAttribute # NIL THEN detailsAttribute.attributeValue ELSE NIL];
};
GV Utilities Utilities
QueueAction:
INTERNAL PROC [q: MBQueue.Queue, proc:
PROC [
REF
ANY], data:
REF
ANY] = {
queuesEmpty←FALSE;
MBQueue.QueueClientAction[q, proc, data];
IF q=cacheQueue THEN MBQueue.QueueClientAction[refreshCacheQueue, Arise, NIL];
};
Arise: SAFE PROC [whatever: REF] = { NULL };
MBQueueEmpty:
ENTRY
PROC[q: MBQueue.Queue, notifyIfEmpty:
BOOL←
FALSE]
RETURNS [empty: BOOL] = TRUSTED {
SomethingThatLooksLikeAnMBQueue:
TYPE =
RECORD [
lock: CARDINAL, -- something that looks like a lock.
firstEvent: LIST OF MBQueue.Action,
otherStuff: CARDINAL -- and so on, but who cares?
];
qp: LONG POINTER TO SomethingThatLooksLikeAnMBQueue = LOOPHOLE[q];
empty ← qp.firstEvent=NIL;
IF ~empty OR ~notifyIfEmpty THEN RETURN;
queuesEmpty←TRUE;
NOTIFY queuesEmptyCond;
};
Action: TYPE = MBQueue.Action;
Notifier:
PROC [] = {
Derived from MBQueueImpl.Notifier; runs all the time.
Exhaust cacheQueue before considering entries on refreshCacheQueue.
When cacheQueue operations are queued, dummy refresh operations are, too, to wake us up.
DO
ENABLE
ABORTED => {
MBQueue.Flush[cacheQueue]; MBQueue.Flush[refreshCacheQueue]; LOOP; };
UNTIL MBQueueEmpty[cacheQueue]
DO
WITH MBQueue.DequeueAction[cacheQueue]
SELECT
FROM
e2: Action.client => { queuesEmpty←FALSE; e2.proc[e2.data]; };
ENDCASE => ERROR;
ENDLOOP;
[] ← MBQueueEmpty[refreshCacheQueue, TRUE]; -- if TRUE, about to wait
WITH MBQueue.DequeueAction[refreshCacheQueue]
SELECT
FROM
e2: Action.client => { queuesEmpty←FALSE; e2.proc[e2.data]; };
ENDCASE => ERROR;
ENDLOOP;
};
SemiTok: IO.BreakProc = TRUSTED {RETURN[IF char='; THEN break ELSE other]; };
CommaTok: IO.BreakProc = TRUSTED {RETURN[IF char=', THEN break ELSE other]; };
Report:
PROC[outcome: GVNames.Outcome, r: Results, details: GVDetails←
NIL, timeout:
BOOL←
FALSE]
timeout=TRUE means that next attempt to fetch info about this RName consult Grapevine right away
RETURNS[rr: Results] = {
rName: ROPE←NIL;
rr←r;
IF details#
NIL
THEN {
details.valid←FALSE; rName�tails.rName;
IF timeout THEN details.lastTimeValid ← realOldTime; -- next query will go to GV fer sherr
};
VoiceUtils.Report[IO.PutFR["GV: **%s %s\n", rope[rName], rope[
SELECT outcome
FROM
noChange => "no change",
group => "group",
individual => "individual",
notFound => "not found",
protocolError => "protocol error",
wrongServer => "wrong server",
allDown => "all servers down",
badPwd => "bad password",
outOfDate => "out of date",
notAllowed => "not allowed",
ENDCASE => "??"]], $System]; };
ValidUntil:
PROC[interval:
INT]
RETURNS [BasicTime.GMT] = {
RETURN[BasicTime.Update[BasicTime.Now[], interval]];
};
GMTComp:
PUBLIC
PROC[t1, t2: BasicTime.
GMT]
RETURNS [c: Basics.Comparison] = {
period: INT = BasicTime.Period[t2, t1];
RETURN[IF period>0 THEN greater ELSE IF period=0 THEN equal ELSE less];
};
GetGVCache:
INTERNAL PROC[new:
BOOL←
FALSE] = {
All copies of the same version of VoiceUtils on same machine get the same cache!!
Different versions jockey for position among the gvCacheVersion entries.
A cache is a SymTab.Ref, which is opaque, which means that a REF ANY containing one can't be narrowed, so it's stored inside another REF. Sigh.
cRef: REF DetailsCache ← NIL;
cache←NIL;
DO
ref: REF ← Atom.GetProp[$GVCache, gvCacheVersion];
IF ref=NIL THEN EXIT;
WITH ref
SELECT
FROM
cRef1: REF DetailsCache => { cRef𡤌Ref1; EXIT; };
ENDCASE;
gvCacheVersion ← VoiceUtils.MakeAtom[
rName: Rope.Cat["V",
Convert.RopeFromInt[
Convert.IntFromRope[
Rope.Substr[ Atom.GetPName[gvCacheVersion], 1]
]+1
]
],
case: TRUE
];
ENDLOOP;
IF ~new AND cRef#NIL THEN { cache ← cRef^; RETURN};
cache ← SymTab.Create[cacheMod, FALSE];
Atom.PutProp[$GVCache, gvCacheVersion, NEW[DetailsCache ← cache]];
};
GV user commands
CmdSaveGVCache: Commander.CommandProc = {
GVSaveCache[];
};
CmdRestoreGVCache: Commander.CommandProc = {
GVRestoreCache[];
};
CmdRefreshGVCache:
ENTRY Commander.CommandProc = {
RefreshEachRName:
INTERNAL SymTab.EachPairAction = {
details: GVDetails ← NARROW[val];
quit←FALSE;
IF details.dirty THEN details.refreshMode ← TRUE;
QueueAction[refreshCacheQueue, LookupDetails, details];
};
[]←SymTab.Pairs[cache, RefreshEachRName];
};
CmdUpdateGVCache: Commander.CommandProc = {
GVUpdateAll[];
};
CmdFlushGVCache: Commander.CommandProc = {
GVFlushCache[];
};
CmdWaitForGV: Commander.CommandProc = {
GVWait[];
};
CmdGVSquawk: Commander.CommandProc = {
squawking ← ~squawking;
VoiceUtils.Report[IO.PutFR["Squawking[%g]", bool[squawking]], $System];
};
ReadLine:
PROC[s:
IO.
STREAM]
RETURNS [ line:
ROPE] = {
RETURN[s.GetLineRope[]]; };
Initialization
cacheQueue ← MBQueue.Create[pushModel: FALSE];
refreshCacheQueue ← MBQueue.Create[pushModel: FALSE];
TRUSTED { Process.Detach[FORK Notifier[]]; };
Commander.Register["GVFlushCache", CmdFlushGVCache, "Flush GV Cache"];
Commander.Register["GVSaveCache", CmdSaveGVCache, "Save GV Cache"];
Commander.Register["GVRestoreCache", CmdRestoreGVCache, "Restore GV Cache"];
Commander.Register["GVRefreshCache", CmdRefreshGVCache,
"Refresh all GV Cache entries from GV"];
Commander.Register["GVUpdateCache", CmdUpdateGVCache,
"Write all dirty cache entries to GV"];
Commander.Register["GVWait", CmdWaitForGV, "Wait for GV communications to complete"];
Commander.Register["GVSquawk", CmdGVSquawk, "Inform user of GV activity"];
}.