-- Transport Mechanism Registration Server - Access to entries.

-- [Juniper]<Grapevine>MS>RegAccess.mesa

-- Andrew Birrell  17-Jul-81 13:48:50 

DIRECTORY
BodyDefs	USING [maxRNameLength, RName, Timestamp],
HeapDefs	USING [HeapAbandonWrite,
		       HeapEndRead, ObjectOffset,
		       objectStart, ReaderHandle,
		       SetReaderOffset,
		       WriterHandle],
LocalNameDefs	USING[ ReadRSName ],
LogDefs		USING[ WriteLogEntry, WriteString ],
ProtocolDefs	USING[ ReturnCode, RNameType ],
RegAccessDefs	USING[ NameState ],
RegBTreeDefs	USING[ Insert, KnownRegistry, Lookup,
		       LookupReason, RegistryObject, RegState,
		       TestKnownReg, UpdateFailed ],
RegistryDefs	USING[ EnumerateRList ],
RegServerDefs	USING[ EnumeratedMembers, IsInList, Membership,
		       MembershipLevel ],
SendDefs	USING[ AddRecipient, AddToItem, Create, Destroy, Handle,
		       StartItem, StartSend, StartSendInfo, Send ],
String		USING [AppendString, EquivalentStrings,
		       EquivalentSubStrings, SubStringDescriptor];

RegAccess: MONITOR
   IMPORTS HeapDefs, LocalNameDefs, LogDefs, RegBTreeDefs, RegistryDefs,
           RegServerDefs, SendDefs, String
   EXPORTS RegAccessDefs =

BEGIN

EndsWith: PROC[s: 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;



-- ================ Synchronization for Registry changes ================ --

-- This layer is concerned with the integrity of the "Registry" concept,
-- determining whether entries are in known registries and handling
-- changes in the set of known registries.
-- Under our monitor lock, Lookup determines whether this is the correct
-- R-Server for the lookup.  All updates also go through the monitor
-- lock, and retry if we have become (or ceased to be) the correct
-- server for that registry.  This includes the updates which alter our
-- set of registries.  The BTree changes provoked by the RegPurger are
-- exempt from this.

Lookup: PUBLIC PROC[name: BodyDefs.RName,
                    reason: RegBTreeDefs.LookupReason]
            RETURNS[info: RegAccessDefs.NameState] =
   BEGIN
   IF EndsWith[name, ".GV"L]
   THEN -- avoid deadlocking recursion on updates to GV names --
        BEGIN
        treeInfo: RegBTreeDefs.RegistryObject =
                                      RegBTreeDefs.Lookup[name, reason];
        info _ [yes --Beware: BTree may not have knownReg bits yet! --,
                treeInfo.type, treeInfo.stamp, treeInfo.reader];
        END
   ELSE info _ InnerLookup[name, reason];
   END;

InnerLookup: PUBLIC ENTRY PROC[name: BodyDefs.RName,
                          reason: RegBTreeDefs.LookupReason]
                RETURNS[info: RegAccessDefs.NameState] =
   BEGIN
   treeInfo: RegBTreeDefs.RegistryObject =
                                      RegBTreeDefs.Lookup[name, reason];
   info _ [yes, treeInfo.type, treeInfo.stamp, treeInfo.reader];
   IF info.type = notFound THEN info.regState _ CheckReg[name];
   END;


-- This module also contains a layer for producing MS internal mail.
-- For "Insert" where the old type was Individual, the old reader
-- is positioned to the mailbox site list.
-- To avoid problems at start-of-world, MS-mail is disabled in the early
-- stages of some restarts - see RegRestart.

OldReaderNeeded: ERROR = CODE;
CantCreateMSInternalMail: ERROR = CODE;
MSMailEnabled: BOOLEAN _ FALSE;

IsMSMailEnabled: ENTRY PROC RETURNS[ BOOLEAN ] = INLINE
   { RETURN[MSMailEnabled] };
   
EnableMSMail: ENTRY PROC = INLINE
   { MSMailEnabled _ TRUE };

Insert: PUBLIC PROCEDURE [name:   BodyDefs.RName,
                          type:   ProtocolDefs.RNameType,
                          stamp:  POINTER TO BodyDefs.Timestamp,
                          writer: HeapDefs.WriterHandle,
                          oldInfo:   POINTER TO RegAccessDefs.NameState]
      RETURNS[done: BOOLEAN] =
   BEGIN
   -- compose any message to mail servers before destroying the old reader,
   -- but we must commit the update before sending the mail (to avoid
   -- remote possibility of M-Server reading mail and re-evaluating site
   -- with old entry before we commit the update!).
   IF oldInfo.type = individual AND IsMSMailEnabled[]
   THEN BEGIN
        humanHint: STRING = "MS Internal mail for R-Name "L;
        myName: BodyDefs.RName;
        myPassword: STRING;
        mail: SendDefs.Handle = SendDefs.Create[];
        sendInfo: SendDefs.StartSendInfo;
        [myName, myPassword,] _ LocalNameDefs.ReadRSName[];
        sendInfo _ SendDefs.StartSend[
           handle: mail,
           sender: myName, senderPwd: myPassword,
           returnTo: "DeadLetter.MS"L, validate: FALSE];
        IF sendInfo # ok
        THEN ERROR CantCreateMSInternalMail[];
        IF oldInfo.reader = NIL THEN ERROR OldReaderNeeded[];
        -- oldInfo.reader exists and is at his mailbox site list --
        CopyRList[mail, oldInfo.reader];
        SendDefs.StartItem[mail, reMail];
        SendDefs.AddToItem[mail, DESCRIPTOR[ @(name.text), name.length]];
        SendDefs.StartItem[mail, Text];-- in case it gets to DeadLetter! --
        SendDefs.AddToItem[mail, DESCRIPTOR[ @(humanHint.text),
                                             humanHint.length ] ];
        SendDefs.AddToItem[mail, DESCRIPTOR[ @(name.text), name.length]];
        done _ ActualInsert[name, type, stamp, writer, oldInfo];
        IF done THEN SendDefs.Send[mail];
        SendDefs.Destroy[mail];
        END
   ELSE done _ ActualInsert[name, type, stamp, writer, oldInfo];
   END;

CopyRList: PROCEDURE[ message: SendDefs.Handle,
                      reader: HeapDefs.ReaderHandle] =
   BEGIN
   Work: PROC[name: BodyDefs.RName] RETURNS[done:BOOLEAN] =
      BEGIN
      done _ FALSE;
      FOR i: CARDINAL DECREASING IN [0..name.length)
      DO IF name[i] = '. THEN EXIT; REPEAT
      FINISHED => GOTO notGV
      ENDLOOP;
      SendDefs.AddRecipient[message, name];
      EXITS notGV => -- foreign mail server site --
        NULL;
      END;
   RegistryDefs.EnumerateRList[reader, Work];
   END;


ActualInsert: ENTRY PROC[ name: BodyDefs.RName,
                 type: ProtocolDefs.RNameType,
                 stamp: POINTER TO BodyDefs.Timestamp,
                 writer: HeapDefs.WriterHandle,
                 oldInfo: POINTER TO RegAccessDefs.NameState ]
      RETURNS[done: BOOLEAN] =
   BEGIN
   -- If done=FALSE at return, then oldInfo^ has been updated --
   ENABLE UNWIND => NULL;
   treeInfo: RegBTreeDefs.RegistryObject _
         [oldInfo.type, oldInfo.stamp, oldInfo.reader];
   nameIsGVGV: BOOLEAN = String.EquivalentStrings[name, "GV.GV"L];
   -- "GV.GV" is special only during the InitializeWorld restart sequence--
   IF oldInfo.type = notFound AND NOT nameIsGVGV
   THEN BEGIN
	newRegState: RegBTreeDefs.RegState = CheckReg[name];
        IF newRegState # oldInfo.regState
        THEN BEGIN
             IF writer # NIL THEN HeapDefs.HeapAbandonWrite[writer];
             IF oldInfo.reader # NIL
             THEN HeapDefs.SetReaderOffset[oldInfo.reader, 
                                           HeapDefs.objectStart];
             oldInfo.regState _ newRegState;
             RETURN[FALSE]
             END;
	END;
   BEGIN
      CheckOneOfMine: INTERNAL PROC[type: ProtocolDefs.RNameType]
                             RETURNS[BOOLEAN] =
         BEGIN
         -- determines whether "name" is a registry known to this server --
         -- don't call ReadRSName[] when creating FirstRS.gv! --
         RETURN[ type = group
           AND EndsWith[name, ".GV"L]
           AND ( nameIsGVGV
               OR RegServerDefs.IsInList[name,
                                         LocalNameDefs.ReadRSName[].name,
                                         direct, self, members
                                         ].membership
                     = yes
               ) ]
         END;
      wasMine: BOOLEAN = CheckOneOfMine[oldInfo.type];
      isMine: BOOLEAN;
      RegBTreeDefs.Insert[name, type, stamp, writer, @treeInfo !
         RegBTreeDefs.UpdateFailed => {treeInfo _ info; GOTO failed}];
      -- BTree sets knownReg bit FALSE --
      done _ TRUE;
      isMine _ CheckOneOfMine[type];
      SELECT TRUE FROM
        isMine =>
          { RegBTreeDefs.KnownRegistry[name, TRUE];
            IF NOT wasMine THEN LogAddition[name] };
        wasMine AND NOT isMine =>
          { RegBTreeDefs.KnownRegistry[name, FALSE];
            LogRemoval[name];
            StartChanger[name, FALSE] -- may unlock monitor -- };
      ENDCASE => NULL;
      EXITS failed =>
         BEGIN
         oldInfo^ _ [CheckReg[name],
                     treeInfo.type, treeInfo.stamp, treeInfo.reader];
         done _ FALSE;
         END;
   END;
   END;

LogAddition: INTERNAL PROC[name: BodyDefs.RName] =
   BEGIN
   log: STRING = [84];
   String.AppendString[log, "New registry "L];
   String.AppendString[log, name];
   LogDefs.WriteLogEntry[log]; LogDefs.WriteString[log];
   END;

LogRemoval: INTERNAL PROC[name: BodyDefs.RName] =
   BEGIN
   log: STRING = [84];
   String.AppendString[log, "Remove registry "L];
   String.AppendString[log, name];
   LogDefs.WriteLogEntry[log]; LogDefs.WriteString[log];
   END;

BadRegName: ERROR = CODE;

regChangerIdle: BOOLEAN _ FALSE;
regChangerWanted: BOOLEAN _ FALSE;
regChangerCond: CONDITION;
regChangerName: BodyDefs.RName;
regChangerAdd: BOOLEAN;

StartChanger: INTERNAL PROC[name: BodyDefs.RName, add: BOOLEAN] =
   BEGIN
   UNTIL regChangerIdle DO WAIT regChangerCond ENDLOOP;
   regChangerIdle _ FALSE; -- prevent others attempting to call it --   
   regChangerName _ name;
   regChangerAdd _ add;
   regChangerWanted _ TRUE;-- ask it to listen --
   BROADCAST regChangerCond;
   WHILE regChangerWanted DO WAIT regChangerCond ENDLOOP;--let it take args--
   END;

GetChangerArg: ENTRY PROC[regName: BodyDefs.RName] RETURNS[add: BOOLEAN] =
   BEGIN
   regChangerIdle _ TRUE; BROADCAST regChangerCond; -- open for calls --
   UNTIL regChangerWanted DO WAIT regChangerCond ENDLOOP;
   regName.length _ 0;
   String.AppendString[regName, "All."L];
   FOR i: CARDINAL DECREASING IN [0..regChangerName.length)
   DO IF regChangerName[i] = '.
      THEN BEGIN
           realLength: CARDINAL = regChangerName.length;
           regChangerName.length _ i;
           String.AppendString[regName, regChangerName];
           regChangerName.length _ realLength;
           EXIT
           END;
   REPEAT
   FINISHED => ERROR BadRegName[];
   ENDLOOP;
   add _ regChangerAdd;
   regChangerWanted _ FALSE; BROADCAST regChangerCond;-- free caller --
   END;

RegChanger: PROC =
   BEGIN
   DO regName: BodyDefs.RName = [BodyDefs.maxRNameLength];
      IF GetChangerArg[regName]
      THEN ERROR --add registry --
      ELSE DoRemoval[regName];
   ENDLOOP;
   END;

DoRemoval: PROC[regName: BodyDefs.RName] =
   BEGIN
   -- regName is "All.reg" --
   LogDefs.WriteLogEntry["Starting removal"L];
   BEGIN
      reader: HeapDefs.ReaderHandle =
                RegServerDefs.EnumeratedMembers[regName, notFound--ugh!--];
      Action: PROC[entry: BodyDefs.RName] RETURNS[done: BOOLEAN] =
         BEGIN
         done _ FALSE;
         RegBTreeDefs.Insert[entry, notFound,NIL,NIL,NIL];
         END;
      RegistryDefs.EnumerateRList[reader, Action];
      HeapDefs.HeapEndRead[reader];
   END;
   LogDefs.WriteLogEntry["End of removal"L];
   END;

CheckReg: INTERNAL PROC[name: BodyDefs.RName]
                RETURNS[RegBTreeDefs.RegState] =
   BEGIN
   -- determines whether "name" is in a valid and/or local registry --
   RETURN[ RegBTreeDefs.TestKnownReg[name] ]
   END;

Abandon: PUBLIC PROCEDURE[name: BodyDefs.RName,
                   nameObj: POINTER TO RegAccessDefs.NameState]
           RETURNS[rc: ProtocolDefs.ReturnCode] =
  BEGIN
  IF nameObj.reader # NIL THEN HeapDefs.HeapEndRead[nameObj.reader];
  rc _ IF nameObj.type = notFound AND nameObj.regState = no
       THEN [WrongServer, nameObj.type]
       ELSE [BadRName, nameObj.type];
  END;


regChangerProcess: PROCESS = FORK RegChanger[];

STOP;

EnableMSMail[];

END.