-- Copyright (C) 1981, 1982, 1983, 1984 by Xerox Corporation. All rights reserved.
-- Registration.mesa, Registration Server: Implementation of protocols talking to a Registry
-- HGM, 18-Nov-84 0:22:29
-- Randy Gobbel, 19-May-81 12:21:02
-- Jeremy Dion, September 1979
-- Andrew Birrell, 4-Jan-82 13:36:12
-- Mike Schroeder, 25-Jan-83 13:38:54
-- Hankins 13-Aug-84 8:14:53 Klamath update (PupDefs/Buffer)
DIRECTORY
AclDefs USING [CanOperate],
BodyDefs USING [maxRNameLength, oldestTime, RName, RNameSize, Timestamp],
Buffer USING [ReturnBuffer],
HeapDefs USING [
CopyReader, GetReaderOffset, HeapAbandonWrite, HeapEndRead, HeapReadData,
HeapReadRName, ObjectOffset, ReaderHandle, SendComponent, SetReaderOffset,
WriterHandle],
LogDefs,
NameInfoDefs USING [AuthenticateInfo, AuthenticateKey],
PolicyDefs USING [CheckOperation, EndOperation],
Process USING [Detach],
ProtocolDefs,
PupDefs USING [
GetPupContentsBytes, PupAddress, PupBuffer, PupSocket, PupSocketMake,
ReturnPup, veryLongWait],
PupStream USING [
CreatePupByteStreamListener, RejectThisRequest, SecondsToTocks],
RegistryDefs USING [
AddNameToSublist, CompareRNames, CompareTimestamps, EndSublist, Skip,
StartSublist],
RegServerDefs,
String USING [AppendChar, AppendNumber, AppendString, EquivalentStrings];
Registration: MONITOR
IMPORTS
AclDefs, BodyDefs, Buffer, HeapDefs, LogDefs, NameInfoDefs, PolicyDefs,
Process, ProtocolDefs, PupDefs, PupStream, RegistryDefs, RegServerDefs, String
EXPORTS RegServerDefs =
BEGIN
LogAction: PROCEDURE [
op: ProtocolDefs.RSOperation, from: PupDefs.PupAddress,
name, entry: BodyDefs.RName, rc: ProtocolDefs.ReturnCode] =
BEGIN OPEN ProtocolDefs, String;
log: STRING = [192];
AppendString[log, "RS op by "L];
AppendNumber[log, from.net, 8];
AppendChar[log, '#];
AppendNumber[log, from.host, 8];
AppendString[log, ", R-Name "];
AppendString[log, name];
AppendString[log, ": "L];
AppendString[
log,
SELECT op FROM
Expand => "Expand"L,
ReadMembers => "Read Members"L,
ReadOwners => "Read Owners"L,
ReadFriends => "Read Friends"L,
ReadEntry => "Read Entry"L,
CheckStamp => "Check Stamp"L,
ReadConnect => "Read Connect-site"L,
ReadRemark => "Read Remark"L,
Authenticate => "Authenticate"L,
CreateRegistry => "Create Registry"L,
DeleteRegistry => "Delete Registry"L,
CreateIndividual => "Create Individual"L,
DeleteIndividual => "Delete Individual"L,
CreateGroup => "Create Group"L,
DeleteGroup => "Delete Group"L,
ChangePassword => "Change Password"L,
ChangeConnect => "Change Connect-site to "L,
ChangeRemark => "Change Remark to "L,
AddMember => "Add Member "L,
AddMailBox => "Add Mailbox "L,
AddForward => "Add Forward "L,
AddOwner => "Add Owner "L,
AddFriend => "Add Friend "L,
DeleteMember => "Remove Member "L,
DeleteMailBox => "Remove Mailbox "L,
DeleteForward => "Remove Forward "L,
DeleteOwner => "Remove Owner "L,
DeleteFriend => "Remove Friend "L,
AddSelf => "Add Self"L,
DeleteSelf => "Remove Self"L,
AddListOfMembers => "Add List Of Members"L,
NewName => "New Name"L,
IdentifyCaller => "Identify Caller"L,
IsMemberDirect => "Is Member Direct"L,
IsOwnerDirect => "Is Owner Direct"L,
IsFriendDirect => "Is Friend Direct"L,
IsMemberClosure => "Is Member Closure"L,
IsOwnerClosure => "Is Owner Closure"L,
IsFriendClosure => "Is Friend Closure"L,
IsInList => "Is In List"L,
ENDCASE => "??Unknown op??"L];
IF op IN [ChangeConnect..DeleteFriend] OR op = NewName
OR op IN [IsMemberDirect..IsInList] THEN AppendString[log, entry];
IF rc.code # done THEN
AppendString[
log,
SELECT rc.code FROM
noChange => ": no change"L,
outOfDate => ": out of date"L,
NotAllowed => ": not allowed"L,
BadOperation => ": bad operation"L,
BadPassword => ": bad password"L,
BadProtocol => ": bad protocol"L,
BadRName => ": bad R-Name"L,
WrongServer => ": wrong server"L,
ENDCASE => ": *** bad return code ***"L];
LogDefs.WriteLogEntry[log];
END;
SendDummyPwd: PROC [
reader: HeapDefs.ReaderHandle, str: ProtocolDefs.Handle,
callerKey: ProtocolDefs.Password] =
BEGIN
length: CARDINAL;
stamp: BodyDefs.Timestamp;
pwd: ProtocolDefs.Password;
[] ← HeapDefs.HeapReadData[reader, [@length, SIZE[CARDINAL]]];
IF length # SIZE[BodyDefs.Timestamp] + SIZE[ProtocolDefs.Password] THEN ERROR;
ProtocolDefs.SendCount[str, length];
[] ← HeapDefs.HeapReadData[reader, [@stamp, SIZE[BodyDefs.Timestamp]]];
ProtocolDefs.SendTimestamp[str, stamp];
[] ← HeapDefs.HeapReadData[reader, [@pwd, SIZE[ProtocolDefs.Password]]];
pwd ← ALL[0];
ProtocolDefs.SendPassword[str, callerKey, pwd];
END;
-- These should be in ProtocolDefs --
MembershipGrade: TYPE = RegServerDefs.MembershipGrade; --self,registry--
MembershipAcl: TYPE = RegServerDefs.MembershipAcl; --member,owner,friend--
MembershipLevel: TYPE = RegServerDefs.MembershipLevel; --direct,closure,upA--
ReceiveMembershipGrade: PROC [str: ProtocolDefs.Handle]
RETURNS [MembershipGrade] = INLINE
BEGIN
b: ProtocolDefs.Byte = ProtocolDefs.ReceiveByte[str];
IF b NOT IN
[LOOPHOLE[FIRST[MembershipGrade], ProtocolDefs.Byte]..LOOPHOLE[LAST[
MembershipGrade], ProtocolDefs.Byte]] THEN
ERROR ProtocolDefs.Failed[protocolError]
ELSE RETURN[LOOPHOLE[b]]
END;
ReceiveMembershipAcl: PROC [str: ProtocolDefs.Handle] RETURNS [MembershipAcl] =
INLINE
BEGIN
b: ProtocolDefs.Byte = ProtocolDefs.ReceiveByte[str];
IF b NOT IN
[LOOPHOLE[FIRST[MembershipAcl], ProtocolDefs.Byte]..LOOPHOLE[LAST[
MembershipAcl], ProtocolDefs.Byte]] THEN
ERROR ProtocolDefs.Failed[protocolError]
ELSE RETURN[LOOPHOLE[b]]
END;
ReceiveMembershipLevel: PROC [str: ProtocolDefs.Handle]
RETURNS [MembershipLevel] = INLINE
BEGIN
b: ProtocolDefs.Byte = ProtocolDefs.ReceiveByte[str];
IF b NOT IN
[LOOPHOLE[FIRST[MembershipLevel], ProtocolDefs.Byte]..LOOPHOLE[LAST[
MembershipLevel], ProtocolDefs.Byte]] THEN
ERROR ProtocolDefs.Failed[protocolError]
ELSE RETURN[LOOPHOLE[b]]
END;
ReadTimestamp: PROC [from: HeapDefs.ReaderHandle]
RETURNS [stamp: BodyDefs.Timestamp] = INLINE {
[] ← HeapDefs.HeapReadData[from, [@stamp, SIZE[BodyDefs.Timestamp]]]};
MailSiteSortFailed: ERROR = CODE;
SendMailboxes: PROC [reader: HeapDefs.ReaderHandle, str: ProtocolDefs.Handle] =
BEGIN
-- reader is positioned at start of mailbox site component
-- reader is left positioned at end of mailbox site component
candidate: BodyDefs.RName = [BodyDefs.maxRNameLength];
prevStamp: BodyDefs.Timestamp ← BodyDefs.oldestTime;
candStamp: BodyDefs.Timestamp ← BodyDefs.oldestTime;
stamps: HeapDefs.ReaderHandle = HeapDefs.CopyReader[reader];
nameStart: HeapDefs.ObjectOffset;
nameLength: CARDINAL;
stampStart: HeapDefs.ObjectOffset;
stampLength: CARDINAL;
sentLength: CARDINAL ← 0;
[] ← HeapDefs.HeapReadData[reader, [@nameLength, SIZE[CARDINAL]]];
ProtocolDefs.SendCount[str, nameLength];
nameStart ← HeapDefs.GetReaderOffset[reader];
RegistryDefs.Skip[stamps];
[] ← HeapDefs.HeapReadData[stamps, [@stampLength, SIZE[CARDINAL]]];
stampStart ← HeapDefs.GetReaderOffset[stamps];
DO
ENABLE UNWIND => HeapDefs.HeapEndRead[stamps];
namePos: CARDINAL ← nameLength;
-- skip until we have a candidate --
WHILE namePos > 0 DO
[] ← HeapDefs.HeapReadRName[reader, candidate];
namePos ← namePos - BodyDefs.RNameSize[candidate];
candStamp ← ReadTimestamp[stamps];
IF RegistryDefs.CompareTimestamps[prevStamp, candStamp] = less THEN EXIT;
REPEAT
FINISHED =>
IF sentLength = nameLength THEN EXIT -- from outer loop --
ELSE ERROR MailSiteSortFailed[]
ENDLOOP;
-- look for better candidates --
WHILE namePos > 0 DO
other: BodyDefs.RName = [BodyDefs.maxRNameLength];
otherStamp: BodyDefs.Timestamp = ReadTimestamp[stamps];
[] ← HeapDefs.HeapReadRName[reader, other];
namePos ← namePos - BodyDefs.RNameSize[other];
IF RegistryDefs.CompareTimestamps[prevStamp, otherStamp] = less
AND RegistryDefs.CompareTimestamps[otherStamp, candStamp] = less THEN
BEGIN
-- "other" is a better candidate --
candidate.length ← 0;
String.AppendString[candidate, other];
candStamp ← otherStamp;
END;
ENDLOOP;
-- now "candidate" is oldest name newer than prevStamp --
sentLength ← sentLength + BodyDefs.RNameSize[candidate];
IF sentLength > nameLength THEN ERROR MailSiteSortFailed[];
ProtocolDefs.SendRName[str, candidate];
IF sentLength = nameLength THEN EXIT;
prevStamp ← candStamp;
HeapDefs.SetReaderOffset[reader, nameStart];
HeapDefs.SetReaderOffset[stamps, stampStart];
ENDLOOP;
HeapDefs.HeapEndRead[stamps];
END;
Operate: PROCEDURE [
str: ProtocolDefs.Handle, from: PupDefs.PupAddress, type: {enquiry, update},
caller: BodyDefs.RName] =
BEGIN
wizard: BOOLEAN ← FALSE;
DO
BEGIN
callerKey: ProtocolDefs.Password ← [0, 0, 0, 0];
op: ProtocolDefs.RSOperation;
name: BodyDefs.RName = [BodyDefs.maxRNameLength];
entry: STRING = [
MAX[BodyDefs.maxRNameLength, ProtocolDefs.maxConnectLength]];
password: ProtocolDefs.Password;
stamp: BodyDefs.Timestamp;
rc: ProtocolDefs.ReturnCode;
membership: RegServerDefs.Membership;
reader: HeapDefs.ReaderHandle ← NIL;
nameCount: CARDINAL ← 0;
components: CARDINAL;
pwdPos: CARDINAL;
writer: HeapDefs.WriterHandle ← NIL;
membersOutOfOrder: BOOLEAN ← FALSE; -- failure in AddListOfMembers --
DO
op ← ProtocolDefs.ReceiveRSOperation[
str !
ProtocolDefs.Failed =>
IF why = noData AND ProtocolDefs.IsLocal[from] THEN RETRY];
IF op # NoOp THEN EXIT;
ENDLOOP;
ProtocolDefs.ReceiveRName[str, name];
entry.length ← 0;
SELECT op FROM
IN [Expand..CheckStamp] => stamp ← ProtocolDefs.ReceiveTimestamp[str];
IN [AddMember..DeleteFriend], NewName, IN [IsMemberDirect..IsInList] =>
ProtocolDefs.ReceiveRName[str, entry];
CreateIndividual, ChangePassword, Authenticate, IdentifyCaller =>
password ← ProtocolDefs.ReceivePassword[str, callerKey];
ChangeConnect => ProtocolDefs.ReceiveConnect[str, entry]; --PUN--
ChangeRemark => ProtocolDefs.ReceiveRemark[str, entry]; --PUN--
AddListOfMembers =>
BEGIN
Work: PROC [member: BodyDefs.RName] =
BEGIN
IF RegistryDefs.CompareRNames[entry, member] # less THEN
membersOutOfOrder ← TRUE;
entry.length ← 0;
String.AppendString[entry, member];
RegistryDefs.AddNameToSublist[writer, member];
nameCount ← nameCount + 1;
END;
writer ← RegistryDefs.StartSublist[];
ProtocolDefs.ReceiveRList[
str, Work ! UNWIND => HeapDefs.HeapAbandonWrite[writer]];
reader ← RegistryDefs.EndSublist[writer, nameCount];
writer ← NIL;
END;
ENDCASE;
IF NOT wizard
AND
(( -- not allowable as implicit AddSelf or RemoveSelf --
(op # AddMember AND op # DeleteMember) -- implicit AddSelf or RemoveSelf --
OR NOT String.EquivalentStrings[caller, entry]
OR AclDefs.CanOperate[
op: IF op = AddMember THEN AddSelf ELSE DeleteSelf, entry: name,
caller: caller] # yes)
AND AclDefs.CanOperate[op: op, entry: name, caller: caller] # yes)
THEN
BEGIN
IF reader # NIL THEN HeapDefs.HeapEndRead[reader];
reader ← NIL;
rc ← [NotAllowed, notFound];
END
ELSE
SELECT op FROM
Expand => [reader, rc] ← RegServerDefs.Expand[name, @stamp];
ReadMembers => [reader, rc] ← RegServerDefs.ReadMembers[name, @stamp];
ReadOwners => [reader, rc] ← RegServerDefs.ReadOwners[name, @stamp];
ReadFriends => [reader, rc] ← RegServerDefs.ReadFriends[name, @stamp];
ReadEntry =>
[reader, rc, components, pwdPos] ← RegServerDefs.Read[name];
CheckStamp => [rc] ← RegServerDefs.CheckRName[name, @stamp];
ReadConnect => [rc] ← RegServerDefs.ReadConnect[name, entry];
ReadRemark => [rc] ← RegServerDefs.ReadRemark[name, entry];
Authenticate, IdentifyCaller =>
BEGIN
actual: ProtocolDefs.Password;
[actual, rc] ← RegServerDefs.ReadPassword[name];
SELECT TRUE FROM
rc.code = done =>
IF actual # password OR actual = [0, 0, 0, 0] THEN
rc.code ← BadPassword;
rc.code = WrongServer AND op = IdentifyCaller =>
BEGIN
-- doing this for op=Authenticate would provoke a
-- deadlock, as we might be the first place tried by
-- our NameInfo package.
info: NameInfoDefs.AuthenticateInfo =
NameInfoDefs.AuthenticateKey[name, password];
SELECT info FROM
group => rc ← [BadRName, group];
individual => rc ← [done, individual];
notFound => rc ← [BadRName, notFound];
allDown => rc ← [AllDown, notFound];
badPwd => rc ← [BadPassword, individual];
ENDCASE => ERROR;
END;
ENDCASE => NULL;
IF op = IdentifyCaller AND rc.code = done THEN
BEGIN
caller.length ← 0;
String.AppendString[caller, name];
callerKey ← actual;
type ← update;
END;
END;
CreateIndividual =>
[rc] ← RegServerDefs.CreateIndividual[name, password];
DeleteIndividual => [rc] ← RegServerDefs.DeleteIndividual[name];
CreateGroup => [rc] ← RegServerDefs.CreateGroup[name, caller];
DeleteGroup => [rc] ← RegServerDefs.DeleteGroup[name];
ChangePassword => [rc] ← RegServerDefs.ChangePassword[name, password];
ChangeConnect => [rc] ← RegServerDefs.ChangeConnect[name, entry];
ChangeRemark => [rc] ← RegServerDefs.ChangeRemark[name, entry];
AddMember => [rc] ← RegServerDefs.AddMember[name, entry];
AddMailBox => [rc] ← RegServerDefs.AddMailbox[name, entry];
AddForward => [rc] ← RegServerDefs.AddForward[name, entry];
AddOwner => [rc] ← RegServerDefs.AddOwner[name, entry];
AddFriend => [rc] ← RegServerDefs.AddFriend[name, entry];
AddSelf => [rc] ← RegServerDefs.AddMember[name, caller];
DeleteMember => [rc] ← RegServerDefs.DeleteMember[name, entry];
DeleteMailBox => [rc] ← RegServerDefs.DeleteMailbox[name, entry];
DeleteForward => [rc] ← RegServerDefs.DeleteForward[name, entry];
DeleteOwner => [rc] ← RegServerDefs.DeleteOwner[name, entry];
DeleteFriend => [rc] ← RegServerDefs.DeleteFriend[name, entry];
DeleteSelf => [rc] ← RegServerDefs.DeleteMember[name, caller];
AddListOfMembers =>
BEGIN
IF membersOutOfOrder THEN
BEGIN HeapDefs.HeapEndRead[reader]; rc ← [BadProtocol, group] END
ELSE rc ← RegServerDefs.AddListOfMembers[name, reader];
reader ← NIL;
END;
NewName => rc ← RegServerDefs.NewName[old: entry, new: name];
IsMemberDirect =>
[membership, rc] ← RegServerDefs.IsMember[name, entry, direct];
IsOwnerDirect =>
[membership, rc] ← RegServerDefs.IsOwner[name, entry, direct];
IsFriendDirect =>
[membership, rc] ← RegServerDefs.IsFriend[name, entry, direct];
IsMemberClosure =>
[membership, rc] ← RegServerDefs.IsMember[name, entry, closure];
IsOwnerClosure =>
[membership, rc] ← RegServerDefs.IsOwner[name, entry, closure];
IsFriendClosure =>
[membership, rc] ← RegServerDefs.IsFriend[name, entry, closure];
IsInList =>
BEGIN
grade: MembershipGrade = ReceiveMembershipGrade[str];
acl: MembershipAcl = ReceiveMembershipAcl[str];
level: MembershipLevel = ReceiveMembershipLevel[str];
[membership, rc] ← RegServerDefs.IsInList[
name, entry, level, grade, acl];
END;
ENDCASE => rc ← [BadOperation, notFound];
ProtocolDefs.SendRC[str, rc];
IF rc.code = done THEN
SELECT op FROM
IN [Expand..ReadFriends] =>
BEGIN
ENABLE UNWIND => HeapDefs.HeapEndRead[reader];
ProtocolDefs.SendTimestamp[str, stamp];
IF rc.type = individual THEN SendMailboxes[reader, str]
ELSE HeapDefs.SendComponent[reader, str];
HeapDefs.HeapEndRead[reader];
END;
ReadEntry =>
BEGIN
ENABLE UNWIND => HeapDefs.HeapEndRead[reader];
ProtocolDefs.SendTimestamp[str, BodyDefs.oldestTime];
ProtocolDefs.SendCount[str, components];
IF rc.type = individual THEN
BEGIN
callerIsRServer: BOOLEAN = (type = update)
AND
(RegServerDefs.IsMember["*.gv"L, caller, direct].membership =
yes);
HeapDefs.SendComponent[reader, str]; --prefix--
IF callerIsRServer THEN HeapDefs.SendComponent[reader, str]
ELSE SendDummyPwd[reader, str, callerKey];
HeapDefs.SendComponent[reader, str]; --connect--
THROUGH [1..4] DO
HeapDefs.SendComponent[reader, str]; --forward--
ENDLOOP;
IF callerIsRServer THEN HeapDefs.SendComponent[reader, str]
ELSE SendMailboxes[reader, str];
THROUGH [2..4] DO
HeapDefs.SendComponent[reader, str]; --mailboxes--
ENDLOOP;
END
ELSE -- group, dead --
FOR component: CARDINAL IN [0..components) DO
HeapDefs.SendComponent[reader, str]; ENDLOOP;
HeapDefs.HeapEndRead[reader];
END;
CheckStamp => ProtocolDefs.SendTimestamp[str, stamp];
ReadConnect => ProtocolDefs.SendConnect[str, entry];
ReadRemark => ProtocolDefs.SendRemark[str, entry];
IN [IsMemberDirect..IsInList] =>
ProtocolDefs.SendBoolean[str, membership = yes];
ENDCASE;
IF op NOT IN [Expand..Authenticate] AND op NOT IN [IsMemberDirect..IsInList]
THEN LogAction[op, from, name, entry, rc];
END;
ProtocolDefs.SendNow[str];
ENDLOOP;
END;
Enquiries: PROCEDURE [str: ProtocolDefs.Handle, from: PupDefs.PupAddress] =
BEGIN
ENABLE ProtocolDefs.Failed => GOTO abort;
caller: BodyDefs.RName = [BodyDefs.maxRNameLength];
Operate[str: str, from: from, type: enquiry, caller: caller];
ERROR;
EXITS
abort =>
BEGIN
ProtocolDefs.DestroyStream[str];
IF NOT ProtocolDefs.IsLocal[from] THEN PolicyDefs.EndOperation[regExpand];
END;
END;
PollListener: PROCEDURE [socket: PupDefs.PupSocket] =
BEGIN
DO
b: PupDefs.PupBuffer = socket.get[];
IF b # NIL THEN ConsiderPoll[b];
ENDLOOP;
END;
ConsiderPoll: ENTRY PROC [b: PupDefs.PupBuffer] = INLINE
BEGIN
IF b.pup.pupType = echoMe
AND (mode = all OR (mode = local AND ProtocolDefs.IsLocal[b.pup.source]))
THEN PupDefs.ReturnPup[b, iAmEcho, PupDefs.GetPupContentsBytes[b]]
ELSE Buffer.ReturnBuffer[b];
END;
mode: {none, local, all} ← none;
EnquiryFilter: ENTRY PROC [from: PupDefs.PupAddress] =
BEGIN
ENABLE UNWIND => NULL;
localClient: BOOLEAN = ProtocolDefs.IsLocal[from];
IF mode = none OR (mode = local AND NOT localClient) THEN
ERROR PupStream.RejectThisRequest["Server restarting"L]
ELSE
IF NOT localClient AND NOT PolicyDefs.CheckOperation[regExpand] THEN
BEGIN -- Host names would be nice, but I don't want to think about buffer lockups
s: STRING = [100];
String.AppendString[s, "Rejected RS-enquiry connection from "L];
String.AppendNumber[s, from.net, 8];
String.AppendString[s, "#"L];
String.AppendNumber[s, from.host, 8];
String.AppendString[s, "#"L];
LogDefs.ShowLine[s];
ERROR PupStream.RejectThisRequest["Server full"L]
END;
END;
RegistrationInit: PUBLIC PROCEDURE =
BEGIN
Process.Detach[
FORK PollListener[
PupDefs.PupSocketMake[
local: ProtocolDefs.RegServerPollingSocket, remote:,
ticks: PupDefs.veryLongWait]]];
[] ← PupStream.CreatePupByteStreamListener[
ProtocolDefs.RegServerEnquirySocket, Enquiries, PupStream.SecondsToTocks[
60], EnquiryFilter];
END;
RegistrationLocal: PUBLIC ENTRY PROCEDURE = {mode ← local};
RegistrationAll: PUBLIC ENTRY PROCEDURE = {mode ← all};
END.
13-Aug-84 8:13:19: rework to remove STOPs - blh