-- 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.