-- Copyright (C) 1981, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- RegAccess.mesa, Transport Mechanism Registration Server - Access to entries.

-- HGM,  15-Sep-85  3:59:01 
-- Andrew Birrell  17-Jul-81 13:48:50 
-- Hankins		13-Aug-84  8:19:25	(Klamath update - remove STOPs)

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

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

  BEGIN

  EndsWith: PROC [s: LONG STRING, b: LONG STRING] RETURNS [BOOLEAN] =
    BEGIN
    pattern: String.SubStringDescriptor ¬ [b, 0, b.length];
    target: String.SubStringDescriptor ¬ [s, s.length - b.length, b.length];
    RETURN[
      s.length >= b.length AND String.EquivalentSubStrings[@pattern, @target]]
    END;



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

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

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

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


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

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

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

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

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


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

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

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

  BadRegName: ERROR = CODE;

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

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

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

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

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

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

  Abandon: PUBLIC PROCEDURE [
    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;

  RegAccessInit: PUBLIC PROCEDURE = {regChangerProcess ¬ FORK RegChanger[]};

  RegAccessMSMailEnabled: PUBLIC ENTRY PROCEDURE = {MSMailEnabled ¬ TRUE};


  END.