-- Copyright (C) 1981, 1982, 1984, 1985 by Xerox Corporation. All rights reserved.
-- RegServerImpl.mesa, Registration Server - Operations on entries in a registry.
-- HGM, 15-Sep-85 4:04:32
-- Randy Gobbel, 19-May-81 18:51:53
-- J. Dion, September 8, 1979
-- Andrew Birrell, 27-Oct-82 15:46:02
-- Brenda Hankins 14-Aug-84 16:25:47 alter UpdateSublist return vals.
DIRECTORY
BodyDefs USING [maxRNameLength, oldestTime, RName, RNameSize, Timestamp],
Heap USING [systemZone],
HeapDefs USING [
GetWriterOffset, HeapAbandonWrite, HeapEndWrite, HeapEndRead, HeapStartRead,
HeapStartWrite, HeapWriteData, HeapWriteRName, ObjectNumber, ObjectOffset,
objectStart, ReaderHandle, SetReaderOffset, SetWriterOffset, WriterHandle],
LogDefs USING [WriteLogEntry, WriteString],
NameInfoDefs USING [Close, Enumerate, GetMembers, MemberInfo],
ObjectDirDefs USING [FreeObject, UseObject],
ProtocolDefs,
RegAccessDefs USING [Abandon, Insert, Lookup, NameState],
RegBTreeDefs USING [EnumerateTree, RegistryObject],
RegCacheDefs USING [AddConnect, ReadConnect],
RegServerDefs USING [
MailUpdate, Membership, MembershipAcl, MembershipGrade, MembershipLevel],
RegistryDefs USING [
AddName, CheckStampList, CompareTimestamps, Comparison, Copy, EnumerateRList,
FilterStampList, MakeTimestamp, MergeLists, ReadConnect, ReadPassword,
ReadPrefix, RemoveName, Skip, SkipIfEmpty, UpdateInfo, WriteConnect,
WriteList, WritePassword, WritePrefix],
String USING [
AppendString, EquivalentString, EquivalentSubStrings, LowerCase,
SubStringDescriptor],
Time USING [Current, Packed];
RegServerImpl: MONITOR
IMPORTS
BodyDefs, Heap, HeapDefs, LogDefs, NameInfoDefs, ObjectDirDefs, ProtocolDefs,
RegAccessDefs, RegBTreeDefs, RegCacheDefs, RegistryDefs, RegServerDefs,
String, Time
EXPORTS RegServerDefs =
BEGIN
OPEN ProtocolDefs;
-- This module supports complete database entries, but without the
-- concept of "Registry"
-- ================ Layout of entries ================ --
Position: TYPE = MACHINE DEPENDENT{ -- components of an entry --
--dead-- prefixD(1), endD(2),
--individual-- prefixI(11), password(12), connect(13), forward(14), --(15,16,17)--
sites(18), --(19,20,21)--
endI(22),
--group-- prefixG(31), remark(32), members(33), --(34,35,36)--
owners(37), --(38,39,40)--
friends(41), --(42,43,44)--
endG(45)};
Start: PROC [type: ProtocolDefs.RNameType] RETURNS [Position] = INLINE
BEGIN
RETURN[
SELECT type FROM
dead => prefixD,
individual => prefixI,
group => prefixG,
ENDCASE => ERROR]
END;
End: PROC [type: ProtocolDefs.RNameType] RETURNS [Position] = INLINE
BEGIN
RETURN[
SELECT type FROM
dead => endD,
individual => endI,
group => endG,
ENDCASE => ERROR]
END;
Copy: PROC [
reader: HeapDefs.ReaderHandle, writer: HeapDefs.WriterHandle,
from, to: Position] =
BEGIN
-- copies parts of an entry; "from" is position that has just been read
-- "to" indicates what will be available to read after the copying --
-- Copy[x,y, prefixG, endG] copies a group entry except the prefix --
DO
from ← SUCC[from];
IF from = to THEN EXIT;
RegistryDefs.Copy[reader, writer];
ENDLOOP;
END;
Skip: PROC [reader: HeapDefs.ReaderHandle, from, to: Position] =
BEGIN
-- moves the reader efficiently; "from" is current position --
-- "to" indicates what will be available to read after the skipping --
-- Skip[x, prefixI, y] will skip from initial position to read "y" --
DO
IF from = to THEN EXIT;
RegistryDefs.Skip[reader];
from ← SUCC[from];
ENDLOOP;
END;
-- ================ Pseudo-names ================ --
EnumeratedName: PROCEDURE [name: BodyDefs.RName]
RETURNS [enumType: ProtocolDefs.RNameType] =
BEGIN
-- checks for correct syntax, with special case if
-- no registry is given.
sn: BodyDefs.RName = [BodyDefs.maxRNameLength];
index: CARDINAL;
FOR index DECREASING IN [0..name.length) DO
IF name[index] = '. THEN EXIT;
REPEAT FINISHED => index ← name.length
ENDLOOP;
String.AppendString[sn, name];
sn.length ← index; -- "index" is also used below --
IF sn.length > 0 AND sn[sn.length - 1] = '↑ THEN sn.length ← sn.length - 1;
enumType ←
IF String.EquivalentString[sn, "Individuals"L] THEN individual
ELSE
IF String.EquivalentString[sn, "Groups"L] THEN group
ELSE IF String.EquivalentString[sn, "Dead"L] THEN dead ELSE notFound;
END;
EnumeratedMembers: PUBLIC PROCEDURE [
name: BodyDefs.RName, type: ProtocolDefs.RNameType]
RETURNS [reader: HeapDefs.ReaderHandle] =
BEGIN
registry: CARDINAL;
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[temp];
memberWords: CARDINAL ← 0;
members: CARDINAL ← 0;
Action: PROCEDURE [found: BodyDefs.RName] =
BEGIN
index: CARDINAL;
IF found.length >= name.length - registry THEN
FOR index IN (0..name.length - registry] DO
IF String.LowerCase[found[found.length - index]] #
--already l.c.-- name[name.length - index] THEN EXIT;
REPEAT
FINISHED =>
BEGIN
HeapDefs.HeapWriteRName[writer, found];
members ← members + 1;
memberWords ← memberWords + BodyDefs.RNameSize[found];
END
ENDLOOP;
END;
GetReader: PROCEDURE [obj: HeapDefs.ObjectNumber] = {
reader ← HeapDefs.HeapStartRead[obj]};
WriteComponentLength: PROCEDURE [length: CARDINAL] = {
HeapDefs.HeapWriteData[writer, [@length, SIZE[CARDINAL]]]};
BEGIN -- parse name to find registry --
FOR registry DECREASING IN [0..name.length) DO
IF name[registry] = '. THEN EXIT;
name[registry] ← String.LowerCase[name[registry]];
REPEAT FINISHED => registry ← name.length
ENDLOOP;
END;
BEGIN -- members
lengthPos: HeapDefs.ObjectOffset = HeapDefs.GetWriterOffset[writer];
memberStampPos: HeapDefs.ObjectOffset;
WriteComponentLength[0] --place holder-- ;
RegBTreeDefs.EnumerateTree[type, Action];
memberStampPos ← HeapDefs.GetWriterOffset[writer];
HeapDefs.SetWriterOffset[writer, lengthPos];
WriteComponentLength[memberWords];
END;
HeapDefs.HeapEndWrite[writer, GetReader];
END;
ImpliedOwners: PROC [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp,
nameObj: POINTER TO RegAccessDefs.NameState]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] =
BEGIN
-- ReadMembers for names of the form "Owners-foo↑.pa" --
antiSmashing: BodyDefs.RName = [BodyDefs.maxRNameLength];
String.AppendString[antiSmashing, entry];
IF CheckForOwners[antiSmashing] THEN
BEGIN
-- CheckOwners smashes it's arg if it wins.
-- That bypasses the loop detection if Owners-foo↑ is an owner of Foo↑.
IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
[reader, rc] ← ReadOwners[antiSmashing, stamp];
IF rc.code = done AND RegistryDefs.SkipIfEmpty[reader] THEN
BEGIN -- owner list is empty, so use registry --
HeapDefs.HeapEndRead[reader];
[reader, rc] ← ReadRegistryFriends[antiSmashing, stamp];
END;
-- special case of Owners-foo.pa where foo.pa is individual: --
-- must adjust return code to avoid confusing client of Expand --
IF rc = [BadRName, individual] THEN rc ← [BadRName, notFound];
END
ELSE {rc ← RegAccessDefs.Abandon[nameObj]; reader ← NIL};
END;
CheckForOwners: PROC [entry: BodyDefs.RName] RETURNS [BOOLEAN] =
BEGIN
owner: STRING = "Owner-"L;
owners: STRING = "Owners-"L;
begin: STRING;
IF BeginsWith[entry, (begin ← owner)] OR BeginsWith[entry, (begin ← owners)]
THEN
BEGIN
FOR i: CARDINAL IN [begin.length..entry.length) DO
entry[i - begin.length] ← entry[i] ENDLOOP;
entry.length ← entry.length - begin.length;
RETURN[TRUE]
END
ELSE RETURN[FALSE]
END;
-- ================ Access to entries ================ --
CheckRName: PUBLIC PROCEDURE [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readNone];
SELECT TRUE FROM
nameObj.type = notFound AND nameObj.regState = yes =>
BEGIN
IF EnumeratedName[entry] # notFound THEN {
rc ← [done, group]; stamp↑ ← RegistryDefs.MakeTimestamp[]}
ELSE
IF CheckForOwners[entry] -- updates "entry" if successful --
THEN
BEGIN
rc ← CheckRName[entry, stamp];
IF rc.type = individual THEN rc ← [BadRName, notFound];
END
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
END;
nameObj.type = notFound OR nameObj.type = dead =>
rc ← RegAccessDefs.Abandon[@nameObj];
ENDCASE =>
IF nameObj.stamp # stamp↑ THEN {
stamp↑ ← nameObj.stamp; rc ← [done, nameObj.type]}
ELSE rc ← [noChange, nameObj.type];
END;
Read: PUBLIC PROCEDURE [entry: BodyDefs.RName]
RETURNS [
reader: HeapDefs.ReaderHandle, rc: ReturnCode,
components, password: CARDINAL] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readAny];
reader ← nameObj.reader;
rc ← [done, nameObj.type];
SELECT nameObj.type FROM
individual =>
BEGIN
components ←
LOOPHOLE[Position[endI], CARDINAL] - LOOPHOLE[Position[prefixI],
CARDINAL];
password ←
LOOPHOLE[Position[password], CARDINAL] - LOOPHOLE[Position[prefixI],
CARDINAL];
END;
group =>
BEGIN
components ←
LOOPHOLE[Position[endG], CARDINAL] - LOOPHOLE[Position[prefixG],
CARDINAL];
password ← LAST[CARDINAL];
END;
dead =>
BEGIN
components ←
LOOPHOLE[Position[endD], CARDINAL] - LOOPHOLE[Position[prefixD],
CARDINAL];
password ← LAST[CARDINAL];
END;
ENDCASE => rc ← RegAccessDefs.Abandon[@nameObj];
END;
ReadPassword: PUBLIC PROCEDURE [entry: BodyDefs.RName]
RETURNS [pw: Password, rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[
entry, readIndividual];
IF nameObj.type # individual THEN rc ← RegAccessDefs.Abandon[@nameObj]
ELSE
BEGIN
stamp: BodyDefs.Timestamp;
Skip[nameObj.reader, prefixI, password];
[pw, stamp] ← RegistryDefs.ReadPassword[nameObj.reader];
HeapDefs.HeapEndRead[nameObj.reader];
rc ← [done, nameObj.type];
END;
END;
ReadConnect: PUBLIC PROCEDURE [entry: BodyDefs.RName, connect: Connect]
RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState;
IF RegCacheDefs.ReadConnect[entry, connect] THEN RETURN[[done, individual]];
nameObj ← RegAccessDefs.Lookup[entry, readIndividual];
IF nameObj.type # individual THEN rc ← RegAccessDefs.Abandon[@nameObj]
ELSE
BEGIN
stamp: BodyDefs.Timestamp;
Skip[nameObj.reader, prefixI, connect];
stamp ← RegistryDefs.ReadConnect[nameObj.reader, connect];
HeapDefs.HeapEndRead[nameObj.reader];
RegCacheDefs.AddConnect[entry, nameObj.stamp, connect];
rc ← [done, nameObj.type];
END;
END;
ReadRemark: PUBLIC PROCEDURE [entry: BodyDefs.RName, remark: Remark]
RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readGroup];
IF nameObj.type # group THEN rc ← RegAccessDefs.Abandon[@nameObj]
ELSE
BEGIN
stamp: BodyDefs.Timestamp;
Skip[nameObj.reader, prefixG, remark];
stamp ← RegistryDefs.ReadConnect[nameObj.reader, remark];
HeapDefs.HeapEndRead[nameObj.reader];
rc ← [done, nameObj.type];
END;
END;
Expand: PUBLIC PROCEDURE [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] =
BEGIN
-- don't allow delivery to enumerated groups --
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readEither];
reader ← nameObj.reader;
SELECT nameObj.type FROM
individual =>
IF (rc ← PositionReader[@nameObj, forward, stamp]).code = done THEN
IF RegistryDefs.SkipIfEmpty[reader] THEN
Skip[reader, SUCC[forward], sites]
ELSE rc ← [done, group]
ELSE NULL;
group => rc ← PositionReader[@nameObj, members, stamp];
ENDCASE => [reader, rc] ← ImpliedOwners[entry, stamp, @nameObj];
END;
BeginsWith: PROC [s: LONG STRING, b: LONG STRING] RETURNS [BOOLEAN] =
BEGIN
pattern: String.SubStringDescriptor ← [b, 0, b.length];
target: String.SubStringDescriptor ← [s, 0, b.length];
RETURN[
s.length >= b.length AND String.EquivalentSubStrings[@pattern, @target]]
END;
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;
ReadSites: PUBLIC PROCEDURE [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[
entry, readIndividual];
reader ← nameObj.reader;
IF nameObj.type = individual THEN rc ← PositionReader[@nameObj, sites, stamp]
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
END;
ReadMembers: PUBLIC PROCEDURE [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readGroup];
reader ← nameObj.reader;
IF nameObj.type = group THEN rc ← PositionReader[@nameObj, members, stamp]
ELSE
IF nameObj.type # notFound OR nameObj.regState # yes THEN
rc ← RegAccessDefs.Abandon[@nameObj]
ELSE
BEGIN
enumType: ProtocolDefs.RNameType = EnumeratedName[entry];
IF enumType # notFound THEN
BEGIN
reader ← EnumeratedMembers[entry, enumType];
stamp↑ ← RegistryDefs.MakeTimestamp[];
rc ← [done, group];
END
ELSE [reader, rc] ← ImpliedOwners[entry, stamp, @nameObj];
END;
END;
ReadOwners: PUBLIC PROCEDURE [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readGroup];
reader ← nameObj.reader;
IF nameObj.type = group THEN rc ← PositionReader[@nameObj, owners, stamp]
ELSE rc ← RegAccessDefs.Abandon[ @nameObj];
END;
ReadFriends: PUBLIC PROCEDURE [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readGroup];
reader ← nameObj.reader;
IF nameObj.type = group THEN rc ← PositionReader[@nameObj, friends, stamp]
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
END;
ReadRegistry: PROC [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp,
work: PROC [BodyDefs.RName, POINTER TO BodyDefs.Timestamp]
RETURNS [HeapDefs.ReaderHandle, ReturnCode]]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] =
BEGIN
gvReg: STRING = ".gv"L;
regName: BodyDefs.RName = [BodyDefs.maxRNameLength];
index: CARDINAL;
sep: CARDINAL;
FOR index DECREASING IN [0..entry.length) DO
IF entry[index] = '. THEN BEGIN sep ← index + 1; EXIT END;
REPEAT FINISHED => sep ← 0
ENDLOOP;
FOR index IN [sep..entry.length) DO
regName[index - sep] ← entry[index] ENDLOOP;
regName.length ← entry.length - sep;
IF regName.length + gvReg.length > regName.maxlength THEN {
reader ← NIL; rc ← [BadRName, notFound]}
ELSE
BEGIN
String.AppendString[regName, gvReg];
[reader, rc] ← work[regName, stamp];
END;
END;
ReadRegistryMembers: PUBLIC PROC [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] = {
[reader, rc] ← ReadRegistry[entry, stamp, ReadMembers]};
ReadRegistryOwners: PUBLIC PROC [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] = {
[reader, rc] ← ReadRegistry[entry, stamp, ReadOwners]};
ReadRegistryFriends: PUBLIC PROC [
entry: BodyDefs.RName, stamp: POINTER TO BodyDefs.Timestamp]
RETURNS [reader: HeapDefs.ReaderHandle, rc: ReturnCode] = {
[reader, rc] ← ReadRegistry[entry, stamp, ReadFriends]};
PositionReader: PROCEDURE [
nameObj: POINTER TO RegAccessDefs.NameState, sublist: Position,
oldStamp: POINTER TO BodyDefs.Timestamp] RETURNS [rc: ReturnCode] =
BEGIN
IF oldStamp↑ = nameObj.stamp THEN
BEGIN
HeapDefs.HeapEndRead[nameObj.reader];
rc ← [noChange, nameObj.type];
END
ELSE
BEGIN
oldStamp↑ ← nameObj.stamp;
Skip[nameObj.reader, Start[nameObj.type], sublist];
rc ← [done, nameObj.type]
END
END;
-- ================ Access control and membership ================ --
LowerCase: PROC [c: CHARACTER] RETURNS [CHARACTER] = INLINE {
RETURN[IF c IN ['A..'Z] THEN 'a + (c - 'A) ELSE c]};
StarPattern: PROC [p: LONG STRING] RETURNS [BOOLEAN] = INLINE {
RETURN[p.length > 0 AND p[0] = '*]};
StarMatch: PROC [pattern, name: LONG STRING] RETURNS [BOOLEAN] =
BEGIN
-- Assumes pattern.length > 0 and pattern[0] = '* --
nPtr: CARDINAL ← name.length;
IF name.length < pattern.length THEN RETURN[FALSE];
FOR pPtr: CARDINAL DECREASING IN [1..pattern.length) DO
nPtr ← nPtr - 1;
IF LowerCase[name[nPtr]] # LowerCase[pattern[pPtr]] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE]
END;
HaveIDoneThis: SIGNAL [new: BodyDefs.RName] RETURNS [BOOLEAN] = CODE;
-- used to prevent recursive loops --
IsInList: PUBLIC PROCEDURE [
entry: BodyDefs.RName, member: BodyDefs.RName,
level: RegServerDefs.MembershipLevel, grade: RegServerDefs.MembershipGrade,
acl: RegServerDefs.MembershipAcl]
RETURNS [membership: RegServerDefs.Membership, rc: ProtocolDefs.ReturnCode] =
BEGIN
getList: PROCEDURE [BodyDefs.RName, POINTER TO BodyDefs.Timestamp]
RETURNS [HeapDefs.ReaderHandle, ReturnCode] =
SELECT acl FROM
members => IF grade = self THEN ReadMembers ELSE ReadRegistryMembers,
owners => IF grade = self THEN ReadOwners ELSE ReadRegistryOwners,
friends => IF grade = self THEN ReadFriends ELSE ReadRegistryFriends,
ENDCASE => ERROR;
[membership, rc] ← IsInListSub[
entry, member, IF level = closure THEN upArrow ELSE level, getList !
HaveIDoneThis => RESUME [FALSE]];
IF level = closure AND membership = no THEN
[membership, rc] ← IsInListSub[
entry, member, level, getList ! HaveIDoneThis => RESUME [FALSE]];
END;
IsInListSub: PROCEDURE [
entry: BodyDefs.RName, member: BodyDefs.RName,
level: RegServerDefs.MembershipLevel,
getList: PROCEDURE [BodyDefs.RName, POINTER TO BodyDefs.Timestamp]
RETURNS [HeapDefs.ReaderHandle, ReturnCode]]
RETURNS [membership: RegServerDefs.Membership, rc: ProtocolDefs.ReturnCode] =
BEGIN
reader: HeapDefs.ReaderHandle;
Work: PROC [name: BodyDefs.RName] RETURNS [done: BOOLEAN] =
BEGIN
Accept: PROC = {membership ← yes; done ← TRUE; rc ← [done, group]};
ExpandThis: PROC RETURNS [BOOLEAN] = INLINE
BEGIN
SELECT level FROM
direct => RETURN[FALSE];
closure => RETURN[TRUE];
upArrow =>
BEGIN
FOR i: CARDINAL DECREASING IN [0..name.length) DO
IF name[i] = '. THEN RETURN[i > 0 AND name[i - 1] = '↑]; ENDLOOP;
RETURN[FALSE]
END;
ENDCASE => ERROR;
END;
done ← FALSE;
SELECT TRUE FROM
(IF StarPattern[name] THEN StarMatch[name, member]
ELSE String.EquivalentString[name, member]) => Accept[];
ExpandThis[] =>
IF SIGNAL HaveIDoneThis[name] THEN NULL -- recursive loop elimination --
ELSE
BEGIN
ENABLE
HaveIDoneThis =>
IF String.EquivalentString[new, name] THEN RESUME [TRUE];
subMember: RegServerDefs.Membership;
subRC: ProtocolDefs.ReturnCode;
[subMember, subRC] ← IsInListSub[
entry: name, member: member, level: level, getList: ReadMembers];
SELECT subRC.code FROM
done => {IF subMember = yes THEN Accept[]};
WrongServer =>
BEGIN -- ask remote R-Server -
subInfo: NameInfoDefs.MemberInfo = NameInfoDefs.GetMembers[name];
WITH s: subInfo SELECT FROM
group =>
BEGIN
NameInfoDefs.Enumerate[s.members, Work];
NameInfoDefs.Close[s.members];
IF membership = yes THEN done ← TRUE;
END;
allDown => rc.code ← AllDown;
ENDCASE => NULL;
END;
AllDown => rc.code ← AllDown; -- stronger default RC --
ENDCASE => NULL;
END;
ENDCASE => NULL;
END;
SELECT TRUE FROM
-- IsMember["*", foo] or IsMember["*.pa", foo] --
getList = ReadMembers AND StarPattern[entry] =>
BEGIN
rc ← [done, group];
membership ← IF StarMatch[entry, member] THEN yes ELSE no;
END;
-- IsMember["individuals.reg", foo] --
getList = ReadMembers AND (EnumeratedName[entry] = individual) =>
BEGIN
silly: BodyDefs.Timestamp ← BodyDefs.oldestTime;
namePtr: CARDINAL ← entry.length;
membership ← no;
rc ← [done, group];
FOR memberPtr: CARDINAL DECREASING IN [0..member.length) DO
namePtr ← namePtr - 1;
IF namePtr = 0 THEN EXIT;
IF String.LowerCase[entry[namePtr]] # String.LowerCase[
member[memberPtr]] THEN EXIT;
IF entry[namePtr] = '. THEN {
membership ←
IF CheckRName[member, @silly].type = individual THEN yes ELSE no;
EXIT};
ENDLOOP;
END;
ENDCASE =>
BEGIN
oldTimePtr: BodyDefs.Timestamp ← BodyDefs.oldestTime; --ugh!--
[reader, rc] ← getList[entry, @oldTimePtr]; -- sets default RC --
IF rc.code = done THEN
BEGIN
membership ← no;
RegistryDefs.EnumerateRList[reader, Work];
HeapDefs.HeapEndRead[reader];
END
ELSE membership ← badList;
END;
END;
-- ================ Changing entries ================ --
CheckCreation: PROC [
name: BodyDefs.RName, nameObj: POINTER TO RegAccessDefs.NameState]
RETURNS [ok: BOOLEAN] =
BEGIN
IF EnumeratedName[name] # notFound OR CheckForOwners[name]
OR StarPattern[name] THEN nameObj.type ← group;
RETURN[nameObj.type = notFound AND nameObj.regState = yes]
END;
CreateIndividual: PUBLIC PROC [name: BodyDefs.RName, password: Password]
RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[name, readAny];
-- must use "readAny", for update synchronization logic if entry was dead
DO
IF CheckCreation[name, @nameObj] THEN
BEGIN
stamp: BodyDefs.Timestamp ← RegistryDefs.MakeTimestamp[];
IF RegistryDefs.CompareTimestamps[stamp, nameObj.stamp] # greater THEN
BEGIN
rc ← [outOfDate, nameObj.type];
IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
END
ELSE
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
RegistryDefs.WritePrefix[writer, individual, @stamp, name];
RegistryDefs.WritePassword[writer, password, stamp];
RegistryDefs.WriteConnect[writer, ""L, stamp];
RegistryDefs.WriteList[writer, NIL, stamp];
RegistryDefs.WriteList[writer, NIL, stamp];
IF NOT FinishUpdate[
name, individual, @stamp, writer, @nameObj, NIL, CreateIndividual]
THEN LOOP;
rc ← [done, individual];
END;
END
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
EXIT
ENDLOOP
END;
DeleteIndividual: PUBLIC PROCEDURE [name: BodyDefs.RName]
RETURNS [rc: ReturnCode] = BEGIN rc ← DeleteRName[name, individual]; END;
CreateGroup: PUBLIC PROCEDURE [name, caller: BodyDefs.RName]
RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[name, readAny];
-- must use "readAny", for update synchronization logic if entry was dead
DO
IF CheckCreation[name, @nameObj] THEN
BEGIN
stamp: BodyDefs.Timestamp ← RegistryDefs.MakeTimestamp[];
IF RegistryDefs.CompareTimestamps[stamp, nameObj.stamp] # greater THEN
BEGIN
rc ← [outOfDate, nameObj.type];
IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
END
ELSE
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
RegistryDefs.WritePrefix[writer, group, @stamp, name];
--TEMP-- RegistryDefs.WriteConnect[writer, ""L, stamp]; -- remark
RegistryDefs.WriteList[writer, NIL, stamp]; -- members
RegistryDefs.WriteList[writer, NIL, stamp]; -- owners
RegistryDefs.WriteList[writer, NIL, stamp]; -- friends
IF NOT FinishUpdate[
name, group, @stamp, writer, @nameObj, NIL, CreateGroup] THEN LOOP;
rc ← [done, group];
END;
END
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
EXIT
ENDLOOP;
END;
DeleteGroup: PUBLIC PROCEDURE [name: BodyDefs.RName] RETURNS [rc: ReturnCode] =
BEGIN rc ← DeleteRName[name, group]; END;
DeleteRName: PROCEDURE [name: BodyDefs.RName, type: ProtocolDefs.RNameType]
RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[name, readAny];
-- must acquire reader on old object if it's an individual, to allow
-- internal mail to mail servers --
DO
IF nameObj.type = type THEN
BEGIN
stamp: BodyDefs.Timestamp ← RegistryDefs.MakeTimestamp[];
IF RegistryDefs.CompareTimestamps[stamp, nameObj.stamp] # greater THEN
BEGIN
rc ← [outOfDate, nameObj.type];
IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
END
ELSE
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
RegistryDefs.WritePrefix[writer, dead, @stamp, name];
IF NOT FinishUpdate[
name, dead, @stamp, writer, @nameObj, NIL,
IF type = individual THEN DeleteIndividual ELSE DeleteGroup] THEN
LOOP;
rc ← [done, dead];
END;
END
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
EXIT
ENDLOOP;
END;
NewName: PUBLIC PROCEDURE [new, old: BodyDefs.RName]
RETURNS [rc: ProtocolDefs.ReturnCode] =
BEGIN
reader: HeapDefs.ReaderHandle;
components: CARDINAL;
[reader, rc, components, ] ← Read[old];
IF rc.code = done THEN
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[new, readAny];
DO
IF CheckCreation[new, @nameObj] THEN
BEGIN
stamp: BodyDefs.Timestamp ← RegistryDefs.MakeTimestamp[];
IF RegistryDefs.CompareTimestamps[stamp, nameObj.stamp] # greater THEN
BEGIN
rc ← [outOfDate, nameObj.type];
IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
END
ELSE
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
RegistryDefs.WritePrefix[writer, rc.type, @stamp, new];
HeapDefs.SetReaderOffset[reader, HeapDefs.objectStart];
RegistryDefs.Skip[reader];
THROUGH (1..components] DO RegistryDefs.Copy[reader, writer] ENDLOOP;
IF NOT FinishUpdate[
new, rc.type, @stamp, writer, @nameObj, NIL, NewName] THEN
BEGIN
HeapDefs.SetReaderOffset[reader, HeapDefs.objectStart];
LOOP
END;
END;
END
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
EXIT
ENDLOOP;
-- Only specify to support names both in same registry --
IF rc.code = WrongServer THEN rc.code ← BadProtocol;
END;
IF reader # NIL THEN HeapDefs.HeapEndRead[reader];
END;
ChangePassword: PUBLIC PROCEDURE [entry: BodyDefs.RName, pw: Password]
RETURNS [rc: ReturnCode] =
BEGIN rc ← ChangeItem[entry, [password[pw]], ChangePassword]; END;
ChangeConnect: PUBLIC PROCEDURE [
entry: BodyDefs.RName, connect: ProtocolDefs.Connect]
RETURNS [rc: ProtocolDefs.ReturnCode] =
BEGIN rc ← ChangeItem[entry, [conn[connect]], ChangeConnect]; END;
ChangeRemark: PUBLIC PROCEDURE [
entry: BodyDefs.RName, remark: ProtocolDefs.Remark]
RETURNS [rc: ProtocolDefs.ReturnCode] =
BEGIN rc ← ChangeItem[entry, [rem[remark]], ChangeRemark]; END;
ChangeItem: PROCEDURE [
entry: BodyDefs.RName,
item: RECORD [
SELECT t: * FROM
password => [pw: Password],
conn => [connect: Connect],
rem => [remark: Remark],
ENDCASE], op: ProtocolDefs.RSOperation] RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[entry, readAny];
DO
IF nameObj.type =
(SELECT item.t FROM
password, conn => individual,
rem => group,
ENDCASE => ERROR) THEN
BEGIN
stamp: BodyDefs.Timestamp ← RegistryDefs.MakeTimestamp[];
oldpw: Password;
oldConnect: Connect = [ProtocolDefs.maxConnectLength];
oldRemark: Remark = [ProtocolDefs.maxRemarkLength];
oldstamp: BodyDefs.Timestamp;
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
start: Position = Start[nameObj.type];
[, ] ← RegistryDefs.ReadPrefix[nameObj.reader, entry] --correct case-- ;
RegistryDefs.WritePrefix[writer, nameObj.type, @stamp, entry];
Copy[
nameObj.reader, writer, start,
SELECT item.t FROM
password => password,
conn => connect,
rem => remark
ENDCASE => ERROR];
WITH item SELECT FROM
password =>
[oldpw, oldstamp] ← RegistryDefs.ReadPassword[nameObj.reader];
conn => oldstamp ← RegistryDefs.ReadConnect[nameObj.reader, oldConnect];
rem =>
--TEMP--
oldstamp ← RegistryDefs.ReadConnect[nameObj.reader, oldRemark];
ENDCASE => ERROR;
SELECT RegistryDefs.CompareTimestamps[stamp, oldstamp] FROM
less =>
BEGIN
HeapDefs.HeapAbandonWrite[writer];
HeapDefs.HeapEndRead[nameObj.reader];
rc ← [outOfDate, nameObj.type];
END;
equal =>
BEGIN
HeapDefs.HeapAbandonWrite[writer];
HeapDefs.HeapEndRead[nameObj.reader];
rc ← [noChange, nameObj.type];
END;
greater =>
BEGIN
WITH item SELECT FROM
password =>
BEGIN
RegistryDefs.WritePassword[writer, pw, stamp];
Copy[nameObj.reader, writer, password, endI];
END;
conn =>
BEGIN
RegistryDefs.WriteConnect[writer, connect, stamp];
Copy[nameObj.reader, writer, connect, endI];
END;
rem =>
BEGIN
--TEMP-- RegistryDefs.WriteConnect[writer, remark, stamp];
Copy[nameObj.reader, writer, remark, endG];
END;
ENDCASE => ERROR;
IF NOT FinishUpdate[
entry, nameObj.type, @stamp, writer, @nameObj, NIL, op] THEN LOOP;
rc ← [done, nameObj.type];
END;
ENDCASE => ERROR;
END
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
EXIT
ENDLOOP;
END;
AddMailbox: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, AddMailBox].rc};
DeleteMailbox: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {
rc ← UpdateSublist[name, entry, DeleteMailBox].rc};
AddForward: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, AddForward].rc};
DeleteForward: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {
rc ← UpdateSublist[name, entry, DeleteForward].rc};
AddMember: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, AddMember].rc};
DeleteMember: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, DeleteMember].rc};
AddOwner: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, AddOwner].rc};
DeleteOwner: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, DeleteOwner].rc};
AddFriend: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, AddFriend].rc};
DeleteFriend: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
RETURNS [rc: ReturnCode] = {rc ← UpdateSublist[name, entry, DeleteFriend].rc};
AddListOfMembers: PUBLIC PROCEDURE [
name: BodyDefs.RName, reader: HeapDefs.ReaderHandle]
RETURNS [rc: ReturnCode] =
BEGIN
stamp: BodyDefs.Timestamp ← RegistryDefs.MakeTimestamp[];
rc ← UpdateSingleSublist[name, reader, @stamp, group, members];
END;
UpdateSublist: PUBLIC PROCEDURE [
name, element: BodyDefs.RName, op: ProtocolDefs.RSOperation,
prevStamp: BodyDefs.Timestamp ← BodyDefs.oldestTime]
RETURNS [rc: ReturnCode, regLocal: BOOLEAN ← TRUE] =
BEGIN
propagate: BOOLEAN = prevStamp = BodyDefs.oldestTime;
expectedType: ProtocolDefs.RNameType =
SELECT op FROM
AddMailBox, DeleteMailBox, AddForward, DeleteForward => individual,
AddMember, DeleteMember, AddOwner, DeleteOwner, AddFriend, DeleteFriend =>
group,
ENDCASE => ERROR;
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[
name,
SELECT expectedType FROM
individual => readIndividual,
group => readGroup,
ENDCASE => ERROR];
DO
IF nameObj.type = expectedType THEN
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
elementStamp: BodyDefs.Timestamp ←
IF propagate THEN RegistryDefs.MakeTimestamp[] ELSE prevStamp;
globalStamp: BodyDefs.Timestamp ←
IF RegistryDefs.CompareTimestamps[elementStamp, nameObj.stamp] = greater
THEN elementStamp ELSE RegistryDefs.MakeTimestamp[];
info: RegistryDefs.UpdateInfo;
component: Position =
SELECT op FROM
AddMailBox, DeleteMailBox => sites,
AddForward, DeleteForward => forward,
AddMember, DeleteMember => members,
AddOwner, DeleteOwner => owners,
AddFriend, DeleteFriend => friends,
ENDCASE => ERROR;
add: BOOLEAN =
SELECT op FROM
AddMailBox, AddForward, AddMember, AddOwner, AddFriend => TRUE,
ENDCASE => FALSE;
[, ] ← RegistryDefs.ReadPrefix[nameObj.reader, name] --correct case-- ;
RegistryDefs.WritePrefix[writer, nameObj.type, @globalStamp, name];
Copy[nameObj.reader, writer, Start[nameObj.type], component];
info ←
IF add THEN RegistryDefs.AddName[
nameObj.reader, element, @elementStamp, writer]
ELSE RegistryDefs.RemoveName[
nameObj.reader, element, @elementStamp, writer];
IF info = done OR (NOT propagate AND info = noChange) THEN
BEGIN
Copy[
nameObj.reader, writer, SUCC[SUCC[SUCC[component]]], End[
nameObj.type]];
IF NOT
(IF propagate THEN FinishUpdate[
name, expectedType, @globalStamp, writer, @nameObj, element, op]
ELSE RegAccessDefs.Insert[
name, expectedType, @globalStamp, writer, @nameObj]) THEN LOOP;
rc ← [done, nameObj.type]
END
ELSE
BEGIN
HeapDefs.HeapEndRead[nameObj.reader];
rc ← [
SELECT info FROM
outOfDate => outOfDate,
noChange => noChange,
ENDCASE => ERROR, nameObj.type];
HeapDefs.HeapAbandonWrite[writer];
END;
IF NOT propagate THEN
LogMerge[name, prevStamp, info = outOfDate, info # noChange, TRUE];
END
ELSE {
rc ← RegAccessDefs.Abandon[@nameObj];
regLocal ← nameObj.regState = yes};
EXIT
ENDLOOP;
END;
UpdateSingleSublist: PROCEDURE [
name: BodyDefs.RName, update: HeapDefs.ReaderHandle,
stamp: POINTER TO BodyDefs.Timestamp, expectedType: RNameType,
component: Position] RETURNS [rc: ReturnCode] =
BEGIN
nameObj: RegAccessDefs.NameState ← RegAccessDefs.Lookup[
name,
SELECT expectedType FROM
individual => readIndividual,
group => readGroup,
ENDCASE => ERROR];
DO
IF nameObj.type = expectedType THEN
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
updateNewer, readerNewer: BOOLEAN;
[, ] ← RegistryDefs.ReadPrefix[nameObj.reader, name] --correct case-- ;
RegistryDefs.WritePrefix[writer, nameObj.type, stamp, name];
Copy[nameObj.reader, writer, Start[nameObj.type], component];
[updateNewer, readerNewer] ← RegistryDefs.MergeLists[
update, nameObj.reader, writer];
Copy[
nameObj.reader, writer, SUCC[SUCC[SUCC[component]]], End[nameObj.type]];
IF updateNewer THEN
BEGIN
IF NOT FinishUpdate[
name, expectedType, stamp, writer, @nameObj, NIL, AddListOfMembers]
THEN LOOP;
rc ← [done, nameObj.type]
END
ELSE
BEGIN
HeapDefs.HeapEndRead[nameObj.reader];
IF readerNewer THEN rc ← [outOfDate, nameObj.type]
ELSE rc ← [noChange, nameObj.type];
HeapDefs.HeapAbandonWrite[writer];
END;
END
ELSE rc ← RegAccessDefs.Abandon[@nameObj];
EXIT
ENDLOOP;
HeapDefs.HeapEndRead[update];
END;
dontOptimizeMembers: BOOLEAN ← TRUE;
FinishUpdate: PROCEDURE [
name: BodyDefs.RName, type: ProtocolDefs.RNameType,
stamp: POINTER TO BodyDefs.Timestamp, writer: HeapDefs.WriterHandle,
info: POINTER TO RegAccessDefs.NameState, element: BodyDefs.RName,
op: ProtocolDefs.RSOperation] RETURNS [done: BOOLEAN] =
BEGIN
-- write an RSmail object to ensure others are told about the update --
-- then end the writer, committing us to the update --
-- then tell others about the update --
-- then throw away the RSmail object --
-- returns done=FALSE iff Insert does so --
rsMailObject: HeapDefs.ObjectNumber = RecordDelivery[name];
ResetForMailboxSites[info];
IF (done ← RegAccessDefs.Insert[name, type, stamp, writer, info]) THEN
RegServerDefs.MailUpdate[name, stamp↑, element, op, rsMailObject]
ELSE ObjectDirDefs.FreeObject[rsMailObject];
END;
RecordDelivery: PROCEDURE [name: BodyDefs.RName]
RETURNS [object: HeapDefs.ObjectNumber] =
BEGIN
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSmail];
now: Time.Packed ← Time.Current[];
GetObjectNumber: PROCEDURE [number: HeapDefs.ObjectNumber] = {
object ← number; ObjectDirDefs.UseObject[number]};
HeapDefs.HeapWriteRName[writer, name];
HeapDefs.HeapWriteData[writer, [@now, SIZE[Time.Packed]]];
HeapDefs.HeapEndWrite[writer, GetObjectNumber];
END;
-- ================ Merge update from other server ================ --
Update: PUBLIC PROCEDURE [object: HeapDefs.ObjectNumber] =
BEGIN
oldNameObj: RegAccessDefs.NameState;
newReader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[object];
newRName: BodyDefs.RName = [BodyDefs.maxRNameLength];
newType: ProtocolDefs.RNameType;
newStamp: BodyDefs.Timestamp;
mineIsNewer: BOOLEAN ← FALSE;
hisIsNewer: BOOLEAN ← FALSE;
[newType, newStamp] ← RegistryDefs.ReadPrefix[newReader, newRName];
oldNameObj ← RegAccessDefs.Lookup[newRName, readAny];
-- state of newReader here must be same as after the "tryAgain" exit --
DO
BEGIN
stampCompare: RegistryDefs.Comparison = RegistryDefs.CompareTimestamps[
newStamp, oldNameObj.stamp];
bestStamp: BodyDefs.Timestamp ←
IF stampCompare = greater THEN newStamp
ELSE -- Our stamp was newer (or equal?) --
-- Stamps on our disk must be monotonic, for restart sequence --
RegistryDefs.MakeTimestamp[];
writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[RSobject];
-- newReader has had the prefix read from it;
-- oldRegObj.reader has had nothing read from it;
-- writer has had nothing written to it;
SELECT TRUE FROM -- the order of the arms of the SELECT matters! --
(oldNameObj.type = dead AND (newType # dead OR stampCompare = less)),
-- and: ignore update for registry we don't know about.
-- NB: this is correct only in absence of addition of registries!
(oldNameObj.type = notFound AND oldNameObj.regState # yes) =>
BEGIN
-- our object is better --
IF oldNameObj.reader # NIL THEN HeapDefs.HeapEndRead[oldNameObj.reader];
HeapDefs.HeapAbandonWrite[writer];
mineIsNewer ← TRUE;
EXIT --no update needed--
END;
(oldNameObj.type = notFound OR newType = dead
--and newStamp is newer or old is not dead-- ) =>
BEGIN
-- new entry, or his object is "dead" --
RegistryDefs.WritePrefix[writer, newType, @bestStamp, newRName];
Copy[newReader, writer, Start[newType], End[newType]];
hisIsNewer ← TRUE;
END
ENDCASE =>
BEGIN
n1, n2: BOOLEAN;
RegistryDefs.WritePrefix[writer, newType, @bestStamp, newRName];
SELECT newType FROM
dead => ERROR;
group => [n1, n2] ← UpdateGroup[oldNameObj.reader, newReader, writer];
individual =>
[n1, n2] ← UpdateIndividual[oldNameObj.reader, newReader, writer];
ENDCASE => ERROR;
IF n1 THEN mineIsNewer ← TRUE;
IF n2 THEN hisIsNewer ← TRUE;
END;
ResetForMailboxSites[@oldNameObj];
IF RegAccessDefs.Insert[newRName, newType, @bestStamp, writer, @oldNameObj]
THEN EXIT
ELSE
BEGIN
HeapDefs.SetReaderOffset[newReader, HeapDefs.objectStart];
[newType, newStamp] ← RegistryDefs.ReadPrefix[newReader, newRName];
END;
END
ENDLOOP;
HeapDefs.HeapEndRead[newReader];
LogMerge[newRName, newStamp, mineIsNewer, hisIsNewer, FALSE];
END;
LogMerge: PROC [
name: BodyDefs.RName, stamp: BodyDefs.Timestamp,
mineIsNewer, hisIsNewer, brief: BOOLEAN] =
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[200]];
IF brief THEN LogDefs.WriteString["Brief "L];
LogDefs.WriteString["Merge "L];
LogDefs.WriteString[name];
String.AppendString[log, IF brief THEN "Brief merge "L ELSE "Merge "L];
String.AppendString[log, name];
String.AppendString[log, ", stamp="L];
ProtocolDefs.AppendTimestamp[log, stamp];
IF NOT hisIsNewer THEN String.AppendString[log, ", no change"L];
IF mineIsNewer THEN String.AppendString[log, ", anti-entropy"L];
LogDefs.WriteLogEntry[log];
Heap.systemZone.FREE[@log];
END;
UpdateGroup: PROCEDURE [
oldReader, newReader: HeapDefs.ReaderHandle, writer: HeapDefs.WriterHandle]
RETURNS [n1, n2: BOOLEAN] =
BEGIN
-- returns n1=TRUE iff oldReader has info newer than newReader;
-- returns n2=TRUE iff newReader has info newer than oldReader;
-- Note that both or neither may be true.
ListsInGroup: CARDINAL = 3;
n1 ← n2 ← FALSE;
Skip[oldReader, prefixG, remark];
BEGIN
oldStamp, newStamp: BodyDefs.Timestamp;
oldRem: Remark = [maxRemarkLength];
newRem: Remark = [maxRemarkLength];
oldStamp ← RegistryDefs.ReadConnect[oldReader, oldRem];
newStamp ← RegistryDefs.ReadConnect[newReader, newRem];
SELECT RegistryDefs.CompareTimestamps[oldStamp, newStamp] FROM
greater => {n1 ← TRUE; RegistryDefs.WriteConnect[writer, oldRem, oldStamp]};
equal => RegistryDefs.WriteConnect[writer, newRem, newStamp];
less => {n2 ← TRUE; RegistryDefs.WriteConnect[writer, newRem, newStamp]};
ENDCASE => ERROR;
END;
THROUGH [1..ListsInGroup] DO
newer1, newer2: BOOLEAN;
[newer1, newer2] ← RegistryDefs.MergeLists[oldReader, newReader, writer];
IF newer1 THEN n1 ← TRUE;
IF newer2 THEN n2 ← TRUE;
ENDLOOP;
END;
UpdateIndividual: PROCEDURE [
oldReader, newReader: HeapDefs.ReaderHandle, writer: HeapDefs.WriterHandle]
RETURNS [n1, n2: BOOLEAN] =
BEGIN
-- returns n1=TRUE iff oldReader has info newer than newReader;
-- returns n2=TRUE iff newReader has info newer than oldReader;
-- Note that both or neither may be true.
ListsInIndividual: CARDINAL = 2;
n1 ← n2 ← FALSE;
Skip[oldReader, prefixI, SUCC[prefixI]];
BEGIN
oldStamp, newStamp: BodyDefs.Timestamp;
oldpw, newpw: Password;
[oldpw, oldStamp] ← RegistryDefs.ReadPassword[oldReader];
[newpw, newStamp] ← RegistryDefs.ReadPassword[newReader];
SELECT RegistryDefs.CompareTimestamps[oldStamp, newStamp] FROM
greater => {n1 ← TRUE; RegistryDefs.WritePassword[writer, oldpw, oldStamp]};
equal => RegistryDefs.WritePassword[writer, newpw, newStamp];
less => {n2 ← TRUE; RegistryDefs.WritePassword[writer, newpw, newStamp]};
ENDCASE => ERROR;
END;
BEGIN
oldStamp, newStamp: BodyDefs.Timestamp;
oldConn: Connect = [maxConnectLength];
newConn: Connect = [maxConnectLength];
oldStamp ← RegistryDefs.ReadConnect[oldReader, oldConn];
newStamp ← RegistryDefs.ReadConnect[newReader, newConn];
SELECT RegistryDefs.CompareTimestamps[oldStamp, newStamp] FROM
greater => {
n1 ← TRUE; RegistryDefs.WriteConnect[writer, oldConn, oldStamp]};
equal => RegistryDefs.WriteConnect[writer, newConn, newStamp];
less => {n2 ← TRUE; RegistryDefs.WriteConnect[writer, newConn, newStamp]};
ENDCASE => ERROR;
END;
THROUGH [1..ListsInIndividual] DO
newer1, newer2: BOOLEAN;
[newer1, newer2] ← RegistryDefs.MergeLists[oldReader, newReader, writer];
IF newer1 THEN n1 ← TRUE;
IF newer2 THEN n2 ← TRUE;
ENDLOOP;
END;
CantReadOldEntry: ERROR = CODE;
ResetForMailboxSites: PROC [info: POINTER TO RegAccessDefs.NameState] =
BEGIN
-- re-position reader to mailbox sites, for generating
-- internal mail to appropriate MS's --
IF info.type = individual -- old entry was individual --
THEN
BEGIN
IF info.reader = NIL THEN ERROR CantReadOldEntry[];
HeapDefs.SetReaderOffset[info.reader, HeapDefs.objectStart];
Skip[info.reader, Start[individual], sites];
END;
END;
-- ================ RegPurger utilities ================ --
ConsiderPurging: PUBLIC PROC [
regObj: RegBTreeDefs.RegistryObject, oldest: BodyDefs.Timestamp]
RETURNS [yes: BOOLEAN] =
BEGIN
SELECT regObj.type FROM
dead => yes ← RegistryDefs.CompareTimestamps[regObj.stamp, oldest] = less;
individual =>
BEGIN
Skip[regObj.reader, prefixI, SUCC[SUCC[SUCC[forward]]]];
yes ← RegistryDefs.CheckStampList[regObj.reader, oldest];
IF yes THEN RETURN;
Skip[
regObj.reader, SUCC[SUCC[SUCC[SUCC[forward]]]], SUCC[
SUCC[SUCC[sites]]]];
yes ← RegistryDefs.CheckStampList[regObj.reader, oldest];
END;
group =>
BEGIN
Skip[regObj.reader, prefixG, SUCC[SUCC[SUCC[members]]]];
yes ← RegistryDefs.CheckStampList[regObj.reader, oldest];
IF yes THEN RETURN;
Skip[
regObj.reader, SUCC[SUCC[SUCC[SUCC[members]]]], SUCC[
SUCC[SUCC[owners]]]];
yes ← RegistryDefs.CheckStampList[regObj.reader, oldest];
IF yes THEN RETURN;
Skip[
regObj.reader, SUCC[SUCC[SUCC[SUCC[owners]]]], SUCC[
SUCC[SUCC[friends]]]];
yes ← RegistryDefs.CheckStampList[regObj.reader, oldest];
END;
ENDCASE => ERROR;
END;
ReallyPurge: PUBLIC PROC [
name: BodyDefs.RName, regObj: RegBTreeDefs.RegistryObject,
oldest: BodyDefs.Timestamp]
RETURNS [yes: BOOLEAN, writer: HeapDefs.WriterHandle] =
BEGIN
SELECT regObj.type FROM
dead =>
BEGIN
yes ← RegistryDefs.CompareTimestamps[regObj.stamp, oldest] = less;
writer ← NIL
END;
individual =>
BEGIN
yes ← TRUE;
writer ← HeapDefs.HeapStartWrite[RSobject];
RegistryDefs.Copy[regObj.reader, writer]; --prefix--
Copy[regObj.reader, writer, prefixI, SUCC[SUCC[forward]]];
RegistryDefs.FilterStampList[regObj.reader, oldest, writer];
Copy[regObj.reader, writer, SUCC[SUCC[SUCC[forward]]], SUCC[SUCC[sites]]];
RegistryDefs.FilterStampList[regObj.reader, oldest, writer];
END;
group =>
BEGIN
yes ← TRUE;
writer ← HeapDefs.HeapStartWrite[RSobject];
RegistryDefs.Copy[regObj.reader, writer]; --prefix--
Copy[regObj.reader, writer, prefixG, SUCC[SUCC[members]]];
RegistryDefs.FilterStampList[regObj.reader, oldest, writer];
Copy[
regObj.reader, writer, SUCC[SUCC[SUCC[members]]], SUCC[SUCC[owners]]];
RegistryDefs.FilterStampList[regObj.reader, oldest, writer];
Copy[
regObj.reader, writer, SUCC[SUCC[SUCC[owners]]], SUCC[SUCC[friends]]];
RegistryDefs.FilterStampList[regObj.reader, oldest, writer];
END;
ENDCASE => ERROR;
IF regObj.reader # NIL THEN HeapDefs.HeapEndRead[regObj.reader];
END;
END.