-- Transport Mechanism Registration Server - restart sequence.

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

-- Randy Gobbel,	20-May-81 10:37:16 
-- Andrew Birrell,	29-Oct-82 10:16:19
-- Mike Schroeder	25-Jan-83 15:48:25 

DIRECTORY
BodyDefs	USING [maxRNameLength, oldestTime, Password, RName, 
		       Timestamp],
EnquiryDefs	USING [],
HeapDefs	USING [HeapAbandonWrite, HeapEndWrite, HeapEndRead,
		       HeapReadData, HeapReadRName, HeapStartRead,
		       HeapStartWrite, ObjectNumber,
		       ReceiveComponent, ReaderHandle, ReadRList,
		       WriterHandle],
LocalNameDefs	USING[ ReadRSName ],
LocateDefs	USING[ FindNearestServer, FindRegServer, FoundServerInfo ],
LogDefs		USING[ WriteChar, WriteLine, WriteLogEntry, WriteString ],
ObjectDirDefs	USING[ Enumerate, UseObject ],
PolicyDefs	USING[ EndOperation, WaitOperation ],
Process		USING[ Detach ],
ProtocolDefs,
PupDefs		USING[ PupAddress ],
RegAccessDefs	USING[ RegAccess ],
RegBTreeDefs	USING[ EnumerateTree, KeepObject, Lookup, LookupReason,
		       MarkKnown, RegBTree, RegistryObject, RegPurger,
		       TestKnownReg ],
RegServerDefs	USING[ AddMailbox, AddMember, AddOwner, ChangeConnect, CreateGroup,
		       CreateIndividual, IsMember, MailUpdate, ReadMail,
		       ReadMembers, Registration, RegMail, Update ],
RegistryDefs	USING[ CompareTimestamps, EnumerateRList, MakeTimestamp,
		       ReadPrefix],
RestartDefs	USING[ ],
Runtime		USING[ CallDebugger ],
String		USING[ AppendString, EquivalentString,
		       EquivalentSubStrings, SubStringDescriptor ],
Time		USING[ Append, Packed, Unpack ];

RegRestart: PROGRAM[ initHeap: BOOLEAN ]
   IMPORTS HeapDefs, LocalNameDefs, LocateDefs, LogDefs, ObjectDirDefs,
           PolicyDefs, Process, ProtocolDefs, RegAccessDefs, RegBTreeDefs,
           RegServerDefs, RegistryDefs, Runtime, String, Time
   EXPORTS EnquiryDefs--AddRegistry--, RestartDefs --PROGRAM-- =

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;

maxDownTime: CARDINAL _ 4 -- days --;

WaitForTime: PROC[then: BodyDefs.Timestamp] =
   BEGIN
   log: STRING = [64];
   futureLimit: Time.Packed _ 
     LOOPHOLE[then.time + (LONG[maxDownTime] * 24) * 60 * 60];
   -- Note: "CompareTimestamps" treats very future times as zero --
   IF RegistryDefs.CompareTimestamps[then, RegistryDefs.MakeTimestamp[]]
         # less
   THEN BEGIN
        String.AppendString[log, "Current time is less than "L];
        Time.Append[log, Time.Unpack[then.time]];
        LogDefs.WriteLogEntry[log];
        Runtime.CallDebugger[log];
        END;
   IF RegistryDefs.MakeTimestamp[].time > futureLimit
   THEN BEGIN
        log.length _ 0;
        String.AppendString[log, "Current time is too long after "L];
        Time.Append[log, Time.Unpack[then.time]];
        LogDefs.WriteLogEntry[log];
        Runtime.CallDebugger[log];
        END;
   END;

FindKnownRegistries: PROC =
  BEGIN
  myName: BodyDefs.RName = LocalNameDefs.ReadRSName[].name;
  CheckLocalRegistry: PROC[name: BodyDefs.RName] =
    BEGIN
    IF MyRegistry[myName, name]
    THEN { LogDefs.WriteString["Known registry "L];
           LogDefs.WriteString[name];
           LogDefs.WriteString["; "L];
           SIGNAL RegBTreeDefs.MarkKnown[] };
    END;
  RegBTreeDefs.EnumerateTree[group, CheckLocalRegistry];
  END;

MyRegistry: PROC[myName, group: BodyDefs.RName] RETURNS[ BOOLEAN ] = INLINE
   { RETURN[ RegServerDefs.IsMember[group, myName, direct].membership =
                yes ] };

baseOfWorld: BodyDefs.RName = "GV.GV";

InitializeFromLocalHeap: PROCEDURE RETURNS[limit: BodyDefs.Timestamp] =
  BEGIN
  registries: BOOLEAN _ TRUE; -- registries on first pass, then others --
  RestartObject: PROCEDURE [object: HeapDefs.ObjectNumber] RETURNS [BOOLEAN] =
    BEGIN
    oldRegObj:   RegBTreeDefs.RegistryObject;
    newReader:   HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[object];
    newName:     BodyDefs.RName = [BodyDefs.maxRNameLength];
    newType:     ProtocolDefs.RNameType;
    newStamp:    BodyDefs.Timestamp;
    [newType, newStamp] _ RegistryDefs.ReadPrefix[newReader, newName];
    IF EndsWith[newName,".GV"L] = registries
    THEN BEGIN
         -- first pass: only names ending with ".gv"
         -- second pass: only names not ending with ".gv"
         IF registries OR RegBTreeDefs.TestKnownReg[newName] = yes
         THEN BEGIN
              IF RegistryDefs.CompareTimestamps[newStamp, limit] = greater
              THEN limit _ newStamp;
              oldRegObj _ RegBTreeDefs.Lookup[newName, readNone];
              IF oldRegObj.type = notFound
              OR RegistryDefs.CompareTimestamps[oldRegObj.stamp,newStamp] = less
              THEN RegBTreeDefs.KeepObject[newName, newType, @newStamp, object];
              IF oldRegObj.reader # NIL
              THEN  HeapDefs.HeapEndRead[oldRegObj.reader];
              END
         ELSE LogDiscard[newName];
         END;
    HeapDefs.HeapEndRead[newReader];
    RETURN [FALSE]; -- ie keep enumerating
    END;
  limit _ BodyDefs.oldestTime;
  [] _ ObjectDirDefs.Enumerate[RSobject, RestartObject];
  FindKnownRegistries[];
  registries _ FALSE;
  [] _ ObjectDirDefs.Enumerate[RSobject, RestartObject];
  limit _ RecoverRSMailObjects[limit];
  WaitForTime[limit];
  END;

LogDiscard: PROC[name: BodyDefs.RName] =
   BEGIN
   log: STRING = [80];
   String.AppendString[log, "Discarded "L];
   String.AppendString[log, name];
   LogDefs.WriteLogEntry[log];
   LogDefs.WriteChar[' ];
   LogDefs.WriteString[log];
   END;

initializeWorldCalled: BOOLEAN _ FALSE;

InitializeWorld: PROCEDURE =
   BEGIN
   OPEN RegServerDefs;
   -- Must be called only if this is the first R-Server in the world --
   wizard: BodyDefs.RName = "Wizard.gv"L;
   firstRS: BodyDefs.RName = "FirstRS.gv"L;
   msReg: BodyDefs.RName = "MS.gv"L;
   deadLetter: BodyDefs.RName = "DeadLetter.ms"L;
   firstMS: BodyDefs.RName = "FirstMS.ms"L;
   maildrop: BodyDefs.RName = "MailDrop.ms"L;
   foreignReg: BodyDefs.RName = "Foreign.gv"L;
   [] _ CreateGroup[baseOfWorld, wizard]; -- GV.GV
   [] _ AddMember[baseOfWorld, firstRS];
   [] _ CreateIndividual[wizard, ProtocolDefs.MakeKey["grapevine"L]];
   [] _ CreateIndividual[firstRS, ProtocolDefs.MakeKey["grapevine"L]];
   [] _ ChangeConnect[firstRS, "ME"L];
   RESTART RegServerDefs.Registration; -- in "local" mode --
   FindKnownRegistries[];
   [] _ CreateGroup[msReg, wizard]; -- create "MS" registry
   [] _ AddMember[msReg, firstRS]; -- known to this R-Server
   [] _ CreateGroup[deadLetter, wizard]; -- deadLetter.ms for "return-to" in update mail
   [] _ CreateIndividual[firstMS, ProtocolDefs.MakeKey["grapevine"L]]; -- MS-name
   [] _ ChangeConnect[firstMS, "ME"L];
   [] _ CreateGroup[maildrop, wizard];
   [] _ AddMailbox[firstRS, firstMS];
   [] _ AddMailbox[firstMS, firstMS];
   [] _ AddMailbox[wizard, firstMS];
   [] _ AddMember[deadLetter, wizard];
   [] _ AddMember[maildrop, firstMS];
   [] _ CreateGroup[foreignReg, wizard]; -- create "Foreign" registry
   [] _ AddMember[foreignReg, firstRS]; -- known to this R-Server
   [] _ AddOwner[baseOfWorld, wizard];
   [] _ AddOwner[msReg, wizard];
   [] _ AddOwner[foreignReg, wizard];
   initializeWorldCalled _ TRUE;
   END;


ThisServerIsntInGrapevine: ERROR = CODE;

InitializeServer: PROCEDURE[myName: BodyDefs.RName,
                            myKey: BodyDefs.Password] =
   BEGIN
   -- Must be called only if this server's database is empty --
   rc: ProtocolDefs.ReturnCode;
   reader: HeapDefs.ReaderHandle;
   oldTimePtr: BodyDefs.Timestamp _ BodyDefs.oldestTime; --ugh!--
   LogDefs.WriteLine["Initializing Registration Server"L];
   LogDefs.WriteLogEntry["Initializing RServer"L];
   FetchRegistry[baseOfWorld, myName, myKey];
   FindKnownRegistries[];
   IF NOT MyRegistry[myName, baseOfWorld]
   THEN ERROR ThisServerIsntInGrapevine[];
   [reader, rc] _ RegServerDefs.ReadMembers["Groups.GV"L, @oldTimePtr];
   IF rc # [code: done, type: group] THEN ERROR;
   BEGIN
      Work: PROC[name: BodyDefs.RName] RETURNS[done: BOOLEAN] =
         BEGIN
         done _ FALSE;
         IF NOT String.EquivalentString[name, baseOfWorld]
         AND MyRegistry[myName, name]
         THEN FetchRegistry[name, myName, myKey];
         END;
      RegistryDefs.EnumerateRList[reader, Work];
      HeapDefs.HeapEndRead[reader];
   END;
   END;

AddSelfToRegistry: PUBLIC PROC[name: BodyDefs.RName]
         RETURNS[done: BOOLEAN] =
   BEGIN
   IF RegServerDefs.IsMember["*.gv", name, direct].membership # yes
   THEN RETURN[FALSE];
   IF RegServerDefs.AddMember[name, LocalNameDefs.ReadRSName[].name]
         # [done, group]
   THEN RETURN[FALSE];
   RETURN[TRUE]
   END;

AddRegistry: PUBLIC PROC[name: BodyDefs.RName]
         RETURNS[done: BOOLEAN] =
   BEGIN
   myName: BodyDefs.RName;
   myKey: BodyDefs.Password;
   [myName,,myKey] _ LocalNameDefs.ReadRSName[];
   IF NOT MyRegistry[myName, name] THEN RETURN[FALSE];
   done _ TRUE;
   FetchRegistry[name, myName, myKey !
     CantFetchRegistry => {done _ FALSE; CONTINUE} ];
   END;

CantFetchRegistry: ERROR[name: BodyDefs.RName] = CODE;

FetchRegistry: PROCEDURE[name, myName: BodyDefs.RName,
                         myKey: BodyDefs.Password] =
   BEGIN
   str: ProtocolDefs.Handle _ NIL;
   AcceptNonLocal: PROCEDURE[addr: PupDefs.PupAddress]RETURNS[ BOOLEAN ] =
      BEGIN
      IF ProtocolDefs.IsLocal[addr]
      THEN RETURN[FALSE]
      ELSE BEGIN
           addr.socket _ ProtocolDefs.RegServerEnquirySocket;
           str _ ProtocolDefs.CreateStream[addr: addr, secs: 600 !
                    ProtocolDefs.Failed => GOTO no ];
           RETURN[TRUE];
           EXITS no => RETURN[FALSE]
           END;
      END;
   BEGIN
      ENABLE UNWIND => IF str # NIL THEN str.delete[str];
      info: LocateDefs.FoundServerInfo =
         LocateDefs.FindNearestServer[name, AcceptNonLocal];
      LogDefs.WriteString["FetchRegistry: "L];
      LogDefs.WriteLine[name];
      WITH info SELECT FROM
        notFound, allDown => ERROR CantFetchRegistry[name];
        found =>
          BEGIN
          ENABLE ProtocolDefs.Failed => ERROR CantFetchRegistry[name];
          BEGIN
            rc: ProtocolDefs.ReturnCode;
            ProtocolDefs.SendRSOperation[str, IdentifyCaller];
            ProtocolDefs.SendRName[str, myName];
            ProtocolDefs.SendPassword[str:str, pw:myKey, key:[0,0,0,0]];
            ProtocolDefs.SendNow[str];
            rc _ ProtocolDefs.ReceiveRC[str];
            IF rc.code # done THEN ERROR CantFetchRegistry[name];
          END;
          FetchSingleEntry[name, str]; -- particularly "GV.GV" very early!
          FetchType[group, name, str];
          FetchType[individual, name, str];
          FetchType[dead, name, str];
          END;
      ENDCASE => ERROR;
   END;
   IF str # NIL THEN str.delete[str];
   END;

MakeRNameInRegistry: PROCEDURE [sname, reg, destination: BodyDefs.RName] =
  BEGIN
  -- sname is of the form "SN.something" or just "SN"
  -- reg is of the form "NA.something" or just "NA"
  -- assumes that SN and NA do not contain '.
  -- constructs "SN.NA", truncating NA if needed
  sep: CHARACTER = '.;
  destination.length _ 0;
  FOR index: CARDINAL IN [0..sname.length) WHILE sname[index] # sep
  DO IF destination.length = destination.maxlength THEN ERROR;
     destination[destination.length] _ sname[index];
     destination.length _ destination.length + 1;
  ENDLOOP;
  IF destination.length = destination.maxlength THEN RETURN;
  destination[destination.length] _ sep;
  destination.length _ destination.length + 1;
  FOR index: CARDINAL IN [0..reg.length) WHILE reg[index] # sep
  DO IF destination.length = destination.maxlength THEN EXIT;
     destination[destination.length] _ reg[index];
     destination.length _ destination.length + 1;
  ENDLOOP;
  END;

FetchType: PROCEDURE[type: ProtocolDefs.RNameType, registry: BodyDefs.RName,
                     str: ProtocolDefs.Handle ] =
   BEGIN
   writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[temp];
   BEGIN
      ENABLE UNWIND => HeapDefs.HeapAbandonWrite[writer];
      typeName: BodyDefs.RName = [BodyDefs.maxRNameLength];
      MakeRNameInRegistry[SELECT type FROM
                            group => "Groups"L, individual => "Individuals"L,
                            dead => "Dead"L, ENDCASE => ERROR,
                          registry, typeName];
      IF ProtocolDefs.Enquire[str, ReadMembers, typeName].rc
         # [code:done, type:group] THEN ERROR;
      HeapDefs.ReceiveComponent[writer, str];
   END;
   BEGIN
      GetEntries: PROCEDURE[ obj: HeapDefs.ObjectNumber] =
         BEGIN
         reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[obj];
         Work: PROCEDURE[entry: BodyDefs.RName] RETURNS[done: BOOLEAN] =
            { FetchSingleEntry[entry, str]; done _ FALSE };
         HeapDefs.ReadRList[reader, Work !
                            UNWIND => HeapDefs.HeapEndRead[reader] ];
         HeapDefs.HeapEndRead[reader];
         END;
      HeapDefs.HeapEndWrite[writer, GetEntries ];
   END;
   END;

FetchSingleEntry: PROCEDURE[entry: BodyDefs.RName,
                            str: ProtocolDefs.Handle] =
   BEGIN
      writer: HeapDefs.WriterHandle = HeapDefs.HeapStartWrite[temp];
      BEGIN
         ENABLE UNWIND => HeapDefs.HeapAbandonWrite[writer];
         IF ProtocolDefs.Enquire[str, ReadEntry, entry].rc.code # done
         THEN ERROR;
         THROUGH [0.. ProtocolDefs.ReceiveCount[str] )
         DO HeapDefs.ReceiveComponent[writer, str]; ENDLOOP;
      END;
      HeapDefs.HeapEndWrite[writer, RegServerDefs.Update];
   END;

RecoverRSMailObjects: PROC[oldLimit: BodyDefs.Timestamp]
                   RETURNS[limit: BodyDefs.Timestamp] =
   BEGIN
   -- enumerate the heap looking for objects of the type created by
   -- RecordDelivery. These define updates which might not have been
   -- mailed before we crashed. These objects contain the time at which
   -- they were written, so that we can distinguish them later from
   -- objects written during this run.
   name: BodyDefs.RName = [BodyDefs.maxRNameLength];
   Look: PROC[object: HeapDefs.ObjectNumber] RETURNS[found: BOOLEAN] =
      BEGIN
      reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[object];
      then: Time.Packed;
      thenStamp: BodyDefs.Timestamp _ BodyDefs.oldestTime;
      [] _ HeapDefs.HeapReadRName[reader, name];
      [] _ HeapDefs.HeapReadData[reader,
               [@then, SIZE[Time.Packed]] ];
      ObjectDirDefs.UseObject[object];
      HeapDefs.HeapEndRead[reader];
      thenStamp.time _ then;
      -- CompareTimestamps includes a garbage check --
      IF RegistryDefs.CompareTimestamps[thenStamp, limit] = greater
      THEN limit _ thenStamp;
      RETURN[FALSE] --i.e. keep enumerating--
      END;
   limit _ oldLimit;
   [] _ ObjectDirDefs.Enumerate[RSmail, Look];
   END;

ActOnRSMailObjects: PROC[limit: Time.Packed] =
   BEGIN
   name: BodyDefs.RName = [BodyDefs.maxRNameLength];
   Look: PROC[object: HeapDefs.ObjectNumber] RETURNS[found: BOOLEAN] =
      BEGIN
      reader: HeapDefs.ReaderHandle = HeapDefs.HeapStartRead[object];
      then: Time.Packed;
      [] _ HeapDefs.HeapReadRName[reader, name];
      [] _ HeapDefs.HeapReadData[reader,
               [@then, SIZE[Time.Packed]] ];
      HeapDefs.HeapEndRead[reader];
      IF then <= limit
      THEN RegServerDefs.MailUpdate[entry: name, stamp:, element: NIL, op: ReadEntry,
                                             rsMailObj: object];
      RETURN[FALSE] --i.e. keep enumerating--
      END;
   PolicyDefs.WaitOperation[regExpand];
   [] _ ObjectDirDefs.Enumerate[RSmail, Look];
   PolicyDefs.EndOperation[regExpand];
   END;

IsThisTheFirstRServerInTheWorld: SIGNAL = CODE;

Restart: PROC =
  BEGIN
  -- We'd prefer to consult other reg servers, not ourselves.
  -- If no other is up, we're willing to use ourself.
  -- If our heap is empty and no-one else is up, we can't proceed
  -- unless we're the first in the world;  in that case the operator
  -- must use the debugger to call "InitializeWorld".

  AcceptNonLocal: PROCEDURE[addr: PupDefs.PupAddress] RETURNS[BOOLEAN] =
     BEGIN RETURN[ NOT ProtocolDefs.IsLocal[addr] ] END;
  info: LocateDefs.FoundServerInfo =
              LocateDefs.FindRegServer[baseOfWorld, AcceptNonLocal];
  myName: BodyDefs.RName;
  myPassword: STRING;
  myKey: BodyDefs.Password;
  START RegServerDefs.Registration; -- in "none" mode --
  START RegServerDefs.RegMail; -- with update propagation disbaled! --
  START RegBTreeDefs.RegBTree;
  START RegAccessDefs.RegAccess; -- with MS internal mail disabled! --
  IF initHeap
  THEN BEGIN
       IF info.t = allDown -- no other servers up --
       THEN BEGIN
            UNTIL initializeWorldCalled
	    DO SIGNAL IsThisTheFirstRServerInTheWorld[] ENDLOOP;
            -- operator should call "InitializeWorld" from the debugger --
	    RESTART RegServerDefs.RegMail; -- enable update propagation --
	    RESTART RegAccessDefs.RegAccess; -- enable MS internal mail --
            [myName,myPassword,myKey] _ LocalNameDefs.ReadRSName[];
            END
       ELSE BEGIN
	    RESTART RegServerDefs.RegMail; -- enable update propagation --
	    RESTART RegAccessDefs.RegAccess; -- enable MS internal mail --
            [myName,myPassword,myKey] _ LocalNameDefs.ReadRSName[];
            InitializeServer[myName, myKey];
            RESTART RegServerDefs.Registration; -- in "local" mode --
            END;
       END
  ELSE BEGIN
       RESTART RegServerDefs.RegMail; -- enable update propagation --
       RESTART RegAccessDefs.RegAccess; -- enable MS internal mail --
       IF info.t = allDown -- no other servers up --
       THEN RESTART RegServerDefs.Registration; -- in "local" mode --
       rsMailLimit _ InitializeFromLocalHeap[]; -- also gets local name --
       [myName,myPassword,myKey] _ LocalNameDefs.ReadRSName[];
       IF info.t # allDown
       THEN RESTART RegServerDefs.Registration; -- in "local" mode --
       END;
  END;


rsMailLimit: BodyDefs.Timestamp _ BodyDefs.oldestTime;

Restart[];

STOP;

-- now Compactor has started --

Process.Detach[
  FORK ActOnRSMailObjects[rsMailLimit.time]--may wait on PolicyDefs--];

RegServerDefs.ReadMail[];

RegBTreeDefs.RegPurger[];

RESTART RegServerDefs.Registration; -- in "all" mode --

END.