-- Copyright (C) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved. -- Registration.mesa, Registration Server: Implementation of protocols talking to a Registry -- HGM, 19-Mar-86 21:04:14 -- 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], Heap USING [systemZone], HeapDefs USING [ CopyReader, GetReaderOffset, HeapAbandonWrite, HeapEndRead, HeapReadData, HeapReadRName, ObjectOffset, ReaderHandle, SendComponent, SetReaderOffset, WriterHandle], LogDefs USING [ShowRejection, WriteLogEntry], 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, Heap, 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: LONG STRING ¬ Heap.systemZone.NEW[StringBody[300]]; 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 from "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]; Heap.systemZone.FREE[@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 LogDefs.ShowRejection["RS-enquiry", from]; -- No L 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