-- Copyright (C) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.
-- RegMail.mesa, Transport Mechanism Registration Server - Internal Mail.
-- HGM, 15-Sep-85 11:50:42
-- Randy Gobbel, 19-May-81 12:26:40
-- Andrew Birrell, 18-Nov-82 10:33:12
-- Mike Schroeder 8-Feb-83 9:43:22
-- Hankins 14-Aug-84 16:30:13 (Klamath update - remove STOPs)
DIRECTORY
BodyDefs USING [
ItemHeader, ItemLength, ItemType, maxRNameLength, oldestTime, Password, RName,
RNameSize, Timestamp],
EnquiryDefs USING [],
Heap USING [systemZone],
HeapDefs USING [
HeapEndWrite, HeapEndRead, HeapReadData, HeapStartWrite, HeapWriteData,
ObjectNumber, ReaderHandle, WriterHandle],
LocalNameDefs USING [ReadRSName],
LogDefs USING [WriteLogEntry],
ObjectDirDefs USING [FreeObject, noObject],
PolicyDefs USING [CheckOperation, EndOperation, Wait, WaitOperation],
Process USING [Detach, DisableTimeout],
ProtocolDefs USING [AppendTimestamp, ReturnCode, RSOperation],
RegBTreeDefs USING [Lookup, LookupReason, RegistryObject],
RegServerDefs USING [IsMember, ReadRegistryMembers, Update, UpdateSublist],
RegistryDefs USING [EnumerateRList],
RetrieveDefs USING [
AccessProcs, Failed, Handle, Create, MailboxState, NewUser, NextServer,
ServerName, ServerState, WaitForMail],
SendDefs USING [
Abort, AddRecipient, AddToItem, Create, Destroy, Handle, StartItem, StartSend,
Send],
String USING [AppendString, EquivalentString],
VMDefs USING [AllocatePage, Page, pageSize, Release];
RegMail: MONITOR
IMPORTS
BodyDefs, Heap, HeapDefs, LocalNameDefs, LogDefs, ObjectDirDefs, PolicyDefs,
Process, ProtocolDefs, RegBTreeDefs, RegistryDefs, RegServerDefs,
RetrieveDefs, SendDefs, String, VMDefs
EXPORTS EnquiryDefs --LoginRSMail-- , RegServerDefs =
BEGIN
OPEN ProtocolDefs;
-- the update mail is generated in a separate process to allow return to
-- client sooner, and to avoid deadlock if we generate an update while
-- determining our R-Server name.
updateEntry: BodyDefs.RName = [BodyDefs.maxRNameLength];
updateStamp: BodyDefs.Timestamp;
updateElement: BodyDefs.RName = [BodyDefs.maxRNameLength];
updateOp: ProtocolDefs.RSOperation;
updateRSMailObj: HeapDefs.ObjectNumber;
updatePending: BOOLEAN ← FALSE;
updateCond: CONDITION;
updateEnabled: BOOLEAN ← FALSE; -- set TRUE early in restart --
NoRegistryForName: ERROR = CODE;
FailedToSendUpdate: ERROR = CODE;
MailUpdate: PUBLIC ENTRY PROCEDURE [
entry: BodyDefs.RName, stamp: BodyDefs.Timestamp, element: BodyDefs.RName,
op: ProtocolDefs.RSOperation, rsMailObj: HeapDefs.ObjectNumber] =
BEGIN
IF updateEnabled THEN
BEGIN
WHILE updatePending DO WAIT updateCond ENDLOOP;
updateEntry.length ← 0;
String.AppendString[updateEntry, entry];
updateStamp ← stamp;
updateElement.length ← 0;
IF element # NIL THEN String.AppendString[updateElement, element];
updateOp ← op;
updateRSMailObj ← rsMailObj;
updatePending ← TRUE;
NOTIFY updateCond;
END
ELSE
IF rsMailObj # ObjectDirDefs.noObject THEN
ObjectDirDefs.FreeObject[rsMailObj];
END;
SendRSMail: ENTRY PROC =
BEGIN
DO
UNTIL updatePending DO WAIT updateCond ENDLOOP;
SendUpdate[updateEntry, updateStamp, updateElement, updateOp];
IF updateRSMailObj # ObjectDirDefs.noObject THEN
ObjectDirDefs.FreeObject[updateRSMailObj];
updatePending ← FALSE;
NOTIFY updateCond;
ENDLOOP;
END;
briefUpdate: BodyDefs.ItemType = LOOPHOLE[2001B];
briefUpdateAllowed: BOOLEAN ← TRUE;
SendUpdate: INTERNAL PROC [
entry: BodyDefs.RName, stamp: BodyDefs.Timestamp, element: BodyDefs.RName,
op: ProtocolDefs.RSOperation] =
BEGIN
-- mail the object to other registration servers for entry's registry.
regobj: RegBTreeDefs.RegistryObject = RegBTreeDefs.Lookup[entry, readAny];
myName: BodyDefs.RName;
myPassword: LONG STRING;
[myName, myPassword, ] ← LocalNameDefs.ReadRSName[];
IF regobj.type # notFound THEN
BEGIN
message: SendDefs.Handle = SendDefs.Create[];
itsRegReader: HeapDefs.ReaderHandle = LookupRegistry[entry];
IF SendDefs.StartSend[
handle: message, senderPwd: myPassword, sender: myName,
returnTo: "DeadLetter.MS"L, validate: FALSE] # ok THEN
ERROR FailedToSendUpdate[];
IF CopyRList[message, myName, itsRegReader] > 0 THEN
BEGIN
humanHint: LONG STRING = "RS internal mail for R-Name "L;
SELECT op FROM
AddMember, DeleteMember =>
IF briefUpdateAllowed THEN
BriefUpdate[message, entry, stamp, element, op]
ELSE FullUpdate[message, regobj.reader];
ENDCASE => FullUpdate[message, regobj.reader];
HeapDefs.HeapEndRead[regobj.reader];
-- in case it gets to DeadLetter! --
SendDefs.StartItem[message, Text];
SendDefs.AddToItem[
message, DESCRIPTOR[@(humanHint.text), humanHint.length]];
SendDefs.AddToItem[message, DESCRIPTOR[@(entry.text), entry.length]];
SendDefs.Send[message];
END
ELSE
BEGIN --no recipients--
SendDefs.Abort[message];
HeapDefs.HeapEndRead[regobj.reader];
END;
SendDefs.Destroy[message];
END;
END;
LookupRegistry: PROCEDURE [name: BodyDefs.RName]
RETURNS [reader: HeapDefs.ReaderHandle] =
BEGIN
oldTimePtr: BodyDefs.Timestamp ← BodyDefs.oldestTime; --ugh!--
rc: ProtocolDefs.ReturnCode;
[reader, rc] ← RegServerDefs.ReadRegistryMembers[name, @oldTimePtr];
IF rc.code # done THEN ERROR NoRegistryForName[];
END;
CopyRList: PROCEDURE [
message: SendDefs.Handle, me: BodyDefs.RName, reader: HeapDefs.ReaderHandle]
RETURNS [recipients: CARDINAL] =
BEGIN
Work: PROC [name: BodyDefs.RName] RETURNS [done: BOOLEAN] =
BEGIN
done ← FALSE;
IF NOT String.EquivalentString[me, name] THEN
BEGIN
SendDefs.AddRecipient[message, name];
recipients ← recipients + 1;
END;
END;
recipients ← 0;
RegistryDefs.EnumerateRList[reader, Work];
HeapDefs.HeapEndRead[reader];
END;
FullUpdate: PROCEDURE [
message: SendDefs.Handle, reader: HeapDefs.ReaderHandle] =
BEGIN
buffer: VMDefs.Page = VMDefs.AllocatePage[];
BEGIN
ENABLE UNWIND => VMDefs.Release[buffer];
ended: BOOLEAN;
used: CARDINAL;
SendDefs.StartItem[message, updateItem];
DO
[ended, used] ← HeapDefs.HeapReadData[reader, [buffer, VMDefs.pageSize]];
SendDefs.AddToItem[
message, DESCRIPTOR[LOOPHOLE[buffer, LONG POINTER], 2 * used]];
IF ended THEN EXIT;
-- why isn't the error SendDefs.SendFailed recognized in this module?
ENDLOOP;
END;
VMDefs.Release[buffer];
END;
BriefUpdate: PROCEDURE [
message: SendDefs.Handle, entry: BodyDefs.RName, stamp: BodyDefs.Timestamp,
element: BodyDefs.RName, op: ProtocolDefs.RSOperation] =
BEGIN
SendDefs.StartItem[message, briefUpdate];
SendDefs.AddToItem[
message, DESCRIPTOR[
LOOPHOLE[LONG[@op], LONG POINTER], 2 * SIZE[ProtocolDefs.RSOperation]]];
SendDefs.AddToItem[
message, DESCRIPTOR[
LOOPHOLE[entry, LONG POINTER], 2 * BodyDefs.RNameSize[entry]]];
SendDefs.AddToItem[
message, DESCRIPTOR[
LOOPHOLE[element, LONG POINTER], 2 * BodyDefs.RNameSize[element]]];
SendDefs.AddToItem[
message, DESCRIPTOR[
LOOPHOLE[LONG[@stamp], LONG POINTER], 2 * SIZE[BodyDefs.Timestamp]]];
END;
-- RS Mail reading --
handle: RetrieveDefs.Handle = RetrieveDefs.Create[pollingInterval: 30];
readerActive: BOOLEAN ← FALSE;
readerInactive: CONDITION ← [timeout: 0];
LoginRSMail: PUBLIC ENTRY PROC =
BEGIN
myName: BodyDefs.RName;
myPassword: LONG STRING;
WHILE readerActive DO WAIT readerInactive ENDLOOP;
[myName, myPassword, ] ← LocalNameDefs.ReadRSName[];
RetrieveDefs.NewUser[handle: handle, user: myName, password: myPassword];
DO
sName: BodyDefs.RName = [BodyDefs.maxRNameLength];
noMore: BOOLEAN;
[noMore, , ] ← RetrieveDefs.NextServer[handle];
IF noMore THEN EXIT;
LogInboxSite["RS inbox-site: "L];
ENDLOOP;
END;
LogInboxSite: INTERNAL PROC [s: LONG STRING] =
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
server: STRING = [64];
RetrieveDefs.ServerName[handle, server];
String.AppendString[log, s];
server.length ← MIN[server.length, log.maxlength - log.length];
String.AppendString[log, server];
LogDefs.WriteLogEntry[log];
Heap.systemZone.FREE[@log];
END;
LockReader: ENTRY PROC = INLINE {readerActive ← TRUE};
UnlockReader: ENTRY PROC = INLINE {readerActive ← FALSE; NOTIFY readerInactive};
MyNameIsBad: ERROR = CODE;
MyPwdIsBad: ERROR = CODE;
ReadMail: PUBLIC PROCEDURE =
BEGIN
-- Reads outstanding mail before returning --
LoginRSMail[];
SELECT RetrieveDefs.MailboxState[handle] FROM
badName => ERROR MyNameIsBad[];
badPwd => ERROR MyPwdIsBad[];
notEmpty =>
IF PolicyDefs.CheckOperation[RSReadMail] THEN {
RegMailReader[]; PolicyDefs.EndOperation[RSReadMail]};
ENDCASE => NULL;
Process.Detach[FORK RegMailWatcher[]];
END;
RegMailWatcher: PROC =
BEGIN
DO
RetrieveDefs.WaitForMail[handle];
PolicyDefs.WaitOperation[RSReadMail];
RegMailReader[];
PolicyDefs.EndOperation[RSReadMail];
PolicyDefs.Wait[mins: 3];
ENDLOOP;
END;
RegMailReader: PROC =
BEGIN
LockReader[];
DO
noMore: BOOLEAN;
state: RetrieveDefs.ServerState;
gv: RetrieveDefs.AccessProcs;
[noMore, state, gv] ← RetrieveDefs.NextServer[handle];
IF noMore THEN EXIT;
IF state # notEmpty THEN LOOP;
BEGIN
ENABLE RetrieveDefs.Failed => CONTINUE;
pleaseFlush: BOOLEAN ← TRUE;
DO
sender: BodyDefs.RName = [BodyDefs.maxRNameLength];
time: BodyDefs.Timestamp;
msgExists, archived, deleted: BOOLEAN;
pleaseDelete: BOOLEAN ← TRUE;
[msgExists, archived, deleted] ← gv.nextMessage[handle];
IF deleted THEN LOOP;
IF NOT msgExists THEN EXIT;
gv.startMessage[handle: handle, sender: sender, postmark: @time];
IF CheckAndLog[sender, time] THEN
DO
header: BodyDefs.ItemHeader = gv.nextItem[handle];
SELECT header.type FROM
LastItem => EXIT;
updateItem => {AcceptUpdate[handle, @gv]; EXIT};
briefUpdate =>
BEGIN
IF NOT AcceptBriefUpdate[handle, header.length, @gv]
-- keep only names in a local registry which weren't found
THEN pleaseDelete ← FALSE;
EXIT
END;
ENDCASE => NULL;
ENDLOOP --each item-- ;
IF pleaseDelete THEN gv.deleteMessage[handle] ELSE pleaseFlush ← FALSE;
ENDLOOP --each message-- ;
IF pleaseFlush THEN gv.accept[handle];
END;
ENDLOOP --each server-- ;
UnlockReader[];
END;
CheckAndLog: PROC [sender: BodyDefs.RName, time: BodyDefs.Timestamp]
RETURNS [good: BOOLEAN] =
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
good ← TRUE;
String.AppendString[log, "RS reading "L];
ProtocolDefs.AppendTimestamp[log, time];
String.AppendString[log, " from "L];
String.AppendString[log, sender];
IF RegServerDefs.IsMember["*.gv"L, sender, direct].membership # yes THEN {
String.AppendString[log, ": bad sender"L]; good ← FALSE};
LogDefs.WriteLogEntry[log];
Heap.systemZone.FREE[@log];
END;
GetMsgItem: PROCEDURE [
handle: RetrieveDefs.Handle, gv: POINTER TO RetrieveDefs.AccessProcs]
RETURNS [writer: HeapDefs.WriterHandle] =
BEGIN
buffer: VMDefs.Page = VMDefs.AllocatePage[];
BEGIN
ENABLE UNWIND => VMDefs.Release[buffer];
length: CARDINAL;
writer ← HeapDefs.HeapStartWrite[temp];
WHILE (length ← gv.nextBlock[handle, DESCRIPTOR[buffer, 2 * VMDefs.pageSize]])
> 0 DO HeapDefs.HeapWriteData[writer, [buffer, (1 + length) / 2]]; ENDLOOP;
END;
VMDefs.Release[buffer];
END;
MangledMessage: ERROR = CODE;
AcceptUpdate: PROCEDURE [
handle: RetrieveDefs.Handle, gv: POINTER TO RetrieveDefs.AccessProcs] =
BEGIN
updateWriter: HeapDefs.WriterHandle = GetMsgItem[handle, gv];
AcceptRestOfMessage[handle, gv];
HeapDefs.HeapEndWrite[updateWriter, RegServerDefs.Update];
END; --AcceptUpdate--
AcceptBriefUpdate: PROCEDURE [
handle: RetrieveDefs.Handle, itemLength: BodyDefs.ItemLength,
gv: POINTER TO RetrieveDefs.AccessProcs] RETURNS [ok: BOOLEAN] =
BEGIN
strHeader: CARDINAL = 2 * SIZE[StringBody [0]];
op: ProtocolDefs.RSOperation;
entry: BodyDefs.RName = [BodyDefs.maxRNameLength];
element: BodyDefs.RName = [BodyDefs.maxRNameLength];
stamp: BodyDefs.Timestamp;
rc: ProtocolDefs.ReturnCode;
regLocal: BOOLEAN;
length: CARDINAL;
length ← gv.nextBlock[
handle, DESCRIPTOR[
LOOPHOLE[LONG[@op], LONG POINTER], 2 * SIZE[ProtocolDefs.RSOperation]]];
itemLength ← itemLength - length;
length ← gv.nextBlock[
handle, DESCRIPTOR[LOOPHOLE[entry, LONG POINTER], strHeader]];
itemLength ← itemLength - length;
length ← gv.nextBlock[
handle, DESCRIPTOR[
LOOPHOLE[@entry.text, LONG POINTER], 2 * BodyDefs.RNameSize[entry] - strHeader]];
itemLength ← itemLength - length;
length ← gv.nextBlock[
handle, DESCRIPTOR[LOOPHOLE[element, LONG POINTER], strHeader]];
itemLength ← itemLength - length;
length ← gv.nextBlock[
handle, DESCRIPTOR[
LOOPHOLE[@element.text, LONG POINTER], 2 * BodyDefs.RNameSize[element] - strHeader]];
itemLength ← itemLength - length;
length ← gv.nextBlock[
handle, DESCRIPTOR[
LOOPHOLE[LONG[@stamp], LONG POINTER], 2 * SIZE[BodyDefs.Timestamp]]];
itemLength ← itemLength - length;
IF itemLength # 0 OR length # 2 * SIZE[BodyDefs.Timestamp] THEN
ERROR MangledMessage[];
AcceptRestOfMessage[handle, gv];
[rc, regLocal] ← RegServerDefs.UpdateSublist[entry, element, op, stamp];
RETURN[rc.type # notFound AND regLocal]
END;
AcceptRestOfMessage: PROCEDURE [
handle: RetrieveDefs.Handle, gv: POINTER TO RetrieveDefs.AccessProcs] =
BEGIN
DO
header: BodyDefs.ItemHeader = gv.nextItem[handle];
SELECT header.type FROM LastItem => EXIT; ENDCASE => NULL;
ENDLOOP;
END; --AcceptRestOfMessage--
RegMailInit: PUBLIC PROCEDURE = {
Process.DisableTimeout[@updateCond]; Process.Detach[FORK SendRSMail[]]};
RegMailEnableUpdates: PUBLIC ENTRY PROCEDURE = {updateEnabled ← TRUE};
END.