-- Copyright (C) 1981, 1984, 1985 by Xerox Corporation. All rights reserved.
-- RegAccess.mesa, Transport Mechanism Registration Server - Access to entries.
-- HGM, 15-Sep-85 3:59:01
-- Andrew Birrell 17-Jul-81 13:48:50
-- Hankins 13-Aug-84 8:19:25 (Klamath update - remove STOPs)
DIRECTORY
BodyDefs USING [maxRNameLength, RName, Timestamp],
HeapDefs USING [
HeapAbandonWrite, HeapEndRead, ObjectOffset, objectStart, ReaderHandle,
SetReaderOffset, WriterHandle],
LocalNameDefs USING [ReadRSName],
LogDefs USING [ShowLine],
ProtocolDefs USING [ReturnCode, RNameType],
RegAccessDefs USING [NameState],
RegBTreeDefs USING [
Insert, KnownRegistry, Lookup, LookupReason, RegistryObject, RegState,
TestKnownReg, UpdateFailed],
RegistryDefs USING [EnumerateRList],
RegServerDefs USING [EnumeratedMembers, IsInList, Membership, MembershipLevel],
SendDefs USING [
AddRecipient, AddToItem, Create, Destroy, Handle, StartItem, StartSend,
StartSendInfo, Send],
String USING [
AppendString, EquivalentStrings, EquivalentSubStrings, SubStringDescriptor];
RegAccess: MONITOR
IMPORTS
HeapDefs, LocalNameDefs, LogDefs, RegBTreeDefs, RegistryDefs, RegServerDefs,
SendDefs, String
EXPORTS RegAccessDefs =
BEGIN
EndsWith: PROC [s: LONG STRING, b: LONG STRING] RETURNS [BOOLEAN] =
BEGIN
pattern: String.SubStringDescriptor ← [b, 0, b.length];
target: String.SubStringDescriptor ← [s, s.length - b.length, b.length];
RETURN[
s.length >= b.length AND String.EquivalentSubStrings[@pattern, @target]]
END;
-- ================ Synchronization for Registry changes ================ --
-- This layer is concerned with the integrity of the "Registry" concept,
-- determining whether entries are in known registries and handling
-- changes in the set of known registries.
-- Under our monitor lock, Lookup determines whether this is the correct
-- R-Server for the lookup. All updates also go through the monitor
-- lock, and retry if we have become (or ceased to be) the correct
-- server for that registry. This includes the updates which alter our
-- set of registries. The BTree changes provoked by the RegPurger are
-- exempt from this.
Lookup: PUBLIC PROC [name: BodyDefs.RName, reason: RegBTreeDefs.LookupReason]
RETURNS [info: RegAccessDefs.NameState] =
BEGIN
IF EndsWith[name, ".GV"L] THEN -- avoid deadlocking recursion on updates to GV names --
BEGIN
treeInfo: RegBTreeDefs.RegistryObject = RegBTreeDefs.Lookup[name, reason];
info ← [
yes --Beware: BTree may not have knownReg bits yet! -- , treeInfo.type,
treeInfo.stamp, treeInfo.reader];
END
ELSE info ← InnerLookup[name, reason];
END;
InnerLookup: PUBLIC ENTRY PROC [
name: BodyDefs.RName, reason: RegBTreeDefs.LookupReason]
RETURNS [info: RegAccessDefs.NameState] =
BEGIN
treeInfo: RegBTreeDefs.RegistryObject = RegBTreeDefs.Lookup[name, reason];
info ← [yes, treeInfo.type, treeInfo.stamp, treeInfo.reader];
IF info.type = notFound THEN info.regState ← CheckReg[name];
END;
-- This module also contains a layer for producing MS internal mail.
-- For "Insert" where the old type was Individual, the old reader
-- is positioned to the mailbox site list.
-- To avoid problems at start-of-world, MS-mail is disabled in the early
-- stages of some restarts - see RegRestart.
OldReaderNeeded: ERROR = CODE;
CantCreateMSInternalMail: ERROR = CODE;
MSMailEnabled: BOOLEAN ← FALSE;
IsMSMailEnabled: ENTRY PROC RETURNS [BOOLEAN] = INLINE {RETURN[MSMailEnabled]};
Insert: PUBLIC PROCEDURE [
name: BodyDefs.RName, type: ProtocolDefs.RNameType,
stamp: POINTER TO BodyDefs.Timestamp, writer: HeapDefs.WriterHandle,
oldInfo: POINTER TO RegAccessDefs.NameState] RETURNS [done: BOOLEAN] =
BEGIN
-- compose any message to mail servers before destroying the old reader,
-- but we must commit the update before sending the mail (to avoid
-- remote possibility of M-Server reading mail and re-evaluating site
-- with old entry before we commit the update!).
IF oldInfo.type = individual AND IsMSMailEnabled[] THEN
BEGIN
humanHint: STRING = "MS Internal mail for R-Name "L;
myName: BodyDefs.RName;
myPassword: LONG STRING;
mail: SendDefs.Handle = SendDefs.Create[];
sendInfo: SendDefs.StartSendInfo;
[myName, myPassword, ] ← LocalNameDefs.ReadRSName[];
sendInfo ← SendDefs.StartSend[
handle: mail, sender: myName, senderPwd: myPassword,
returnTo: "DeadLetter.MS"L, validate: FALSE];
IF sendInfo # ok THEN ERROR CantCreateMSInternalMail[];
IF oldInfo.reader = NIL THEN ERROR OldReaderNeeded[];
-- oldInfo.reader exists and is at his mailbox site list --
CopyRList[mail, oldInfo.reader];
SendDefs.StartItem[mail, reMail];
SendDefs.AddToItem[mail, DESCRIPTOR[@(name.text), name.length]];
SendDefs.StartItem[mail, Text]; -- in case it gets to DeadLetter! --
SendDefs.AddToItem[mail, DESCRIPTOR[@(humanHint.text), humanHint.length]];
SendDefs.AddToItem[mail, DESCRIPTOR[@(name.text), name.length]];
done ← ActualInsert[name, type, stamp, writer, oldInfo];
IF done THEN SendDefs.Send[mail];
SendDefs.Destroy[mail];
END
ELSE done ← ActualInsert[name, type, stamp, writer, oldInfo];
END;
CopyRList: PROCEDURE [message: SendDefs.Handle, reader: HeapDefs.ReaderHandle] =
BEGIN
Work: PROC [name: BodyDefs.RName] RETURNS [done: BOOLEAN] =
BEGIN
done ← FALSE;
FOR i: CARDINAL DECREASING IN [0..name.length) DO
IF name[i] = '. THEN EXIT; REPEAT FINISHED => GOTO notGV ENDLOOP;
SendDefs.AddRecipient[message, name];
EXITS
notGV => -- foreign mail server site --
NULL;
END;
RegistryDefs.EnumerateRList[reader, Work];
END;
ActualInsert: ENTRY PROC [
name: BodyDefs.RName, type: ProtocolDefs.RNameType,
stamp: POINTER TO BodyDefs.Timestamp, writer: HeapDefs.WriterHandle,
oldInfo: POINTER TO RegAccessDefs.NameState] RETURNS [done: BOOLEAN] =
BEGIN
-- If done=FALSE at return, then oldInfo↑ has been updated --
ENABLE UNWIND => NULL;
treeInfo: RegBTreeDefs.RegistryObject ← [
oldInfo.type, oldInfo.stamp, oldInfo.reader];
nameIsGVGV: BOOLEAN = String.EquivalentStrings[name, "GV.GV"L];
-- "GV.GV" is special only during the InitializeWorld restart sequence--
IF oldInfo.type = notFound AND NOT nameIsGVGV THEN
BEGIN
newRegState: RegBTreeDefs.RegState = CheckReg[name];
IF newRegState # oldInfo.regState THEN
BEGIN
IF writer # NIL THEN HeapDefs.HeapAbandonWrite[writer];
IF oldInfo.reader # NIL THEN
HeapDefs.SetReaderOffset[oldInfo.reader, HeapDefs.objectStart];
oldInfo.regState ← newRegState;
RETURN[FALSE]
END;
END;
BEGIN
CheckOneOfMine: INTERNAL PROC [type: ProtocolDefs.RNameType]
RETURNS [BOOLEAN] =
BEGIN
-- determines whether "name" is a registry known to this server --
-- don't call ReadRSName[] when creating FirstRS.gv! --
RETURN[
type = group AND EndsWith[name, ".GV"L]
AND
(nameIsGVGV
OR RegServerDefs.IsInList[
name, LocalNameDefs.ReadRSName[].name, direct, self,
members].membership = yes)]
END;
wasMine: BOOLEAN = CheckOneOfMine[oldInfo.type];
isMine: BOOLEAN;
RegBTreeDefs.Insert[
name, type, stamp, writer, @treeInfo !
RegBTreeDefs.UpdateFailed => {treeInfo ← info; GOTO failed}];
-- BTree sets knownReg bit FALSE --
done ← TRUE;
isMine ← CheckOneOfMine[type];
SELECT TRUE FROM
isMine => {
RegBTreeDefs.KnownRegistry[name, TRUE];
IF NOT wasMine THEN LogAddition[name]};
wasMine AND NOT isMine => {
RegBTreeDefs.KnownRegistry[name, FALSE];
LogRemoval[name];
StartChanger[name, FALSE] -- may unlock monitor -- };
ENDCASE => NULL;
EXITS
failed =>
BEGIN
oldInfo↑ ← [
CheckReg[name], treeInfo.type, treeInfo.stamp, treeInfo.reader];
done ← FALSE;
END;
END;
END;
LogAddition: INTERNAL PROC [name: BodyDefs.RName] =
BEGIN
log: STRING = [84];
String.AppendString[log, "New registry "L];
String.AppendString[log, name];
LogDefs.ShowLine[log];
END;
LogRemoval: INTERNAL PROC [name: BodyDefs.RName] =
BEGIN
log: STRING = [84];
String.AppendString[log, "Remove registry "L];
String.AppendString[log, name];
LogDefs.ShowLine[log];
END;
BadRegName: ERROR = CODE;
regChangerIdle: BOOLEAN ← FALSE;
regChangerWanted: BOOLEAN ← FALSE;
regChangerCond: CONDITION;
regChangerName: BodyDefs.RName;
regChangerAdd: BOOLEAN;
StartChanger: INTERNAL PROC [name: BodyDefs.RName, add: BOOLEAN] =
BEGIN
UNTIL regChangerIdle DO WAIT regChangerCond ENDLOOP;
regChangerIdle ← FALSE; -- prevent others attempting to call it --
regChangerName ← name;
regChangerAdd ← add;
regChangerWanted ← TRUE; -- ask it to listen --
BROADCAST regChangerCond;
WHILE regChangerWanted DO WAIT regChangerCond ENDLOOP; --let it take args--
END;
GetChangerArg: ENTRY PROC [regName: BodyDefs.RName] RETURNS [add: BOOLEAN] =
BEGIN
regChangerIdle ← TRUE;
BROADCAST regChangerCond; -- open for calls --
UNTIL regChangerWanted DO WAIT regChangerCond ENDLOOP;
regName.length ← 0;
String.AppendString[regName, "All."L];
FOR i: CARDINAL DECREASING IN [0..regChangerName.length) DO
IF regChangerName[i] = '. THEN
BEGIN
realLength: CARDINAL = regChangerName.length;
regChangerName.length ← i;
String.AppendString[regName, regChangerName];
regChangerName.length ← realLength;
EXIT
END;
REPEAT FINISHED => ERROR BadRegName[];
ENDLOOP;
add ← regChangerAdd;
regChangerWanted ← FALSE;
BROADCAST regChangerCond; -- free caller --
END;
RegChanger: PROC =
BEGIN
DO
regName: BodyDefs.RName = [BodyDefs.maxRNameLength];
IF GetChangerArg[regName] THEN ERROR --add registry --
ELSE DoRemoval[regName];
ENDLOOP;
END;
DoRemoval: PROC [regName: BodyDefs.RName] =
BEGIN -- regName is "All.reg" --
LogDefs.ShowLine["Starting removal"L];
BEGIN
reader: HeapDefs.ReaderHandle = RegServerDefs.EnumeratedMembers[
regName, notFound --ugh!-- ];
Action: PROC [entry: BodyDefs.RName] RETURNS [done: BOOLEAN] =
BEGIN
done ← FALSE;
RegBTreeDefs.Insert[entry, notFound, NIL, NIL, NIL];
END;
RegistryDefs.EnumerateRList[reader, Action];
HeapDefs.HeapEndRead[reader];
END;
LogDefs.ShowLine["End of removal"L];
END;
CheckReg: INTERNAL PROC [name: BodyDefs.RName] RETURNS [RegBTreeDefs.RegState] =
-- determines whether "name" is in a valid and/or local registry
{RETURN[RegBTreeDefs.TestKnownReg[name]]};
Abandon: PUBLIC PROCEDURE [nameObj: POINTER TO RegAccessDefs.NameState]
RETURNS [rc: ProtocolDefs.ReturnCode] =
BEGIN
IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
rc ←
IF nameObj.type = notFound AND nameObj.regState = no THEN [
WrongServer, nameObj.type] ELSE [BadRName, nameObj.type];
END;
regChangerProcess: PROCESS;
RegAccessInit: PUBLIC PROCEDURE = {regChangerProcess ← FORK RegChanger[]};
RegAccessMSMailEnabled: PUBLIC ENTRY PROCEDURE = {MSMailEnabled ← TRUE};
END.