GluePruneHacksImpl:
CEDAR
MONITOR
IMPORTS CHOpsP2V3, CrRPC, IO, Rope, XNSAuth, XNSCH, XNSCHName
EXPORTS GluePruneHacks
= {
OPEN CHEntriesP0V0;
ROPE: TYPE = Rope.ROPE;
RopeList: TYPE = GluePruneHacks.RopeList;
Conversation: TYPE = GluePruneHacks.Conversation;
ConversationObject: TYPE = GluePruneHacks.ConversationObject;
VerifyList: TYPE = GluePruneHacks.VerifyList;
VerifyInfo: TYPE = GluePruneHacks.VerifyInfo;
VerifyInfoObject:
TYPE = GluePruneHacks.VerifyInfoObject;
Cache: TYPE = GluePruneHacks.Cache;
CacheEntryList: TYPE = GluePruneHacks.CacheEntryList;
CacheEntry: TYPE = GluePruneHacks.CacheEntry;
CacheEntryObject:
TYPE = GluePruneHacks.CacheEntryObject;
EditOperation: TYPE = GluePruneHacks.EditOperation;
EditList: TYPE = GluePruneHacks.EditList;
Edit: TYPE = GluePruneHacks.Edit;
EditObject:
TYPE = GluePruneHacks.EditObject;
serverAddressToAsk: XNS.Address ¬ XNS.unknownAddress;
editConversation: XNSCH.Conversation ¬ XNSCH.InitiateConversation[NIL, serverAddressToAsk];
chServers: ROPE = "CHServers";
domainsForServerCache: Cache ¬ NEW[CacheEntryList];
serversForDomainCache: Cache ¬ NEW[CacheEntryList];
FlushDomainsForServerCache:
PUBLIC ENTRY PROC = {
domainsForServerCache ¬ NIL;
};
FlushServersForDomainCache:
PUBLIC
ENTRY PROC = {
serversForDomainCache ¬ NIL;
};
RopeToFull:
PUBLIC
PROC [name:
ROPE]
RETURNS [rope:
ROPE, nsName:
XNSCH.Name, ok:
BOOL ¬
TRUE] = {
nsName ¬ XNSCHName.NameFromRope[name, chServers, chServers
! XNSCHName.FieldTooLong => {ok ¬ FALSE; CONTINUE}];
rope ¬ XNSCHName.RopeFromName[nsName];
};
SetServerToAsk:
PUBLIC
PROC [server:
ROPE ¬
NIL] = {
serverAddressToAsk ¬
IF server =
NIL
THEN XNS.unknownAddress
ELSE XNSCH.LookupAddressFromRope[RopeToFull[server].rope].address;
};
AddRopeToList:
PUBLIC
PROC [rope:
ROPE, list: RopeList]
RETURNS [RopeList] = {
IF RopeInList[rope, list] THEN RETURN[list]; -- already in list
RETURN[CONS[rope, list]];
};
RopeInList:
PUBLIC
PROC [rope:
ROPE, list: RopeList]
RETURNS [
BOOL] = {
FOR temp: RopeList ¬ list, temp.rest
WHILE temp #
NIL
DO
IF Rope.Equal[rope, temp.first, FALSE] THEN RETURN[TRUE]; -- already in list
ENDLOOP;
RETURN[FALSE];
};
FindCacheEntry:
INTERNAL
PROC [cache: Cache, key:
ROPE]
RETURNS [CacheEntry] = {
FOR temp: CacheEntryList ¬ cache, temp.rest
WHILE temp #
NIL
DO
IF Rope.Equal[key, temp.first.key, FALSE] THEN RETURN[temp.first];
ENDLOOP;
RETURN[NIL];
};
LockedFindCacheEntry:
ENTRY
PROC [cache: Cache, key:
ROPE]
RETURNS [CacheEntry] = {
RETURN[FindCacheEntry[cache, key]];
};
AddToCache:
ENTRY
PROC [cache: Cache, entry: CacheEntry]
RETURNS [
BOOL] = {
IF FindCacheEntry[cache, entry.key] # NIL THEN RETURN[FALSE];
cache ¬ CONS[entry, cache];
RETURN[TRUE]
};
AddToCacheValue:
ENTRY
PROC [cache: Cache, key, additionalValue:
ROPE]
RETURNS [
BOOL] = {
ce: CacheEntry ¬ FindCacheEntry[cache, key];
IF ce = NIL THEN RETURN[FALSE];
ce.value ¬ AddRopeToList[additionalValue, ce.value];
RETURN[TRUE]
};
AddToCacheValueAndCreateIfNeeded:
PROC [cache: Cache, key, additionalValue:
ROPE, ok:
BOOL ¬
TRUE, reason:
XNSCH.ErrorCode ¬ unknown]
RETURNS [
BOOL] = {
added: BOOL ¬ AddToCacheValue[cache, key, additionalValue];
IF added THEN RETURN[TRUE];
RETURN[AddToCache[cache, NEW[CacheEntryObject ¬ [key, LIST[additionalValue]]]]];
};
GoodReason:
PUBLIC
PROC [reason:
XNSCH.ErrorCode]
RETURNS [
BOOL] = {
RETURN[
SELECT reason
FROM
illegalOrganizationName, illegalDomainName, illegalObjectName,
noSuchOrganization, noSuchDomain, noSuchObject => TRUE,
ENDCASE => FALSE];
};
DomainsForServer:
PUBLIC
PROC [server:
ROPE]
RETURNS [ce: CacheEntry] = {
ce ¬ LockedFindCacheEntry[domainsForServerCache, server];
IF ce # NIL AND (ce.ok OR GoodReason[ce.reason] ) THEN RETURN;
ce ¬ NEW[CacheEntryObject ¬ [server, NIL]];
[ce.value, ce.ok, ce.reason] ¬ LearnDomainsServed[server];
[] ¬ AddToCache[domainsForServerCache, ce];
FOR domains: RopeList ¬ ce.value, domains.rest
WHILE domains #
NIL
DO
[] ¬ AddToCacheValueAndCreateIfNeeded[serversForDomainCache, domains.first, server];
ENDLOOP;
RETURN;
};
ServersForDomain:
PUBLIC
ENTRY
PROC [domain:
ROPE]
RETURNS [ce: CacheEntry] = {
RETURN[FindCacheEntry[serversForDomainCache, domain]];
};
ServerServesDomain:
PUBLIC
PROC [server, domain:
ROPE]
RETURNS [yes:
BOOL, ce: CacheEntry] = {
ce ¬ DomainsForServer[server];
RETURN[RopeInList[domain, ce.value], ce];
};
LearnDomainsServed:
PUBLIC
PROC [chsName:
ROPE]
RETURNS [domains: RopeList, ok:
BOOL ¬
TRUE, reason:
XNSCH.ErrorCode] ~ {
name: XNSCH.Name;
adr: XNS.Address;
c: Conversation ¬ NEW[ ConversationObject ¬ [] ];
h: CrRPC.Handle;
refAdr: REF XNS.Address ¬ NEW[XNS.Address];
listOfDomains: RopeList;
firstTime: BOOL ¬ FALSE;
ReadStreamOfDomainNames: CrRPC.BulkDataXferProc
[h: Handle, s: IO.STREAM, checkAbort: BulkDataCheckAbortProc] RETURNS [abort: BOOL];
~ {
EachDomainNameInStream: CrRPC.BulkDataValueProc
[s: IO.STREAM] RETURNS [abort: BOOL ← FALSE]
~ {
domPart, orgPart: ROPE;
orgPart ¬ CrRPC.GetRope[s];
domPart ¬ CrRPC.GetRope[s];
listOfDomains ¬ AddRopeToList[Rope.Cat[domPart, ":", orgPart, ":", chServers], listOfDomains];
listOfDomains ¬ AddRopeToList[Rope.Cat[orgPart, ":", chServers, ":", chServers], listOfDomains];
listOfDomains ¬ AddRopeToList[Rope.Cat[chServers, ":", chServers, ":", chServers], listOfDomains];
};
RETURN [CrRPC.ReadBulkDataStream[h, s, checkAbort, EachDomainNameInStream]];
};
[chsName, name, ok] ¬ RopeToFull[chsName];
IF ~ok THEN RETURN[NIL, ok, inappropriateConversation];
adr ¬ XNSCH.LookupAddressFromRope[chsName].address;
IF adr =
XNS.unknownAddress
THEN {
c: XNSCH.Conversation ¬ XNSCH.InitiateConversation[NIL, serverAddressToAsk];
[, adr] ¬
XNSCH.LookupAddress[c, name
! XNSCH.Error => {reason ¬ code; ok ¬ FALSE; CONTINUE}];
XNSCH.TerminateConversation[c];
IF ~ok THEN RETURN[NIL, FALSE, reason];
};
refAdr ¬ adr;
c.conversation ¬ XNSAuth.Initiate[XNSAuth.GetNullIdentity[], ["CHServers", "CHServers", "Clearinghouse Service"]];
h ¬ CrRPC.CreateClientHandle[$SPP, refAdr];
CHOpsP2V3.ListDomainsServed[h, ReadStreamOfDomainNames,
[XNSAuth.GetCredentials[c.conversation],
XNSAuth.GetNextVerifier[c.conversation]] !
CrRPC.Error => {ok ¬ FALSE; reason ¬ MapCrRPCError[errorReason]; CONTINUE};
CHOpsP2V3.CallError => {ok ¬ FALSE; reason ¬ unknown; CONTINUE}
];
XNSAuth.Terminate[c.conversation];
RETURN[listOfDomains, ok, reason];
};
MapCrRPCError:
PUBLIC
PROC [er: CrRPC.ErrorReason]
RETURNS [
XNSCH.ErrorCode] = {
RETURN[
SELECT er
FROM
communicationFailure => communicationFailure,
ENDCASE => unknown];
};
VerifyDomainsForServer:
PUBLIC
PROC [server:
ROPE]
RETURNS [vi: VerifyInfo ¬
NEW[VerifyInfoObject]] = {
domainsServed: RopeList;
yes: BOOL;
ce: CacheEntry;
c: XNSCH.Conversation;
serverName: XNSCH.Name;
vi.name ¬ server;
[server, serverName, vi.ok] ¬ RopeToFull[server];
IF ~vi.ok THEN RETURN;
vi.name ¬ server;
ce ¬ DomainsForServer[server];
domainsServed¬ ce.value;
vi.ok ¬ ce.ok;
IF ~vi.ok THEN { vi.ok ¬ FALSE; RETURN; };
c ¬ XNSCH.InitiateConversation[identity: NIL, server: serverAddressToAsk];
FOR thisDomain: RopeList ¬ domainsServed, thisDomain.rest
WHILE thisDomain #
NIL
DO
vi.ok ¬ TRUE;
[ , yes] ¬
XNSCH.IsMember[c, XNSCHName.NameFromRope[thisDomain.first], members, serverName
! XNSCH.Error => {vi.ok ¬ FALSE; CONTINUE}];
SELECT
TRUE
FROM
~vi.ok => vi.unverified ¬ AddRopeToList[thisDomain.first, vi.unverified];
yes => vi.correct ¬ AddRopeToList[thisDomain.first, vi.correct];
~yes => vi.incorrect ¬ AddRopeToList[thisDomain.first, vi.incorrect];
ENDCASE;
ENDLOOP;
XNSCH.TerminateConversation[c];
RETURN;
};
VerifyServersForDomain:
PUBLIC
PROC [domain:
ROPE]
RETURNS [vi: VerifyInfo ¬
NEW[VerifyInfoObject]] = {
AddNameToServers:
PROC [name:
XNSCH.Name] = {
servers ¬ AddRopeToList[XNSCHName.RopeFromName[name], servers];
};
servers: RopeList;
yes: BOOL;
c: XNSCH.Conversation;
domainName: XNSCH.Name;
ce: CacheEntry;
vi.name ¬ domain;
[domain, domainName, vi.ok] ¬ RopeToFull[domain];
IF ~vi.ok THEN RETURN;
vi.name ¬ domain;
servers ¬ NIL;
c ¬ XNSCH.InitiateConversation[identity: NIL, server: serverAddressToAsk];
[] ¬
XNSCH.ListMembers[c, domainName, members, AddNameToServers
! XNSCH.Error => {vi.ok ¬ FALSE; CONTINUE}];
XNSCH.TerminateConversation[c];
IF ~vi.ok THEN RETURN;
FOR thisServer: RopeList ¬ servers, thisServer.rest
WHILE thisServer #
NIL
DO
[ yes, ce] ¬ ServerServesDomain[thisServer.first, domain];
SELECT
TRUE
FROM
~ce.ok => {
IF GoodReason[ce.reason]
THEN vi.incorrect ¬ AddRopeToList[thisServer.first, vi.incorrect]
ELSE vi.unverified ¬ AddRopeToList[thisServer.first, vi.unverified];
};
yes => vi.correct ¬ AddRopeToList[thisServer.first, vi.correct];
~yes => vi.incorrect ¬ AddRopeToList[thisServer.first, vi.incorrect];
ENDCASE;
ENDLOOP;
RETURN;
};
VerifyDomainsForServersList:
PUBLIC
PROC [servers: RopeList]
RETURNS [list:
LIST
OF VerifyInfo] = {
FOR servers ¬ servers, servers.rest
WHILE servers #
NIL
DO
list ¬ CONS[VerifyDomainsForServer[servers.first], list];
ENDLOOP;
};
VerifyServersForDomain
sList:
PUBLIC
PROC [domains: RopeList]
RETURNS [list:
LIST
OF VerifyInfo] = {
FOR domains ¬ domains, domains.rest
WHILE domains #
NIL
DO
list ¬ CONS[VerifyServersForDomain[domains.first], list];
ENDLOOP;
};
EditListFromVerifyList:
PUBLIC
PROC [verifyList: VerifyList, op: EditOperation]
RETURNS [editList: EditList] = {
edit: Edit;
FOR verifyList ¬ verifyList, verifyList.rest
WHILE verifyList #
NIL
DO
edit ¬ EditFromVerifyInfo[verifyList.first, op];
IF edit.arguments #
NIL
AND edit.operation # noop
THEN editList ¬ CONS[edit, editList];
ENDLOOP;
};
EditFromVerifyInfo:
PUBLIC
PROC [vi: VerifyInfo, op: EditOperation]
RETURNS [edit: Edit] = {
edit ¬ NEW[EditObject ¬ [operation: noop]];
IF vi #
NIL
THEN edit ¬ [
operation: op,
name: vi.name,
arguments: vi.incorrect];
};
DoEdits:
PUBLIC
PROC [editList: EditList] = {
FOR editList ¬ editList, editList.rest
WHILE editList #
NIL
DO
DoEdit[editList.first];
ENDLOOP;
};
DoEdit:
PUBLIC
PROC [edit: Edit] = {
ok: BOOL ¬ TRUE;
result: ROPE;
FOR argList: RopeList ¬ edit.arguments, argList.rest
WHILE argList #
NIL
DO
[ok, result] ¬ DoOneEdit[edit.operation, edit.name, argList.first];
IF ok
THEN edit.okResults ¬ CONS[result, edit.okResults]
ELSE edit.badResults ¬ CONS[result, edit.badResults];
ENDLOOP;
};
DoOneEdit:
PUBLIC
PROC [op: EditOperation, name, arg:
ROPE]
RETURNS [ok:
BOOL ¬
TRUE, result:
ROPE] = {
errorRope, fullName, fullArg: ROPE;
nsName, nsArg: XNSCH.Name;
[fullName, nsName, ok] ¬ RopeToFull[name];
IF ~ok THEN result ¬ "Bad name.";
[fullArg, nsArg, ok] ¬ RopeToFull[arg];
IF ~ok THEN result ¬ "Bad arg.";
IF ~ok THEN RETURN;
{
ENABLE
XNSCH.Error => {ok ¬ FALSE; errorRope ¬ ExposeErrorCode[code]; GOTO chError};
SELECT op
FROM
noop => NULL;
addMember => {
result ¬ IO.PutFR["AddMember \"%g\" to \"%g\" ... ", [rope[fullArg]], [rope[fullName]]];
[] ¬ XNSCH.AddMember[editConversation, nsName, members, nsArg];
};
deleteMember => {
result ¬ IO.PutFR["DeleteMember \"%g\" from \"%g\" ... ", [rope[arg]], [rope[fullName]]];
[] ¬ XNSCH.DeleteMember[editConversation, nsName, members, nsArg];
};
deleteObject => {
result ¬ IO.PutFR1["DeleteObject \"%g\" ... ", [rope[fullName]]];
XNSCH.Delete[editConversation, nsName];
};
ENDCASE;
};
IF ok
THEN result ¬ Rope.Concat[result, "done."]
ELSE result ¬ Rope.Cat[result, "ERROR => ", errorRope];
};
ExposeErrorCode:
PUBLIC
PROC [arg:
XNSCH.ErrorCode]
RETURNS [res:
ROPE] ~ {
SELECT arg
FROM
notAllowed => res ¬ "notAllowed";
allDown => res ¬ "allDown";
wasUpNowDown => res ¬ "wasUpNowDown";
protocolError => res ¬ "protocolError";
cantConnectToServer => res ¬ "cantConnectToServer";
communicationFailure => res ¬ "communicationFailure";
serverTooBusy => res ¬ "serverTooBusy";
serviceNotExported => res ¬ "serviceNotExported";
illegalPropertyID => res ¬ "illegalPropertyID";
illegalOrganizationName => res ¬ "illegalOrganizationName";
illegalDomainName => res ¬ "illegalDomainName";
illegalObjectName => res ¬ "illegalObjectName";
noSuchOrganization => res ¬ "noSuchOrganization";
noSuchDomain => res ¬ "noSuchDomain";
noSuchObject => res ¬ "noSuchObject";
propertyIDNotFound => res ¬ "propertyIDNotFound";
wrongPropertyType => res ¬ "wrongPropertyType";
noChange => res ¬ "noChange";
outOfDate => res ¬ "outOfDate";
overflowOfName => res ¬ "overflowOfName";
overflowOfDataBase => res ¬ "overflowOfDataBase";
credentialsInvalid => res ¬ "credentialsInvalid";
credentialsTooWeak => res ¬ "credentialsTooWeak";
inappropriateConversation => res ¬ "inappropriateConversation";
unknown => res ¬ "unknown";
ENDCASE => ERROR
};