-- Copyright (C) 1981, 1982, 1984, 1985 by Xerox Corporation. All rights reserved.
-- Transport Mechanism Registration Server - restart sequence.
-- RegRestart.mesa, HGM, 15-Sep-85 7:54:19
-- Randy Gobbel, 20-May-81 10:37:16
-- Andrew Birrell, 29-Oct-82 10:16:19
-- Ted Wobber, 2-Nov-82 11:28:09
-- Brenda Hankins 20-Aug-84 17:01:42 Klamath update
DIRECTORY
BodyDefs USING [maxRNameLength, oldestTime, Password, RName, Timestamp],
EnquiryDefs USING [],
Heap USING [systemZone],
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],
LogPrivateDefs USING [tty],
ObjectDirDefs USING [Enumerate, UseObject],
PolicyDefs USING [EndOperation, WaitOperation],
Process USING [Detach],
ProtocolDefs,
PupDefs USING [PupAddress],
RegAccessDefs USING [RegAccessInit, RegAccessMSMailEnabled],
RegBTreeDefs USING [
EnumerateTree, KeepObject, Lookup, LookupReason, MarkKnown, RegBTree,
RegistryObject, RegPurger, TestKnownReg],
RegServerDefs USING [
AddMailbox, AddMember, AddOwner, ChangeConnect, CreateGroup, CreateIndividual,
IsMember, MailUpdate, ReadMail, ReadMembers, RegistrationAll,
RegistrationInit, RegistrationLocal, RegMailEnableUpdates, RegMailInit,
Update],
RegistryDefs USING [
CompareTimestamps, EnumerateRList, MakeTimestamp, ReadPrefix],
RestartDefs USING [],
Runtime USING [CallDebugger],
String USING [
AppendString, EquivalentString, EquivalentSubStrings, SubStringDescriptor],
Time USING [Append, Packed, Unpack],
TTY USING [GetChar, PutCR, PutChar, PutString];
RegRestart: PROGRAM
IMPORTS
Heap, HeapDefs, LocalNameDefs, LocateDefs, LogDefs, LogPrivateDefs, ObjectDirDefs,
PolicyDefs, Process, ProtocolDefs, RegAccessDefs, RegBTreeDefs, RegServerDefs,
RegistryDefs, Runtime, String, Time, TTY
EXPORTS EnquiryDefs --AddRegistry-- , RestartDefs =
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;
maxDownTime: CARDINAL ← 4 -- days -- ;
WaitForTime: PROC [then: BodyDefs.Timestamp] =
BEGIN
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
log: LONG STRING ← Heap.systemZone.NEW[StringBody[500]];
String.AppendString[log, "Current time is less than "L];
Time.Append[log, Time.Unpack[[then.time]]];
String.AppendString[log, ". Consult a wizard!"L];
LogDefs.WriteLogEntry[log];
Runtime.CallDebugger[log];
Heap.systemZone.FREE[@log];
END;
IF RegistryDefs.MakeTimestamp[].time > futureLimit THEN
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[500]];
String.AppendString[log, "The current time is "L];
Time.Append[log, Time.Unpack[[RegistryDefs.MakeTimestamp[].time]]];
String.AppendString[log, ".\nThat's too long after "L];
Time.Append[log, Time.Unpack[[then.time]]];
String.AppendString[log, ".
If the time really is correct and your server has been down for more than 4 days, type P and CR.
BE VERY CAREFUL! If in doubt, consult a wizard."L];
LogDefs.WriteLogEntry[log];
Runtime.CallDebugger[log];
Heap.systemZone.FREE[@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: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
String.AppendString[log, "Unknown: "L];
String.AppendString[log, name];
LogDefs.WriteLogEntry[log];
LogDefs.WriteChar[' ];
LogDefs.WriteString[log];
Heap.systemZone.FREE[@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];
RegServerDefs.RegistrationLocal[]; -- put Registration into "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 RServer"L];
LogDefs.WriteLogEntry["Initializing Registration Server"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;
BailOut: SIGNAL = CODE;
Restart: PROCEDURE [initHeap: BOOLEAN] =
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: LONG STRING;
myKey: BodyDefs.Password;
RegServerDefs.RegistrationInit[]; -- start Registration in "none" mode --
RegServerDefs.RegMailInit[]; -- start RegMail with update propagation disbaled!
START RegBTreeDefs.RegBTree;
RegAccessDefs.RegAccessInit[]; -- with MS internal mail disabled! --
IF initHeap THEN
BEGIN
IF info.t = allDown -- no other servers up --
THEN
BEGIN
wish: CHARACTER;
DO
TTY.PutString[
LogPrivateDefs.tty,
"No other RServers were found. Type 'Y' if this the first RServer in The World (you better be correct...) : "L];
wish ← TTY.GetChar[LogPrivateDefs.tty];
TTY.PutChar[LogPrivateDefs.tty, wish];
TTY.PutCR[LogPrivateDefs.tty];
SELECT wish FROM
'N, 'n => SIGNAL BailOut[];
-- it could be that others are just down, then what? reboot?
'Y, 'y =>
BEGIN
TTY.PutString[
LogPrivateDefs.tty, "Do you know what you're doing? (Y or N): "L];
wish ← TTY.GetChar[LogPrivateDefs.tty];
TTY.PutChar[LogPrivateDefs.tty, wish];
TTY.PutCR[LogPrivateDefs.tty];
SELECT wish FROM
'N, 'n => SIGNAL BailOut[];
'Y, 'y => EXIT; -- go on to initialize the world
ENDCASE => LOOP;
END;
ENDCASE => LOOP;
ENDLOOP;
InitializeWorld[];
RegServerDefs.RegMailEnableUpdates[]; -- enable update propagation --
RegAccessDefs.RegAccessMSMailEnabled; -- enable MS internal mail --
[myName, myPassword, myKey] ← LocalNameDefs.ReadRSName[];
END
ELSE
BEGIN
RegServerDefs.RegMailEnableUpdates[]; -- enable update propagation --
RegAccessDefs.RegAccessMSMailEnabled[]; -- enable MS internal mail --
[myName, myPassword, myKey] ← LocalNameDefs.ReadRSName[];
InitializeServer[myName, myKey];
RegServerDefs.RegistrationLocal[]; -- put Reg. into "local" mode
END;
END
ELSE
BEGIN
RegServerDefs.RegMailEnableUpdates[]; -- enable update propagation --
RegAccessDefs.RegAccessMSMailEnabled[]; -- enable MS internal mail --
IF info.t = allDown THEN -- no other servers up --
RegServerDefs.RegistrationLocal[]; -- put Reg into "local" mode --
rsMailLimit ← InitializeFromLocalHeap[]; -- also gets local name --
[myName, myPassword, myKey] ← LocalNameDefs.ReadRSName[];
IF info.t # allDown THEN RegServerDefs.RegistrationLocal[]; -- put Reg into "local" mode --
END;
END;
rsMailLimit: BodyDefs.Timestamp;
RegRestartInit1: PUBLIC PROCEDURE [initHeap: BOOLEAN] = {
rsMailLimit ← BodyDefs.oldestTime; Restart[initHeap]};
RegRestartInit2: PUBLIC PROCEDURE =
BEGIN -- now Compactor has started --
Process.Detach[
FORK ActOnRSMailObjects[[rsMailLimit.time]] --may wait on PolicyDefs-- ];
RegServerDefs.ReadMail[];
RegBTreeDefs.RegPurger[];
RegServerDefs.RegistrationAll[]; -- put Registration into "all" mode --
END;
END.
13-Aug-84 8:28:21 making init query interactive - BLH
13-Aug-84 8:28:43 reworking STOPs and RESTARTs - blh