-- Registration Server: Implementation of protocols talking to a Registry
-- [Juniper]<Grapevine>MS>Registration.mesa
-- 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
DIRECTORY
AclDefs USING[ CanOperate ],
BodyDefs USING [maxRNameLength, oldestTime,
RName, RNameSize, Timestamp],
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, ReturnFreePupBuffer,
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, HeapDefs, LogDefs, NameInfoDefs, PolicyDefs,
Process, ProtocolDefs, PupDefs, PupStream, RegistryDefs,
RegServerDefs, String
EXPORTS RegServerDefs --PROGRAM-- =
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.pupType = echoMe
AND( mode = all
OR ( mode = local AND ProtocolDefs.IsLocal[b.source] ) )
THEN PupDefs.ReturnPup[b, iAmEcho, PupDefs.GetPupContentsBytes[b] ]
ELSE PupDefs.ReturnFreePupBuffer[b];
END;
mode: {none, local, all} ← none;
SetLocal: ENTRY PROC = INLINE { mode ← local };
SetAll: ENTRY PROC = INLINE { mode ← all };
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
LogDefs.WriteLogEntry["Rejected RS-enquiry connection"L];
ERROR PupStream.RejectThisRequest["Server full"L]
END;
END;
Process.Detach[FORK PollListener[PupDefs.PupSocketMake[
local: ProtocolDefs.RegServerPollingSocket,
remote:, ticks: PupDefs.veryLongWait ] ] ];
[] ← PupStream.CreatePupByteStreamListener[
ProtocolDefs.RegServerEnquirySocket, Enquiries,
PupStream.SecondsToTocks[60], EnquiryFilter ];
STOP;
SetLocal[];
STOP;
SetAll[];
END.