DIRECTORY
Atom USING[ GetPName ],
BasicTime USING[ FromPupTime ],
Buttons USING[ Button, ButtonProc, Create, Destroy, SetDisplayStyle ],
Commander USING[ CommandProc, Register ],
Containers USING[ ChildXBound, ChildYBound, Create ],
GVBasics USING[ GVString, MakeKey, oldestTime, Password, RName, Timestamp ],
GVNames USING[ CheckStamp, GetEntry, GetEntryInfo, GetEntryList, GetMembers, MemberInfo, NameType, Outcome, RListHandle, ReporterProc, RName, RSOperation, SetServer, SetServerInfo, Update],
GvNsMap USING[GetNsName],
IO USING[ Put, PutChar, PutF, PutFR, PutRope, STREAM, Value ],
Labels USING[ Create ],
Rope USING[ Cat, Equal, Fetch, Find, Index, Length, Match, Replace, ROPE, SkipOver, SkipTo, Substr ],
RopeList USING[Append, Length],
Rules USING[ Create ],
TypeScript USING[ Create ],
UserCredentials USING[ Get ],
ViewerClasses USING[ Viewer ],
ViewerIO USING[ CreateViewerStreams ],
ViewerOps USING[ ComputeColumn, DestroyViewer, MoveViewer, SetOpenHeight ],
ViewerTools USING[ GetContents, MakeNewTextViewer, SetContents, SetSelection];
Amount: TYPE = {members, finks, summary, details, names};
TypeGroupMatchesProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeGroup[clientData, names] };
TypeGroupMembersProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeGroup[clientData, members] };
TypeGroupSummaryProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeGroup[clientData, summary] };
TypeGroupDetailsProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeGroup[clientData, details] };
TypeGroupFinksProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeGroup[clientData, finks] };
TypeIndividualMatchesProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeIndividual[clientData, names] };
TypeIndividualSummaryProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeIndividual[clientData, summary] };
TypeIndividualDetailsProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeIndividual[clientData, details] };
TypeDeadMatchesProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeDead[clientData, names] };
TypeDeadDetailsProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
TypeDead[clientData, details] };
TypeGroup:
PROC [clientData:
REF, which: Amount] = {
d: MyData = NARROW[clientData];
name: ROPE = ViewerTools.GetContents[d.groupT];
IF ~CheckForm[clientData, name, "Group"] THEN RETURN;
DoEnumerate[d, name, "Groups", which];
};
TypeIndividual:
PROC [clientData:
REF, which: Amount] = {
d: MyData = NARROW[clientData];
name: ROPE = ViewerTools.GetContents[d.indivT];
IF ~CheckForm[clientData, name, "Individual"] THEN RETURN;
DoEnumerate[d, name, "Individuals", which];
};
TypeDead:
PROC [clientData:
REF, which: Amount] = {
d: MyData = NARROW[clientData];
name: ROPE = ViewerTools.GetContents[d.deadT];
IF ~CheckForm[clientData, name, "Dead"] THEN RETURN;
DoEnumerate[d, name, "Dead", which];
};
CallForItems:
PROC [d: MyData, names:
ROPE, proc:
PROC [
ROPE], evenIfNull:
BOOL ←
FALSE] = {
len: INT = Rope.Length[names];
pos: INT ← 0;
IF Quote[d] THEN { IF len # 0 OR evenIfNull THEN proc[names]; RETURN; };
DO
startPos: INT ← Rope.SkipOver[names, pos, ","];
startPos ← Rope.SkipOver[names, startPos, " "];
IF startPos = len THEN EXIT;
pos ← MIN[Rope.SkipTo[names, startPos, ","], Rope.SkipTo[names, startPos, " "]];
evenIfNull ← FALSE;
proc[Rope.Substr[names, startPos, pos-startPos]];
ENDLOOP;
IF evenIfNull THEN proc[NIL];
};
DoEnumerate:
ENTRY
PROC [d: MyData, pattern, type:
ROPE, which: Amount] = {
ENABLE UNWIND => NULL;
EnumerateOne:
INTERNAL
PROC [pattern:
ROPE] = {
IF Rope.Find[pattern, "*"] >= 0
THEN {
lastDotPos: INT ← -1;
DO
thisDot: INT = Rope.Find[pattern, ".", lastDotPos+1];
IF thisDot < 0 THEN EXIT;
lastDotPos ← thisDot;
ENDLOOP;
d.out.PutF["Enumerate%g[%g] ... ", [rope[type]], [rope[pattern]] ];
IF lastDotPos < 0
THEN {
d.out.PutRope["the pattern must have an explicit registry\n"]; RETURN };
IF Rope.Find[pattern, "*", lastDotPos+1] > 0
THEN {
d.out.PutRope["the registry must not contain \"*\"\n"]; RETURN };
{
registry: ROPE = Rope.Substr[pattern, lastDotPos+1];
enumName: ROPE = Rope.Cat[type, ".", registry];
info: GVNames.MemberInfo = GVNames.GetMembers[enumName];
TRUSTED {
WITH i: info
SELECT
FROM
notFound =>
d.out.PutF["\"%g\" is not a registry\n", [rope[registry]] ];
noChange, individual =>
d.out.PutRope["internal error - consult a wizard\n"];
allDown =>
d.out.PutF["no R-Server for registry \"%g\" is available\n", [rope[registry]] ];
group => {
first: BOOL ← TRUE;
FOR l: GVNames.RListHandle ← i.members, l.rest
UNTIL l =
NIL DO
IF Rope.Match[pattern, l.first,
FALSE]
THEN {
IF which = names
THEN {
IF NOT first THEN d.out.PutRope[", "]; d.out.PutRope[l.first] }
ELSE DoEnquiry[d, l.first, which];
first ← FALSE; };
ENDLOOP;
IF first THEN d.out.PutRope["no matches\n"]
ELSE IF which = names THEN d.out.PutChar['\n];
};
ENDCASE => ERROR; };
};
}
ELSE { IF which = names THEN which ← summary; DoEnquiry[d, pattern, which] };
};
d.stop ← FALSE;
CallForItems[d, pattern, EnumerateOne, FALSE];
IO.PutRope[d.out, "\n"];
};
DoEnquiry:
INTERNAL
PROC [d: MyData, name:
ROPE, which: Amount[members..details]] = {
Reporter:
PROC [report:
ROPE] = {
d.out.PutF["%g ... ", [rope[report]] ];
};
info: REF GVNames.GetEntryInfo;
rc: GVNames.NameType[group..allDown];
d.out.PutF["%g[%g] ... ",
[rope[
SELECT which
FROM
members => "TypeMembers",
finks => "TypeFinks",
summary => "TypeSummary",
details => "TypeDetails",
ENDCASE => ERROR]],
[rope[name]] ];
[rc, info] ← GVNames.GetEntry[name, Reporter];
IF info.type = dead THEN d.out.PutRope["recently deleted name"];
IF info.type # notFound
AND which = details
THEN
d.out.PutF["\nPrefix: %g, %g, %g",
[rope[info.name]],
[rope[
SELECT info.type
FROM
individual => "individual",
group => "group",
dead => "dead",
ENDCASE => ERROR]],
Stamp[info.stamp] ];
TRUSTED {
WITH i: info
SELECT
FROM
individual => {
IF which = details
THEN d.out.PutF["\nPassword: %b %b %b %b, %g",
[cardinal[i.password[0]]],
[cardinal[i.password[1]]],
[cardinal[i.password[2]]],
[cardinal[i.password[3]]],
Stamp[i.passwordStamp] ];
d.out.PutF["\nConnect: \"%g\"", [rope[i.connect]] ];
IF which = details THEN d.out.PutF[", %g", Stamp[i.connectStamp]];
IF which = details OR i.forward.current # NIL
THEN TypeEntryList[d, i.forward, "Forwarding",
IF which = details THEN details ELSE members];
TypeEntryList[d, i.sites, "Mailboxes", IF which = details THEN details ELSE members];
d.out.PutChar['\n];
};
group => {
subList: Rope.ROPE ← GetGVSubList[i.members.current];
IF subList # NIL THEN d.out.PutRope["Top level list ... "];
IF which # members AND which # finks THEN d.out.PutF["\nRemark: \"%g\"", [rope[i.remark]] ];
IF which = details THEN d.out.PutF[", %g", Stamp[i.remarkStamp]];
IF which = finks THEN TypeFinks[d, i.members.current]
ELSE TypeEntryList[d, i.members, "Members", which, subList # NIL];
IF which # members
AND which # finks
THEN {
TypeEntryList[d, i.owners, "Owners", IF which = details THEN details ELSE members];
TypeEntryList[d, i.friends, "Friends", IF which = details THEN details ELSE members];
};
d.out.PutRope["\n\n"];
IF subList # NIL THEN DoEnquiry[d: d, name: subList, which: which];
};
dead => d.out.PutChar['\n];
ENDCASE => TypeRC[d, rc, ReadEntry, name, NIL]; };
IF d.stop THEN { IO.PutRope[d.out, "Stopping.\n"]; ERROR ABORTED; };
};
GetGVSubList:
PROC [list: GVNames.RListHandle]
RETURNS[Rope.
ROPE] = {
FOR c: GVNames.RListHandle ← list, c.rest
UNTIL c =
NIL
DO
IF IsGVSublist[c.first] THEN RETURN[c.first];
ENDLOOP;
RETURN[NIL];
};
IsGVSublist:
PROC [r: Rope.ROPE]
RETURNS[
BOOLEAN] = {
RETURN[Rope.Find[r, "-GV^.", 0, FALSE] # -1];
};
GetNSSubList:
PROC [list: GVNames.RListHandle]
RETURNS[Rope.
ROPE] = {
FOR c: GVNames.RListHandle ← list, c.rest
UNTIL c =
NIL
DO
IF IsNSSublist[c.first] THEN RETURN[c.first];
ENDLOOP;
RETURN[NIL];
};
IsNSSublist:
PROC [r: Rope.ROPE]
RETURNS[
BOOLEAN] = {
RETURN[Rope.Find[r, "-NS.", 0, FALSE] # -1];
};
Stamp:
PROC [stamp: GVBasics.Timestamp]
RETURNS [
IO.Value] = {
time: ROPE = IO.PutFR[NIL, [time[BasicTime.FromPupTime[stamp.time]]] ];
RETURN[ [rope[
IO.PutFR["[%b#%b,%g]",
[cardinal[stamp.net]],
[cardinal[stamp.host]],
[rope[Rope.Substr[time, 0, Rope.Length[time]-4]]]]]]]
};
TypeEntryList:
PROC [d: MyData, list: GVNames.GetEntryList, text:
ROPE, which: Amount, topList:
BOOLEAN ←
FALSE] = {
TypeEntrySublist[d, list.current, list.currentStamps, text, which, topList];
IF which = details
THEN
TypeEntrySublist[d, list.deleted, list.deletedStamps, Rope.Cat["Del", text], which, topList];
};
TypeEntrySublist:
PROC [d: MyData, names: GVNames.RListHandle, stamps:
LIST
OF GVBasics.Timestamp, text:
ROPE, which: Amount, topList:
BOOLEAN ←
FALSE] = {
count: INT ← 0;
stampList: LIST OF GVBasics.Timestamp ← stamps;
d.out.PutF["\n%g: ", [rope[text]] ];
FOR c: GVNames.RListHandle ← names, c.rest
UNTIL c =
NIL DO
IF (which # summary OR topList) AND count # 0 THEN d.out.PutRope[", "];
count ← count+1;
IF which # summary OR topList THEN d.out.PutRope[c.first];
IF which = details THEN d.out.Put[Stamp[stampList.first]];
stampList ← stampList.rest;
ENDLOOP;
IF which = summary AND ~topList THEN d.out.Put[[integer[count]]]
ELSE { IF count = 0 THEN d.out.PutRope["none"] };
};
IsForeignRegistry:
PROC [name: GVNames.RName]
RETURNS[
BOOLEAN] = {
f: GVBasics.RName;
length: INT = Rope.Length[name];
FOR i:
INT
DECREASING
IN [0..length)
DO
IF Rope.Fetch[name, i] = '.
THEN {
f ← Rope.Cat[Rope.Substr[name, i+1, length-i], ".foreign"]; EXIT};
ENDLOOP;
RETURN[CheckIndividual[f]];
};
TypeFinks:
PROC [d: MyData, names: GVNames.RListHandle] = {
badGuys, nsList: GVNames.RListHandle ← NIL;
FOR c: GVNames.RListHandle ← names, c.rest
UNTIL c =
NIL DO
who: GVNames.RName ← c.first;
rc: GVNames.NameType[group..allDown];
info: REF GVNames.GetEntryInfo;
[rc, info] ← GVNames.GetEntry[who];
TRUSTED {
WITH i: info
SELECT
FROM
group => LOOP;
individual => {
IF i.forward.current = NIL THEN LOOP;
d.out.PutF["\n%G => is forwarded to ", [rope[who]] ];
FOR c: GVNames.RListHandle ← i.forward.current, c.rest
UNTIL c =
NIL
DO
nsName: Rope.ROPE ← GvNsMap.GetNsName[c.first];
IF nsName # NIL THEN nsList ← RopeList.Append[nsList, LIST[nsName]];
IF c # i.forward.current THEN d.out.PutRope[", "]
ELSE {IF nsName # NIL THEN badGuys ← RopeList.Append[badGuys, LIST[who]]};
d.out.PutRope[c.first];
ENDLOOP;
};
dead => {d.out.PutF["\n%G => recently deleted", [rope[who]] ];
badGuys ← RopeList.Append[badGuys, LIST[who]]};
notFound => {
nsName: Rope.ROPE ← GvNsMap.GetNsName[who];
SELECT
TRUE
FROM
nsName #
NIL => {
d.out.PutF["\n%G => NS name", [rope[who]]];
nsList ← RopeList.Append[nsList, LIST[nsName]];
badGuys ← RopeList.Append[badGuys, LIST[who]];
};
IsForeignRegistry[who] => d.out.PutF["\n%G => foreign name", [rope[who]]];
ENDCASE => {
d.out.PutF["\n%G => invalid name", [rope[who]] ];
badGuys ← RopeList.Append[badGuys, LIST[who]];
};
};
ENDCASE => d.out.PutF["\n%G => ????", [rope[who]]];
};
ENDLOOP;
d.out.PutF["\n\nFinks: "];
FOR c: GVNames.RListHandle ← badGuys, c.rest
UNTIL c =
NIL DO
IF c # badGuys THEN d.out.PutRope[", "];
d.out.PutRope[c.first];
ENDLOOP;
d.out.PutF["\n\nNS Names: "];
FOR c: GVNames.RListHandle ← nsList, c.rest
UNTIL c =
NIL DO
IF c # nsList THEN d.out.PutRope[", "];
d.out.PutRope[c.first];
ENDLOOP;
d.out.PutF["\n%G members, %G finks, %G NS names.", [integer[RopeList.Length[names]]], [integer[RopeList.Length[badGuys]]], [integer[RopeList.Length[nsList]]] ];
};
UpdateOp: TYPE = REF UpdateOpRec;
UpdateOpRec:
TYPE =
RECORD[
d: MyData,
op: GVNames.RSOperation ];
UpdateGroup: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
rec: UpdateOp = NARROW[clientData];
name: ROPE = ViewerTools.GetContents[rec.d.groupT];
data: ROPE = IF rec.d.dataGT = NIL THEN NIL ELSE ViewerTools.GetContents[rec.d.dataGT];
IF ~CheckForm[rec.d, name, "Group"] THEN RETURN;
SELECT rec.op
FROM
CreateGroup, DeleteGroup, AddSelf, DeleteSelf => NULL;
ENDCASE => IF ~CheckForm[rec.d, data, "Argument"] THEN RETURN;
DoUpdate[rec.d, group, rec.op, name, data];
};
UpdateIndividual: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
rec: UpdateOp = NARROW[clientData];
name: ROPE = ViewerTools.GetContents[rec.d.indivT];
data: ROPE = ViewerTools.GetContents[rec.d.dataIT];
IF ~CheckForm[rec.d, name, "Individual"] THEN RETURN;
SELECT rec.op
FROM
DeleteIndividual => NULL;
ENDCASE => IF ~CheckForm[rec.d, data, "Argument"] THEN RETURN;
DoUpdate[rec.d, individual, rec.op, name, data];
};
DoUpdate:
ENTRY
PROC [d: MyData, expected: GVNames.NameType, op: GVNames.RSOperation, target: GVBasics.RName, value: GVBasics.GVString] = {
ENABLE UNWIND => NULL;
EnumerateValue:
PROC [rope1:
ROPE] = {
AddDeleteOne:
PROC [rope2:
ROPE] = {
DoOneUpdate[d, expected, op, rope1, rope2];
};
CallForItems[d, value, AddDeleteOne, TRUE];
};
UpdateSelf:
PROC [rope:
ROPE] = {
DoOneUpdate[d, expected, op, rope, NIL];
};
d.stop ← FALSE;
SELECT op
FROM
AddSelf, DeleteSelf => CallForItems[d, target, UpdateSelf, TRUE];
CreateIndividual, DeleteIndividual, ChangeConnect, ChangePassword =>
DoOneUpdate[d, expected, op, target, value];
CreateGroup, DeleteGroup, ChangeRemark, NewName =>
DoOneUpdate[d, expected, op, target, value];
AddMember, AddMailBox, AddForward, AddOwner, AddFriend,
DeleteMember
, DeleteMailBox
, DeleteForward
, DeleteOwner
, DeleteFriend =>
CallForItems[d, target, EnumerateValue, TRUE];
ENDCASE => ERROR;
IO.PutRope[d.out, "\n"];
};
DoOneUpdate:
PROC [d: MyData, expected: GVNames.NameType, op: GVNames.RSOperation, target: GVBasics.RName, value: GVBasics.GVString] = {
outcome: GVNames.Outcome;
Reporter:
SAFE PROC [report:
ROPE] = {
d.out.PutF["%g ... ", [rope[report]] ];
};
user, password: ROPE;
[name: user, password: password] ← UserCredentials.Get[];
-- Log command --
IO.PutF[d.out, "%g%g[%g%g] ... ",
[rope[
SELECT op
FROM
CreateIndividual, CreateGroup => "Create",
DeleteIndividual, DeleteGroup => "Delete",
AddMember, AddOwner, AddFriend,
AddMailBox, AddForward, AddSelf => "Add",
DeleteMember, DeleteOwner, DeleteFriend,
DeleteMailBox, DeleteForward, DeleteSelf => "Remove",
ChangeRemark, ChangePassword, ChangeConnect => "Set",
ENDCASE => ""]],
[rope[
SELECT op
FROM
CreateIndividual, DeleteIndividual => "Individual",
CreateGroup, DeleteGroup => "Group",
NewName => "NewName",
AddMember, DeleteMember => "Member",
AddOwner, DeleteOwner => "Owner",
AddFriend, DeleteFriend => "Friend",
AddMailBox, DeleteMailBox => "Mailbox",
AddForward, DeleteForward => "Forwarding",
AddSelf, DeleteSelf => "Self",
ChangeRemark => "Remark",
ChangePassword => "Password",
ChangeConnect => "Connect",
ENDCASE => "UnknownOp"]],
[rope[target]],
[rope[
SELECT op
FROM
CreateIndividual, CreateGroup, ChangePassword,
DeleteIndividual, DeleteGroup,
AddSelf, DeleteSelf => "",
ENDCASE => Rope.Cat[",", value]]] ];
-- validate argument --
IF (
SELECT op
FROM
AddMember, AddOwner, AddFriend, AddForward => CheckName[d, value, Reporter],
AddMailBox => CheckInbox[d, value, Reporter],
ChangePassword => CheckPwd[d, user, target, value],
ENDCASE => TRUE)
AND NotGVMS[d, target] THEN {
newPwd: GVBasics.Password;
SELECT op
FROM
CreateIndividual, ChangePassword => newPwd ← GVBasics.MakeKey[value];
ENDCASE => NULL;
SELECT op
FROM
-- patch because of inadequate return codes from Update --
CreateIndividual, CreateGroup, NewName => {
outcome ← GVNames.CheckStamp[target, GVBasics.oldestTime--, Reporter--];
IF outcome # notFound THEN GOTO Bad;
};
DeleteIndividual, DeleteGroup => {
outcome ← GVNames.CheckStamp[target, GVBasics.oldestTime--, Reporter--];
IF outcome = notFound THEN GOTO Bad;
expected ← notFound;
};
AddMember => {
nsName: Rope.ROPE ← GvNsMap.GetNsName[value];
nsList, topList: Rope.ROPE;
IF nsName #
NIL
AND IsGVSublist[target]
THEN {
rc: GVNames.NameType[group..allDown];
info: REF GVNames.GetEntryInfo;
topList ← Rope.Replace[target, Rope.Index[target, 0, "-GV", FALSE], 3, NIL];
[rc, info] ← GVNames.GetEntry[topList];
TRUSTED {
WITH i: info
SELECT
FROM
group => nsList ← GetNSSubList[i.members.current];
individual => {};
ENDCASE => {TypeRC[d, rc, ReadEntry, topList, NIL]; RETURN};
};
IF nsList # NIL THEN {d.out.PutRope["Please tell this NS individual to add themselves to "]; d.out.PutRope[GvNsMap.GetNsName[nsList]]; d.out.PutRope[". They don't belong on this GV sublist."]; RETURN};
};
};
AddSelf, DeleteSelf => {
rc: GVNames.NameType[group..allDown];
info: REF GVNames.GetEntryInfo;
[rc, info] ← GVNames.GetEntry[target];
TRUSTED {
WITH i: info
SELECT
FROM
group => {
subList: Rope.ROPE ← GetGVSubList[i.members.current];
IF subList #
NIL
THEN {
d.out.PutRope["Top level list ... "];
target ← subList;
SELECT op
FROM
AddSelf => d.out.PutRope["AddSelf["];
DeleteSelf => d.out.PutRope["RemoveSelf["];
ENDCASE;
d.out.PutRope[target];
d.out.PutRope["] ... "];};
};
individual => {};
ENDCASE => {TypeRC[d, rc, ReadEntry, target, NIL]; RETURN};
}};
ENDCASE => NULL;
outcome ← GVNames.Update[user: user, password: GVBasics.MakeKey[password],
op: op, target: target, value: value, newPwd: newPwd, reporter: Reporter];
IF outcome # expected THEN GOTO Bad;
IO.PutRope[d.out, "ok\n"]
EXITS Bad => TypeRC[d, outcome, op, target, value];
};
IF d.stop THEN { IO.PutRope[d.out, "Stopping.\n"]; ERROR ABORTED; };
};
verifyOn: ATOM = $on;
Verify:
PROC [d: MyData]
RETURNS [
BOOL] =
{
IF d.verify = NIL THEN RETURN[TRUE];
IF d.verify^ = verifyOn THEN RETURN[TRUE];
RETURN[FALSE];
};
quoteOff: ATOM = $off;
Quote:
PROC [d: MyData]
RETURNS [
BOOL] =
{
IF d.quote = NIL THEN RETURN[FALSE];
IF d.quote^ = quoteOff THEN RETURN[FALSE];
RETURN[TRUE];
};
CheckName:
PROC [d: MyData, name: GVBasics.RName, reporter: GVNames.ReporterProc]
RETURNS [BOOL] = {
length: INT = Rope.Length[name];
IF length = 0 THEN GOTO Bad;
IF length = 1 AND Rope.Fetch[name, 0] = '* THEN RETURN[TRUE];
IF length > 1 AND Rope.Fetch[name, 0] = '* AND Rope.Fetch[name, 1] = '. THEN RETURN[TRUE];
IF GVNames.CheckStamp[name, GVBasics.oldestTime--, reporter--] = notFound
THEN {
FOR i: INT DECREASING IN [0..length)
DO
IF Rope.Fetch[name, i] = '.
THEN {
f: GVBasics.RName = Rope.Cat[Rope.Substr[name, i+1, length-i], ".foreign"];
IF ~CheckIndividual[f] THEN GOTO Bad;
IO.PutRope[d.out, "(foreign) ... "];
RETURN[TRUE];
};
REPEAT FINISHED => GOTO Bad
ENDLOOP
};
RETURN[TRUE]
EXITS Bad =>
{
IF d.verify #
NIL
AND d.verify^ # verifyOn
THEN { IO.PutRope[d.out, "(invalid) ... "]; RETURN[TRUE] };
IO.PutF[d.out, "\"%g\" is not a valid name\n", [rope[name]] ];
RETURN[FALSE] }
};
CheckIndividual:
PROC [name: GVBasics.RName]
RETURNS [
BOOL] =
{
IF GVNames.CheckStamp[name, GVBasics.oldestTime] # individual THEN RETURN[FALSE];
RETURN[TRUE];
};
CheckInbox:
PROC [d: MyData, name: GVBasics.RName, reporter: GVNames.ReporterProc]
RETURNS [BOOL] = {
IF ~EndsWith[name, ".ms"]
OR ~CheckIndividual[name]
THEN {
IF ~Verify[d] THEN { IO.PutRope[d.out, "(invalid) ... "]; RETURN[TRUE] }
ELSE {
IO.PutF[d.out, "\"%g\" is not a mail server\n", [rope[name]] ];
RETURN[FALSE]; }; };
RETURN[TRUE];
};
CheckPwd:
PROC [d: MyData, user, name, pwd: GVBasics.RName]
RETURNS [BOOL] = {
IF Rope.Length[pwd] # 0 THEN RETURN[TRUE];
IF ~Rope.Equal[user, name, FALSE] THEN RETURN[TRUE];
IO.PutRope[d.out, " You don't want an empty password.\n"];
RETURN[FALSE];
};
gvmsAllowed: ATOM = $yes;
NotGVMS:
PROC [d: MyData, a:
ROPE]
RETURNS [
BOOL] = {
IF d.gvms # NIL AND d.gvms^ = gvmsAllowed THEN RETURN[TRUE];
IF ~EndsWith[a, ".gv"] AND ~EndsWith[a, ".ms"] THEN RETURN[TRUE];
IO.PutRope[d.out, " Use wizard's GV/MS switch first.\n"];
RETURN[FALSE];
};
EndsWith:
PROC [a, b:
ROPE]
RETURNS [
BOOL] = {
bLength: INT = Rope.Length[b];
aLength: INT = Rope.Length[a];
IF aLength < bLength THEN RETURN[FALSE];
RETURN[Rope.Equal[Rope.Substr[a, aLength - bLength, bLength], b, FALSE]];
};
-- ******** Viewer management ******** --
Create: Commander.CommandProc = {
[cmd: Handle]
d: MyData = NEW[MyDataObject];
v: Viewer = Containers.Create[
info: [name: "Maintain", column: right, scrollable: FALSE, iconic: TRUE]];
{
-- kludge to find max button size! --
temp: Buttons.Button = Buttons.Create[
info: [name: "Forwarding", parent: v, border:
FALSE,
wx: 0, wy: 0],
proc: NIL, clientData: d, fork: FALSE, paint: FALSE];
d.maxW ← temp.ww;
d.buttH ← temp.wh;
Buttons.Destroy[temp];
};
d.topChild ← CreateSelector[name: "Level:",
values: LIST[$Normal, $Owner, $Administrator, $Wizard],
change: ChangeLevel,
clientData: d,
viewer: v,
x: 2, y: 1].child;
d.topChild ← Buttons.Create[
info: [name: "Stop", parent: v, border: TRUE,
wy: d.topChild.wy, wx: d.topChild.wx + d.topChild.ww + 20],
proc: Stop, clientData: d, fork: TRUE, paint: TRUE];
d.script ← TypeScript.Create[
info: [parent: v, wh: v.ch - (d.topChild.wy + d.topChild.wh + 2), ww: v.cw,
border: FALSE,
wy: d.topChild.wy + d.topChild.wh + 2, wx: 0] ];
Containers.ChildXBound[v, d.script];
Containers.ChildYBound[v, d.script];
[in: d.in, out: d.out] ← ViewerIO.CreateViewerStreams[
name: "Maintain", viewer: d.script, backingFile: "///Temp/Maintain.log", editedStream: FALSE];
CreateButtons[d, v];
};
ChangeLevel:
PROC [parent: Viewer, clientData:
REF, value:
ATOM] = {
d: MyData = NARROW[clientData];
SELECT value
FROM
$Normal => d.level ← normal;
$Owner => d.level ← owner;
$Administrator => d.level ← admin;
$Wizard => d.level ← wizard;
ENDCASE => ERROR;
CreateButtons[d, parent]
};
Stop: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
d: MyData = NARROW[clientData];
d.stop ← TRUE;
};
CreateButtons:
ENTRY
PROC [d: MyData, parent: Viewer] = {
ENABLE UNWIND => NULL;
child: Viewer ← NIL;
EnquiryButton:
PROC [name:
ROPE, proc: Buttons.ButtonProc] =
{
child ← Buttons.Create[
info: [name: name, parent: kids, border:
TRUE,
wy: child.wy, wx: child.wx + d.maxW - 1, ww: d.maxW],
proc: proc,
clientData: d,
fork: TRUE,
paint: FALSE];
};
updateProc: Buttons.ButtonProc ← UpdateGroup;
UpdateButton:
PROC
[name: ROPE, op: GVNames.RSOperation, guarded: BOOL ← FALSE] = {
child ← Buttons.Create[
info: [name: name, parent: kids, border:
TRUE,
wy: child.wy, wx: child.wx + d.maxW - 1, ww: d.maxW],
proc: updateProc,
clientData: NEW[UpdateOpRec ← [d,op]],
fork: TRUE,
guarded: guarded,
paint: FALSE];
};
LabelText:
PROC
[name, data: ROPE, prev: Viewer, newline: BOOL ← TRUE] RETURNS[Viewer] = {
x: INTEGER = IF newline THEN 2 ELSE child.wx + d.maxW - 1;
y: INTEGER = IF newline THEN child.wy + child.wh + 1 ELSE child.wy;
child ← ViewerTools.MakeNewTextViewer[
info: [parent: kids, wh: d.buttH, ww: 999, scrollable:
TRUE,
data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
border: FALSE,
wx: x + d.maxW + 2, wy: y],
paint: FALSE ];
Containers.ChildXBound[kids, child];
[] ← Buttons.Create[
info: [name: name, parent: kids, wh: d.buttH,
border: FALSE, wx: x, wy: y],
proc: TextLabelProc, clientData: child, fork: FALSE, paint: FALSE];
RETURN[child]
};
Label:
PROC [name:
ROPE] = {
child ← Labels.Create[
info: [name: name, parent: kids, border:
FALSE,
wy: child.wy + child.wh + (IF child.class.flavor = $Button THEN -1 ELSE 2),
wx: 2],
paint: FALSE ];
};
Rule:
PROC = {
child ← Rules.Create[
info: [parent: kids, border:
FALSE,
wy: IF child = NIL THEN 0 ELSE child.wy + child.wh + 2, wx: 0, ww: kids.ww, wh: 1],
paint: FALSE ];
Containers.ChildXBound[kids, child];
};
kids: Viewer = Containers.Create[
info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ];
Containers.ChildXBound[parent, kids];
Rule[];
d.groupT ← LabelText[
name: "Group:",
data: "group name or pattern",
prev: d.groupT ];
IF d.level IN [owner..wizard]
THEN d.dataGT ← LabelText[
name: "Argument:",
data: "remark string, or member/owner/friend name",
prev: d.dataGT ]
ELSE d.dataGT ← NIL;
Label["Type: "];
EnquiryButton[name: "Matches", proc: TypeGroupMatchesProc];
EnquiryButton[name: "Members", proc: TypeGroupMembersProc];
EnquiryButton[name: "Summary", proc: TypeGroupSummaryProc];
IF d.level
IN [admin..wizard]
THEN {
EnquiryButton[name: "Details", proc: TypeGroupDetailsProc];
EnquiryButton[name: "Finks", proc: TypeGroupFinksProc]};
IF d.level
IN [owner..wizard]
THEN {
Label["Set:"];
UpdateButton[name: "Remark", op: ChangeRemark];
};
Label["Add:"];
UpdateButton[name: "Self", op: AddSelf];
IF d.level
IN [owner..wizard]
THEN {
UpdateButton[name: "Member", op: AddMember];
UpdateButton[name: "Owner", op: AddOwner];
UpdateButton[name: "Friend", op: AddFriend];
};
Label["Remove:"];
UpdateButton[name: "Self", op: DeleteSelf];
IF d.level
IN [owner..wizard]
THEN {
UpdateButton[name: "Member", op: DeleteMember];
UpdateButton[name: "Owner", op: DeleteOwner];
UpdateButton[name: "Friend", op: DeleteFriend];
};
IF d.level
IN [admin..wizard]
THEN {
Label[""];
UpdateButton[name: "Create", op: CreateGroup, guarded: FALSE];
UpdateButton[name: "Delete", op: DeleteGroup, guarded: TRUE];
UpdateButton[name: "NewName", op: NewName, guarded: FALSE];
};
Rule[];
updateProc ← UpdateIndividual;
d.indivT ← LabelText[
name: "Individual:",
data: UserCredentials.Get[].name,
prev: d.indivT ];
d.dataIT ← LabelText[
name: "Argument:",
data: "password, connect-site, etc.",
prev: d.dataIT ];
Label["Type:"];
EnquiryButton[name: "Matches", proc: TypeIndividualMatchesProc];
EnquiryButton[name: "Summary", proc: TypeIndividualSummaryProc];
IF d.level
IN [admin..wizard]
THEN
EnquiryButton[name: "Details", proc: TypeIndividualDetailsProc];
Label["Set:"];
UpdateButton[name: "Password", op: ChangePassword];
UpdateButton[name: "Connect", op: ChangeConnect];
IF d.level
IN [admin..wizard]
THEN {
Label["Add: "];
UpdateButton[name: "Mailbox", op: AddMailBox, guarded: FALSE];
UpdateButton[name: "Forwarding", op: AddForward, guarded: FALSE];
Label["Remove: "];
UpdateButton[name: "Mailbox", op: DeleteMailBox, guarded: FALSE];
UpdateButton[name: "Forwarding", op: DeleteForward, guarded: FALSE];
Label[""];
UpdateButton[name: "Create", op: CreateIndividual, guarded: FALSE];
UpdateButton[name: "Delete", op: DeleteIndividual, guarded: TRUE];
};
Rule[];
IF d.level = wizard
THEN {
d.deadT ← LabelText[
name: "Dead:",
data: "dead name or pattern",
prev: d.deadT];
Label["Type:"];
EnquiryButton[name: "Matches", proc: TypeDeadMatchesProc];
EnquiryButton[name: "Details", proc: TypeDeadDetailsProc];
Rule[];
[child, d.verify] ← CreateSelector[
name: "Verify:",
values: LIST[verifyOn, $off],
init: d.verify,
viewer: kids,
x: 2, y: child.wy + child.wh + 2];
[child, d.quote] ← CreateSelector[
name: "Quote:",
values: LIST[quoteOff, $on],
init: d.quote,
viewer: kids,
x: child.wx + child.ww + 10, y: child.wy];
[child, d.gvms] ← CreateSelector[
name: "GV/MS updates:",
values: LIST[$no, gvmsAllowed],
init: d.gvms,
viewer: kids,
x: child.wx + child.ww + 10, y: child.wy];
child ← Buttons.Create[
info: [name: "SetServer", parent: kids, wh: d.buttH,
border: TRUE, wx: 2, wy: child.wy + child.wh + 2],
proc: SetServerProc, clientData: d, fork: TRUE, paint: FALSE];
d.serverT ← LabelText[
name: " Host:",
data: "RName, NLS name, or Pup address",
prev: d.serverT,
newline: FALSE ];
Rule[];
}
ELSE { d.serverT ← d.deadT ← NIL };
{
kidsY: INTEGER = d.topChild.wy + d.topChild.wh + 2;
kidsH: INTEGER = child.wy + child.wh + 2;
IF d.kids # NIL THEN ViewerOps.DestroyViewer[d.kids, FALSE];
d.kids ← kids;
ViewerOps.MoveViewer[viewer: d.script, x: 0, y: kidsY + kidsH, w: d.script.ww, h: parent.ch - (kids.wy + kidsH), paint: FALSE];
ViewerOps.SetOpenHeight[parent, kidsY + kidsH + 8 * d.buttH];
IF NOT parent.iconic THEN ViewerOps.ComputeColumn[parent.column];
ViewerOps.MoveViewer[viewer: kids, x: kids.wx, y: kidsY, w: kids.ww, h: kidsH];
};
};
TextLabelProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
text: Viewer = NARROW[clientData];
SELECT mouseButton
FROM
red => ViewerTools.SetSelection[text, NIL];
blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
yellow => NULL;
ENDCASE => ERROR;
};
Selector: TYPE = REF SelectorRec;
SelectorRec:
TYPE =
RECORD[
value: REF ATOM,
change: PROC [parent: Viewer, clientData: REF, value: ATOM],
clientData: REF,
buttons: LIST OF Buttons.Button,
values: LIST OF ATOM ];
CreateSelector:
PROC
[name: ROPE, values: LIST OF ATOM, init: REF ATOM ← NIL, change: PROC [parent: Viewer, clientData: REF, value: ATOM] ← NIL, clientData: REF ← NIL, viewer: Viewer, x, y: INTEGER]
RETURNS [child: Viewer, value: REF ATOM] = {
selector: Selector ←
NEW[ SelectorRec ← [
value: IF init # NIL THEN init ELSE NEW[ATOM←values.first],
change: change,
clientData: clientData,
buttons: NIL,
values: values ] ];
last: LIST OF Buttons.Button ← NIL;
value ← selector.value;
child ← Labels.Create[info: [name: name, parent: viewer, border: FALSE, wx: x, wy: y] ];
FOR a:
LIST
OF
ATOM ← values, a.rest
UNTIL a =
NIL DO
child ← Buttons.Create[
info: [name: Atom.GetPName[a.first], parent: viewer, border: TRUE, wy: child.wy, wx: child.wx + child.ww + 2],
proc: SelectorProc, clientData: selector, fork: TRUE, paint: TRUE];
IF last =
NIL
THEN last ← selector.buttons ← CONS[first: child, rest: NIL]
ELSE { last.rest ← CONS[first: child, rest: NIL]; last ← last.rest };
IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
ENDLOOP;
};
SelectorProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
selector: Selector = NARROW[clientData];
buttons: LIST OF Buttons.Button ← selector.buttons;
FOR a:
LIST
OF
ATOM ← selector.values, a.rest
UNTIL a =
NIL DO
IF self = buttons.first
THEN {
selector.value^ ← a.first;
IF selector.change # NIL THEN selector.change[self.parent, selector.clientData, a.first];
Buttons.SetDisplayStyle[buttons.first, $WhiteOnBlack];
}
ELSE Buttons.SetDisplayStyle[buttons.first, $BlackOnWhite];
buttons ← buttons.rest;
ENDLOOP;
};