-- Transport Mechanism Registration Server - Operations on entries in a registry.

-- [Indigo]<Grapevine>MS>RegServerImpl.mesa

-- Randy Gobbel,	19-May-81 18:51:53 
-- J. Dion,		September 8, 1979
-- Andrew Birrell,	27-Oct-82 15:46:02 

DIRECTORY
BodyDefs	USING [maxRNameLength, oldestTime, RName, 
		       RNameSize, Timestamp],
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, 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" --
  IF CheckForOwners[entry]
  THEN BEGIN
       IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
       [reader, rc] _ ReadOwners[entry, stamp];
       IF rc.code = done AND RegistryDefs.SkipIfEmpty[reader]
       THEN BEGIN -- owner list is empty, so use registry --
            HeapDefs.HeapEndRead[reader];
            [reader, rc] _ ReadRegistryFriends[entry, 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[entry, 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[entry, @nameObj];
       END;
    nameObj.type = notFound OR nameObj.type = dead =>
       rc _ RegAccessDefs.Abandon[entry, @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[entry, @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[entry, @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[entry, @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[entry, @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: STRING, b: 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: STRING, b: 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[entry, @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[entry, @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[entry, @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[entry, @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: STRING] RETURNS[BOOLEAN] = INLINE
   { RETURN[ p.length > 0 AND p[0] = '* ] };

StarMatch: PROC[pattern, name: 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[name, @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[name, @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[name, @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[new, @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[entry, @nameObj];
     EXIT
  ENDLOOP;
  END;

AddMailbox: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                     RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, AddMailBox];
  END;

DeleteMailbox: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                        RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, DeleteMailBox];
  END;

AddForward: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                     RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, AddForward];
  END;

DeleteForward: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                        RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, DeleteForward];
  END;

AddMember: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                    RETURNS [rc: ReturnCode] =
  BEGIN
  [rc] _ UpdateSublist[name, entry, AddMember]
  END;

DeleteMember: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                       RETURNS [rc: ReturnCode] =
  BEGIN
  [rc] _ UpdateSublist[name, entry, DeleteMember]
  END;

AddOwner: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                        RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, AddOwner]
  END;

DeleteOwner: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                           RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, DeleteOwner]
  END;

AddFriend: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                     RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, AddFriend]
  END;

DeleteFriend: PUBLIC PROCEDURE [name, entry: BodyDefs.RName]
                        RETURNS [rc: ReturnCode] =
  BEGIN
  rc _ UpdateSublist[name, entry, DeleteFriend]
  END;

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] =
   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[name, @nameObj];
     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[name, @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: STRING = [140];
   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];
   IF brief THEN LogDefs.WriteString["Brief "L];
   LogDefs.WriteString["Merge "L]; LogDefs.WriteString[name];
   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.