MaintainGVImpl.mesa -- From MaintainImpl.mesa
Copyright Ó 1987, 1990, 1992 by Xerox Corporation. All rights reserved.
Wes Irish, December 8, 1987 12:45:19 pm PST
Last changed by Pavel on November 9, 1989 3:31:58 pm PST
Bill Jackson (bj) January 20, 1990 0:33:32 am PST
DIRECTORY
Basics USING[ ShortNumber ],
BasicTime USING[ FromPupTime, GMT ],
Buttons USING[ ButtonProc ],
GVBasics USING[ GVString, MakeKey, oldestTime, Password, RName, Timestamp ],
GVNames USING[ CheckStamp, GetEntry, GetEntryInfo, GetEntryList, GetList, GetMembers, IsInList, ListType, MemberInfo, Membership, NameType, oldestTime, Outcome, RListHandle, RemoveMember, ReporterProc, RName, RSOperation, SetServer, SetServerInfo, StampInfo, Update],
GvNsMap USING[NsFromGvName, GvFromNsName],
IO USING[ Put, PutF, PutFR, PutRope, Value ],
MaintainDefs USING[ Class, Command, CmdButton, CmdRec, CmdRef, Level, Mode, MyData, MyDataObject, What ],
MaintainGV,
MaintainMisc USING[ CallForItems, EnumGroups, EnumIndividuals, EnumDead, ModeOfName, SplitGvName, Verify ],
MaintainNS USING[ DoCommand, DoEnumerate ],
RopeList USING[ Append, Length ],
Rope USING[ Cat, Equal, Fetch, Find, FromChar, Index, Length, Match, Replace, ROPE, Substr ],
XNSCH USING [Conversation, Error, InitiateConversation, Lookup, Name, TerminateConversation],
XNSCHName USING [FieldTooLong, NameFromRope];
MaintainGVImpl: CEDAR MONITOR LOCKS d USING d: MyData
IMPORTS BasicTime, GVBasics, GVNames, GvNsMap, IO, MaintainMisc, MaintainNS, Rope, RopeList, XNSCH, XNSCHName
EXPORTS MaintainGV
SHARES GVNames--Update-- = {
ROPE: TYPE = Rope.ROPE;
NotImplementedYet: PROC [d: MyData] = {
d.out.PutF["\nSorry, that function not implemented yet..."];
};
NotValidInGvMode: PROC [d: MyData, what: What] = {
d.out.PutF["\nSorry, that function is not valid in GV mode."];
};
DoCommand: PUBLIC PROC [d: MyData, cb: CmdButton, name, args: ROPE, okToMap: BOOL ¬ FALSE] = {
IF okToMap THEN {
nsName: ROPE ¬ GvNsMap.NsFromGvName[name];
IF IsNSName[nsName] THEN {
IF d.firstTime
THEN d.firstTime ¬ FALSE
ELSE d.out.PutF["\n"];
d.out.PutF["\n... mapping: %g => \"%g\" ... ", [rope[name]], [rope[nsName]]];
MaintainNS.DoCommand[d, cb, nsName, args];
RETURN;
};
};
SELECT cb.cmd FROM
type => DoType[d, cb, name, args];
isMember => DoIsMember[d, name, args, cb.what];
set, add, remove, misc => DoMyUpdate[d, cb, name, args];
ENDCASE => NotImplementedYet[d];
};
DoEnumerate: PUBLIC PROC [d: MyData, cb: CmdButton, pattern, args: ROPE, okToMap: BOOL ¬ FALSE] = {
EnumThisList: PROC [firstPart, registry: ROPE] = {
enumName: ROPE ¬ Rope.Cat[firstPart, ".", registry];
TRUSTED {
info: GVNames.MemberInfo = GVNames.GetMembers[enumName];
{
WITH i: info SELECT FROM
notFound =>
d.out.PutF["\"%g\" is not a registry", [rope[registry]] ];
noChange, individual =>
d.out.PutRope["internal error - consult a wizard"];
allDown =>
d.out.PutF["no R-Server for registry \"%g\" is available", [rope[registry]] ];
group => {
FOR l: GVNames.RListHandle ¬ i.members, l.rest UNTIL l = NIL OR d.stop DO
IF Rope.Match[pattern, l.first, FALSE] THEN {
IF cb.what = matches OR cb.what = deadMatches THEN {
IF NOT d.firstTime THEN d.out.PutRope[", "]; d.out.PutRope[l.first] }
ELSE DoCommand[d, cb, l.first, args];
d.firstTime ¬ FALSE; };
ENDLOOP;
};
ENDCASE => ERROR; };
};
};
DoOneRegistry: PROC [registry: ROPE] = {
IF MaintainMisc.EnumGroups[cb] THEN EnumThisList["Groups", registry];
IF MaintainMisc.EnumIndividuals[cb] THEN EnumThisList["Individuals", registry];
IF MaintainMisc.EnumDead[cb] THEN EnumThisList["Dead", registry];
};
namePart, registryPart: ROPE;
patternInNamePart, patternInRegistryPart: BOOL;
[namePart, registryPart] ¬ MaintainMisc.SplitGvName[pattern];
patternInNamePart ¬ Rope.Find[namePart, "*"] >= 0;
patternInRegistryPart ¬ Rope.Find[registryPart, "*"] >= 0;
IF ~patternInNamePart AND ~patternInRegistryPart THEN {
DoCommand[d, cb, pattern, args, okToMap];
RETURN;
};
IF ~patternInRegistryPart AND okToMap THEN {
nsName: ROPE ¬ GvNsMap.NsFromGvName[pattern];
IF IsNSName[nsName] THEN {
d.out.PutF["\n... mapping: %g => \"%g\" ... ", [rope[pattern]], [rope[nsName]]];
MaintainNS.DoEnumerate[d, cb, nsName, args];
RETURN;
};
};
IF registryPart = NIL OR registryPart.Length[] = 0 THEN {
d.out.PutRope["\nthe pattern must have an explicit registry"]; RETURN };
IF ~patternInRegistryPart THEN DoOneRegistry[registryPart];
TRUSTED {
info: GVNames.MemberInfo = GVNames.GetMembers["Groups.gv"];
WITH i: info SELECT FROM
notFound => d.out.PutF["Error: .gv registry not found."];
noChange, individual => d.out.PutRope["Error: ???"];
allDown => d.out.PutF["Error: allDown"];
group => {
FOR l: GVNames.RListHandle ¬ i.members, l.rest UNTIL l = NIL OR d.stop DO
IF Rope.Match[registryPart, l.first, FALSE] THEN {
DoOneRegistry[MaintainMisc.SplitGvName[l.first].sn];
};
ENDLOOP;
};
ENDCASE => ERROR; };
};
DoGVEnquiry: PROC [d: MyData, name: ROPE, what: What] = {
Reporter: PROC [report: ROPE] = {
d.out.PutF[" ... %g ... ", [rope[report]] ];
};
info: REF GVNames.GetEntryInfo;
rc: GVNames.NameType[group..allDown];
giveDetails: BOOL ¬ what = details OR what = deadDetails;
[rc, info] ¬ GVNames.GetEntry[name, Reporter];
IF ~d.firstTime THEN d.out.PutF["\n"];
d.firstTime ¬ FALSE;
d.out.PutF["\nName: %g", [rope[name]]];
IF info.type = dead THEN d.out.PutRope[" => recently deleted name"];
IF info.type # notFound AND giveDetails 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] ];
SELECT TRUE FROM
info.type = individual => {
i: REF individual GVNames.GetEntryInfo ¬ NARROW[info];
IF giveDetails 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] ];
IF DecodePassword[d, i.password] THEN d.out.PutF["\nPassword (text): \"%g\"",
[rope[RopeFromPassword[i.password]]]];
};
d.out.PutF["\nConnect: \"%g\"", [rope[i.connect]] ];
IF giveDetails THEN d.out.PutF[", %g", Stamp[i.connectStamp]];
IF giveDetails OR i.forward.current # NIL
THEN TypeEntryList[d, i.forward, "Forwarding",
IF giveDetails THEN details ELSE members];
TypeEntryList[d, i.sites, "Mailboxes", IF giveDetails THEN details ELSE members];
};
info.type = group => {
i: REF group GVNames.GetEntryInfo ¬ NARROW[info];
subList: ROPE ¬ GetGVSubList[i.members.current];
IF subList # NIL THEN d.out.PutRope[" ...Top level list ... "];
IF what # members AND what # finks THEN d.out.PutF["\nRemark: \"%g\"", [rope[i.remark]] ];
IF giveDetails THEN d.out.PutF[", %g", Stamp[i.remarkStamp]];
IF what = finks THEN TypeFinks[d, i.members.current]
ELSE TypeEntryList[d, i.members, "Members", what, subList # NIL];
IF what # members AND what # finks THEN {
TypeEntryList[d, i.owners, "Owners", IF giveDetails THEN details ELSE members];
TypeEntryList[d, i.friends, "Friends", IF giveDetails THEN details ELSE members];
};
IF subList # NIL THEN DoGVEnquiry[d: d, name: subList, what: what];
};
info.type = dead => NULL;
ENDCASE => {
IO.PutRope[d.out, " => "];
TypeRC[d, rc, ReadEntry, name, NIL];
};
IF d.stop THEN { IO.PutRope[d.out, "Stopping...\n"]};
};
DoIsMember: PROC [d: MyData, name, args: ROPE, what: What] = {
extent: ROPE ¬ IF what = extended THEN "" ELSE "DIRECT ";
answer: GVNames.Membership;
ForEach: PROC [thisArg: ROPE] = {
answer ¬ GVNames.IsInList[
name,
thisArg,
IF what = extended THEN upArrow ELSE direct,
self,
members];
SELECT answer FROM
yes =>
IF what = occurrences
THEN {
IF d.firstTime
THEN d.firstTime ¬ FALSE
ELSE d.out.PutF[", "];
d.out.PutF["%g", [rope[name]]];
}
ELSE d.out.PutF["\n\"%g\" IS a %gmember of \"%g\".", [rope[thisArg]], [rope[extent]], [rope[name]]];
no => IF what # occurrences THEN d.out.PutF["\n\"%g\" is NOT a %gmember of \"%g\".", [rope[thisArg]], [rope[extent]], [rope[name]]];
notGroup => IF what # occurrences THEN d.out.PutF["\n\"%g\" is NOT group.", [rope[name]]];
allDown => d.out.PutF["\nError: allDown."];
ENDCASE => ERROR;
};
NewCallForItems[d, args, ForEach];
};
DoType: PROC [d: MyData, cb: CmdButton, name, args: ROPE] = {
EnumerateRegistries: PROC [pattern: ROPE] = {
sep: ROPE ¬ NIL;
d.out.PutF["\nRegistries matching \"%g\": ", [rope[name]]];
TRUSTED {
info: GVNames.MemberInfo = GVNames.GetMembers["Groups.gv"];
{
WITH i: info SELECT FROM
notFound => d.out.PutF["Error: .gv registry not found."];
noChange, individual => d.out.PutRope["Error: ???"];
allDown => d.out.PutF["Error: allDown"];
group => {
FOR l: GVNames.RListHandle ¬ i.members, l.rest UNTIL l = NIL DO
IF Rope.Match[pattern, l.first, FALSE] THEN {
d.out.PutF["%g%g", [rope[sep]], [rope[MaintainMisc.SplitGvName[l.first].sn]]];
IF sep = NIL THEN sep ¬ ", ";
};
ENDLOOP;
IF sep = NIL THEN d.out.PutRope["no matches."];
};
ENDCASE => ERROR; };
};
};
ShowMapping: PROC [gvName: ROPE] = {
nsName: ROPE;
namePart, regPart: ROPE;
nsName ¬ GvNsMap.NsFromGvName[gvName, gvToNs];
[namePart, regPart] ¬ MaintainMisc.SplitGvName[gvName];
namePart ¬ QuoteIfNeeded[namePart];
IF nsName # NIL THEN {
d.out.PutF["\n%g.%g maps to the %gNS name \"%g\"",
[rope[namePart]],
[rope[regPart]],
[rope[IF ~d.verbose
THEN ""
ELSE IF CheckNsNameRope[nsName]
THEN "valid "
ELSE "invalid "]],
[rope[nsName]]];
RETURN;
};
nsName ¬ GvNsMap.NsFromGvName[gvName, nsToGv];
IF nsName # NIL THEN {
d.out.PutF["\n%g.%g is %g GV name mapped by the NS name \"%g\"",
[rope[namePart]],
[rope[regPart]],
[rope[IF ~d.verbose
THEN "a"
ELSE IF GVNames.CheckStamp[gvName] = notFound
THEN "an invalid"
ELSE "a valid"]],
[rope[nsName]]];
RETURN;
};
d.out.PutF["\nNo mapping exists for %g.%g", [rope[namePart]], [rope[regPart]]];
};
SELECT cb.what FROM
matches, members, summary, details, finks, deadMatches, deadDetails
=> DoGVEnquiry[d, name, cb.what];
domains => EnumerateRegistries[name];
mapping => ShowMapping[name];
organizations => NotValidInGvMode[d, cb.what];
ENDCASE => NotImplementedYet[d];
};
NewCallForItems: PROC [d: MyData, names: ROPE, proc: PROC [ROPE], evenIfNull: BOOL ¬ FALSE] = {
NewProc: PROC [thisName: ROPE] = {
IF d.mode = dwim THEN {
thisNameGv: ROPE ¬ GvNsMap.GvFromNsName[thisName, nsToGv];
IF thisNameGv = NIL AND MaintainMisc.ModeOfName[thisName, d] = ns
THEN thisNameGv ¬ GvNsMap.GvFromNsName[thisName, gvToNs];
IF thisNameGv # NIL THEN {
namePart, regPart: ROPE;
[namePart, regPart] ¬ MaintainMisc.SplitGvName[thisNameGv];
namePart ¬ QuoteIfNeeded[namePart];
thisNameGv ¬ Rope.Cat[namePart, ".", regPart];
};
IF IsGvName[thisNameGv] THEN {
d.out.PutF["\n... mapping: \"%g\" => %g ... ", [rope[thisName]], [rope[thisNameGv]]];
thisName ¬ thisNameGv;
};
};
proc[thisName];
};
MaintainMisc.CallForItems[d, names, NewProc, evenIfNull];
};
CheckNsName: PROC [name: XNSCH.Name] RETURNS[ok: BOOL ¬ TRUE] = {
c: XNSCH.Conversation ¬ XNSCH.InitiateConversation[];
[] ¬ XNSCH.Lookup[c, name
! XNSCH.Error => {ok ¬ FALSE; CONTINUE}];
XNSCH.TerminateConversation[c];
};
CheckNsNameRope: PROC [name: ROPE] RETURNS[BOOL] = {
RETURN[CheckNsName[XNSCHName.NameFromRope[name
! XNSCHName.FieldTooLong => {RESUME;}]]];
};
GetNameClass: PROC [name: ROPE] RETURNS [Class] = {
si: GVNames.StampInfo ¬ GVNames.CheckStamp[name];
SELECT si FROM
group => RETURN[group];
individual => RETURN[individual];
ENDCASE => RETURN[any];
};
GetGvNameType: PROC [d: MyData, cb: CmdButton] RETURNS [GVNames.NameType] = {
SELECT cb.class FROM
group => RETURN[group];
individual => RETURN[individual];
ENDCASE => RETURN[noChange];
};
GetGvRSOp: PROC [d: MyData, cb: CmdButton] RETURNS [GVNames.RSOperation] = {
RETURN [
SELECT cb.what FROM
password => ChangePassword,
individualRemark => ChangeConnect,
groupRemark => ChangeRemark,
self => IF cb.cmd = add THEN AddSelf ELSE DeleteSelf,
member => IF cb.cmd = add THEN AddMember ELSE DeleteMember,
owner => IF cb.cmd = add THEN AddOwner ELSE DeleteOwner,
friend => IF cb.cmd = add THEN AddFriend ELSE DeleteFriend,
mailbox => IF cb.cmd = add THEN AddMailBox ELSE DeleteMailBox,
forwarding => IF cb.cmd = add THEN AddForward ELSE DeleteForward,
createIndividual => CreateIndividual,
createGroup => CreateGroup,
delete => IF GetGvNameType[d, cb] = group THEN DeleteGroup ELSE DeleteIndividual,
newName => NewName,
ENDCASE => NoOp
];
};
UpdateOccurrences: PROC [d: MyData, cb: CmdButton, name, args: ROPE] = {
nArgs: CARD ¬ 0;
firstArg, secondArg: ROPE;
ReplaceMember: PROC [groupName, old, new: ROPE] = {
outcome: GVNames.Outcome;
user, password: ROPE;
name ¬ d.gvName;
password ¬ d.gvPassword;
d.out.PutF["\nRemoveMember[%g, %g] ...", [rope[groupName]], [rope[old]]];
outcome ¬ GVNames.RemoveMember[user, GVBasics.MakeKey[password], groupName, old];
SELECT outcome FROM
noChange => d.out.PutF[" noChange."];
group => {
d.out.PutF[" ok."];
AddMember[groupName, new];
};
allDown => d.out.PutF[" Error: allDown."];
ENDCASE => d.out.PutF[" Error: someError."];
};
RemoveOne: PROC [groupName, memberName: ROPE, op: GVNames.RSOperation] = {
outcome: GVNames.Outcome;
user, password: ROPE;
name ¬ d.gvName;
password ¬ d.gvPassword;
d.out.PutF["\nRemove%g[%g, %g] ...",
[rope[SELECT op FROM
DeleteMember => "Member",
DeleteOwner => "Owner",
DeleteFriend => "Friend",
ENDCASE => ERROR]],
[rope[groupName]],
[rope[memberName]]];
outcome ¬ GVNames.Update[user, GVBasics.MakeKey[password], op, groupName, memberName];
SELECT outcome FROM
noChange => d.out.PutF[" noChange."];
group => d.out.PutF[" ok."];
allDown => d.out.PutF[" Error: allDown."];
ENDCASE => d.out.PutF[" Error: someError."];
};
AddMember: PROC [groupName, memberName: ROPE] = {
DoUpdate[d, group, AddMember, groupName, memberName];
};
SELECT cb.cmd FROM
set => {
IF d.nArgs # 2 THEN {
d.out.PutF["\nYou must provide%g two arguments: oldName, newName", [rope[IF nArgs > 2 THEN " only" ELSE ""]]];
d.stop ¬ TRUE;
RETURN;
};
ReplaceMember[name, firstArg, secondArg];
};
remove => {
RemoveName: PROC [removeThis: ROPE] = {
RemoveOne[name, removeThis, DeleteMember];
RemoveOne[name, removeThis, DeleteOwner];
RemoveOne[name, removeThis, DeleteFriend];
};
RemoveMatches: PROC [removeThis: ROPE] = {
FOR type: GVNames.ListType IN [members..friends] DO
info: GVNames.MemberInfo = GVNames.GetList[name, GVNames.oldestTime, type, NIL];
TRUSTED {
WITH i: info SELECT FROM
notFound => d.out.PutF["%g not found.", [rope[name]]];
noChange, individual => d.out.PutF["%g noChange or individual.", [rope[name]]];
allDown => d.out.PutF["Error: allDown"];
group => {
FOR l: GVNames.RListHandle ¬ i.members, l.rest UNTIL l = NIL OR d.stop DO
IF Rope.Match[removeThis, l.first, FALSE] THEN
RemoveOne[
name,
l.first,
SELECT type FROM
members => DeleteMember,
owners => DeleteOwner,
friends => DeleteFriend,
ENDCASE => ERROR];
ENDLOOP;
};
ENDCASE => ERROR;
};
ENDLOOP;
};
FOR list: LIST OF ROPE ¬ d.argList, list.rest UNTIL list = NIL OR d.stop DO
IF Rope.Find[list.first, "*"] >= 0
THEN RemoveMatches[list.first]
ELSE RemoveName[list.first];
ENDLOOP;
};
ENDCASE => NotImplementedYet[d];
};
DoMyUpdate: PROC [d: MyData, cb: CmdButton, name, args: ROPE] = {
IF cb.what = delete THEN cb.class ¬ GetNameClass[name];
SELECT cb.what FROM
occurrences => UpdateOccurrences[d, cb, name, args];
ENDCASE => DoUpdate[d, GetGvNameType[d, cb], GetGvRSOp[d, cb], name, args];
};
GetGVSubList: PROC [list: GVNames.RListHandle] RETURNS[ROPE] = {
A top-level list is one all of whose members are either GV or NS sublists. We return the last GV sublist member if this is a top-level list and NIL otherwise.
gvSubList: ROPE ¬ NIL;
FOR c: GVNames.RListHandle ¬ list, c.rest UNTIL c = NIL DO
IF IsGVSublist[c.first] THEN
gvSubList ¬ c.first
ELSE IF NOT IsNSSublist[c.first] THEN
RETURN[NIL];
ENDLOOP;
RETURN[gvSubList];
};
IsGVSublist: PROC [r: ROPE] RETURNS[BOOLEAN] = {
RETURN[Rope.Find[r, "-GV^.", 0, FALSE] # -1];
};
GetNSSubList: PROC [list: GVNames.RListHandle] RETURNS[ROPE] = {
A top-level list is one all of whose members are either GV or NS sublists. We return the last NS sublist member if this is a top-level list and NIL otherwise.
nsSubList: ROPE ¬ NIL;
FOR c: GVNames.RListHandle ¬ list, c.rest UNTIL c = NIL DO
IF IsNSSublist[c.first] THEN
nsSubList ¬ c.first
ELSE IF NOT IsGVSublist[c.first] THEN
RETURN[NIL];
ENDLOOP;
RETURN[nsSubList];
};
IsNSSublist: PROC [r: ROPE] RETURNS[BOOLEAN] = {
RETURN[Rope.Find[r, "-NS.", 0, FALSE] # -1];
};
IsNSName: PROC [name: ROPE] RETURNS[BOOLEAN] = {
RETURN[name # NIL AND (Rope.Find[name, "@"] < 0)];
};
IsGvName: PROC [name: ROPE] RETURNS[BOOLEAN] = {
RETURN[name # NIL];
};
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: What, 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: What, 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 ¬ GvNsMap.NsFromGvName[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 ¬ GvNsMap.NsFromGvName[who];
SELECT TRUE FROM
IsNSName[nsName] => {
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]]] ];
};
******** Update operations ******** --
UpdateOp: TYPE = REF UpdateOpRec;
UpdateOpRec: TYPE = RECORD[
d: MyData,
op: GVNames.RSOperation ];
DoUpdate: PROC [d: MyData, expected: GVNames.NameType, op: GVNames.RSOperation, target: GVBasics.RName, value: GVBasics.GVString] = {
EnumerateValue: PROC [rope1: ROPE] = {
AddDeleteOne: PROC [rope2: ROPE] = {
DoOneUpdate[d, expected, op, rope1, rope2];
};
NewCallForItems[d, value, AddDeleteOne, TRUE];
};
UpdateSelf: PROC [rope: ROPE] = {
DoOneUpdate[d, expected, op, rope, NIL];
};
d.stop ¬ FALSE;
SELECT op FROM
AddSelf, DeleteSelf => UpdateSelf[target];
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 =>
EnumerateValue[target];
ENDCASE => ERROR;
};
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;
user ¬ d.gvName;
password ¬ d.gvPassword;
Log command --
IO.PutF[d.out, "\n%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];
ChangeRemark, ChangeConnect => {
maxRemark: INT = 64;
IF Rope.Length[value] > maxRemark THEN {
value ¬ Rope.Substr[value, 0, maxRemark];
d.out.PutF["... truncating remark to %g characters (\"%g\") ... ",
[integer[maxRemark]],
[rope[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 ¬ GvNsMap.NsFromGvName[value];
nsList, topList: ROPE;
IF IsNSName[nsName] 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.NsFromGvName[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 ¬ 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"]
EXITS Bad => {
IO.PutRope[d.out, "Error => "];
TypeRC[d, outcome, op, target, value];
};
};
IF d.stop THEN { IO.PutRope[d.out, "Stopping...\n"]};
};
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­ # $on
THEN { IO.PutRope[d.out, "(invalid) ... "]; RETURN[TRUE] };
IO.PutF[d.out, "\"%g\" is not a valid name", [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 ~MaintainMisc.Verify[d] THEN { IO.PutRope[d.out, "(invalid) ... "]; RETURN[TRUE] }
ELSE {
IO.PutF[d.out, "\"%g\" is not a mail server", [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."];
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."];
RETURN[FALSE];
};
NeedsQuotes: PROC [r: ROPE] RETURNS [BOOL] ~ {
IF Rope.Length[r] = 0 OR (Rope.Find[r, "\""] < 0 AND Rope.Find[r, " "] >= 0) THEN RETURN [TRUE];
RETURN[FALSE];
};
QuoteIfNeeded: PROC [r: ROPE] RETURNS [ROPE] ~ {
IF NeedsQuotes[r] THEN RETURN [Rope.Cat["\"", r, "\""]];
RETURN[r];
};
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]];
};
******** SetServer operation ******** --
SetServerProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
d: MyData = NARROW[clientData];
name: ROPE = ViewerTools.GetContents[d.serverT];
name: ROPE;
IF ~CheckForm[clientData, name, "Host"] THEN RETURN;
DoSetServer[d, name];
};
DoSetServer: PUBLIC PROC [d: MyData, name: ROPE] = {
info: GVNames.SetServerInfo;
d.out.PutF["\nSetServer[%g] ... ", [rope[name]] ];
info ¬ GVNames.SetServer[name];
d.out.PutRope[SELECT info FROM
ok => "ok",
allDown => "can't look up name - allDown",
noRoute => "no route to that host at present",
badName => "bad server name",
ENDCASE => ERROR];
};
******** Miscellaneous sub-routines for the operations ******** --
CheckForm: SAFE PROC [clientData: REF, value, label: ROPE] RETURNS[ BOOL ] = {
d: MyData = NARROW[clientData];
IF Rope.Length[value] > 0 AND Rope.Fetch[value, 0] = ' THEN {
IO.PutF[d.out, "\nPlease fill in the \"%g\" field", [rope[label]] ];
RETURN[FALSE] }
ELSE RETURN[TRUE]
};
TypeRC: PROC
[d: MyData, info: GVNames.Outcome, op: GVNames.RSOperation, name: ROPE, value: ROPE] = {
create: BOOL = SELECT op FROM
CreateIndividual, CreateGroup => TRUE,
ENDCASE => FALSE;
SELECT info FROM
group, individual =>
IO.PutF[d.out, "%g is %ga%g",
[rope[name]],
[rope[IF create THEN "already " ELSE NIL]],
[rope[IF info = group THEN " group" ELSE "n individual"]] ];
notFound =>
IO.PutF[d.out, "%g %g",
[rope[name]],
[rope[SELECT TRUE FROM
Rope.Find[name, "."] < 0 => "needs an explicit registry",
create => "has an invalid registry or is recently deleted",
GvNsMap.NsFromGvName[name] # NIL => Rope.Cat["maps to the NS name \"", GvNsMap.NsFromGvName[name], "\""],
ENDCASE => "doesn't exist."]]];
protocolError =>
IO.PutF[d.out, "protocol error - consult expert." ];
wrongServer =>
IO.PutF[d.out, "wrong server - consult expert." ];
allDown =>
IO.PutF[d.out, "couldn't contact needed server. Try later." ];
badPwd =>
IO.PutF[d.out, "your password is now incorrect. Please login again." ];
outOfDate =>
IO.PutF[d.out, "there's newer information in the database - consult expert." ];
notAllowed =>
IO.PutF[d.out, "you're not allowed to do that - ask an administrator to help you." ];
noChange => {
IsFooOfBaz: PROC [s: ROPE] =
{ IO.PutF[d.out, "\"%g\" is %g of \"%g\"",
[rope[value]], [rope[s]], [rope[name]] ] };
SELECT op FROM
CreateIndividual, CreateGroup =>
IO.PutF[d.out, "\"%g\" already exists", [rope[name]] ];
AddMember => IsFooOfBaz["already a member"];
AddMailBox => IsFooOfBaz["already a mailbox-site"];
AddForward => IsFooOfBaz["already a forwardee"];
AddOwner => IsFooOfBaz["already an owner"];
AddFriend => IsFooOfBaz["already a friend"];
DeleteMember => IsFooOfBaz["not a member"];
DeleteMailBox => IsFooOfBaz["not a mailbox-site"];
DeleteForward => IsFooOfBaz["not a forwardee"];
DeleteOwner => IsFooOfBaz["not an owner"];
DeleteFriend => IsFooOfBaz["not a friend"];
AddSelf =>
IO.PutF[d.out, "you're already a member of \"%g\"", [rope[name]]];
DeleteSelf =>
IO.PutF[d.out, "you're not a member of \"%g\"", [rope[name]]];
ENDCASE =>
IO.PutF[d.out, "no-change: consult LaurelSupport.pa."];
};
ENDCASE =>
IO.PutF[d.out, "unknown return code!"];
};
DecodePassword: PROC [d: MyData, password: GVBasics.Password] RETURNS [BOOL] = {
-- the only way the password will be non-zero is if the current user is in .gv (probably wizard.gv) AND has recently done an IdentifyCaller operation (ie, tried to do an update).
RETURN [d.verbose AND password # [0, 0, 0, 0]];
};
RopeFromPassword: PROC [password: GVBasics.Password] RETURNS [r: ROPE] = {
AppendByte: PROC [b: BYTE] = {
c: CHAR ¬ LOOPHOLE[b];
SELECT TRUE FROM
(c > ' AND c <= '~) => r ¬ Rope.Cat[r, Rope.FromChar[c]];
ENDCASE => r ¬ Rope.Cat[r, IO.PutFR["\\%03b", [cardinal[b]]]];
};
FOR i: CARDINAL IN [0..4) DO
word: Basics.ShortNumber;
word.sc ¬ password[i];
AppendByte[word.hi/2];
AppendByte[word.lo/2];
ENDLOOP;
};
}.