// GrapevineNameInfo.bcpl
// Copyright Xerox Corporation 1981
// Last modified January 4, 1982  12:52 PM by Taft

get "Grapevine.decl"
get "GrapevineProtocol.decl"
get "GrapevineInternal.decl"

external
[
// outgoing procedures
IsMemberClosure; IsInACL; ReadRList; ReadRString; Authenticate

// incoming procedures
SendWord; SendRName; ReceiveWord; ReceiveRName; ReceiveRList
Enquire; EnquireWithStamp
BSPWriteBlock; BSPForceOutput
Gets; Puts; DefaultArgs; Free

// incoming statics
offsetBSPStr
]

//----------------------------------------------------------------------------
let IsMemberClosure(group, member) =
//----------------------------------------------------------------------------
// Determines whether member appears anywhere in the tree that results from
// expanding group; see IsInACL for details.
   IsInACL(group, member, dItself+dMember+dClosure)

//----------------------------------------------------------------------------
and IsInACL(name, member, descriptor) = valof
//----------------------------------------------------------------------------
// Determines membership in an ACL, as specified by descriptor, which is any
// combination of: {dItself|dItsRegistry} + {dMember|dOwner|dFriend} +
//   {dDirect|dClosure|dUpArrow}
// name identifies the ACL; member is the name being tested for membership;
// both are RNames.  Returns one of the following:
// ecIsMember		member is in the ACL
// ecIsNotMember	member is not in the ACL
// ecBadRName		name does not exist or is of wrong type for op
// ecAllDown		can't contact any R-Server for name's registry
[
let res = nil  // member, descriptor, and res must be consecutive in frame
let returnCode = Enquire(name, IsInACLWork, lv member)
resultis selecton returnCode<<ReturnCode.code into
   [
   case rcDone: res eq 0? ecIsNotMember, ecIsMember
   case rcBadRName: ecBadRName
   default: ecAllDown
   ]
]

//----------------------------------------------------------------------------
and IsInACLWork(stream, group, lvMember) = valof
//----------------------------------------------------------------------------
// Local procedure used by IsInACL.
[
SendWord(stream, opIsInList)  // op
SendRName(stream, group)  // group
SendRName(stream, lvMember!0)  // member
let descriptor = lvMember!1
Puts(stream, descriptor<<ListDesc.who)
Puts(stream, descriptor<<ListDesc.list)
Puts(stream, descriptor<<ListDesc.coverage)
BSPForceOutput(stream-offsetBSPStr, true)
let returnCode = ReceiveWord(stream)
if returnCode<<ReturnCode.code eq rcDone then
   lvMember!2 = Gets(stream, dataTimeout)
resultis returnCode
]

//----------------------------------------------------------------------------
and ReadRList(name, op, lvEC; numargs na) = valof
//----------------------------------------------------------------------------
// Reads a list associated with name (an RName) as specified by op, which
// may be one of opRead{Members|Owners|Friends}.  If successful, returns
// an RList, which the caller must destroy (by calling DestroyRList) when
// done with it.  If unsuccessful, stores an error code in @lvEC (if
// supplied) and returns zero.  The error codes are:
// ecBadRName		name does not exist or is of wrong type for op
// ecAllDown		can't contact any R-Server for name's registry
[
DefaultArgs(lv na, -2, lv na)
let rList = 0  // at op+3 in frame
let returnCode = Enquire(name, ReadRListWork, lv op)
if rList eq 0 then
   @lvEC = returnCode<<ReturnCode.code eq rcBadRName? ecBadRName, ecAllDown
resultis rList
]

//----------------------------------------------------------------------------
and ReadRListWork(stream, name, lvOp) = valof
//----------------------------------------------------------------------------
// Local procedure used by ReadRList.
[
let returnCode = EnquireWithStamp(stream, lvOp!0, name)
if returnCode<<ReturnCode.code eq rcDone then lvOp!3 = ReceiveRList(stream)
resultis returnCode
]

//----------------------------------------------------------------------------
and ReadRString(name, op, lvEC; numargs na) = valof
//----------------------------------------------------------------------------
// Reads a string associated with name (an RName) as specified by op, which
// may be opReadConnect or opReadRemark.  If successful, returns
// a string, which the caller must free to gus>>GUS.zone when
// done with it.  If unsuccessful, stores an error code in @lvEC (if
// supplied) and returns zero.  The error codes are:
// ecBadRName		name does not exist or is of wrong type for op
// ecAllDown		can't contact any R-Server for name's registry
[
DefaultArgs(lv na, -2, lv na)
let string = 0  // at op+3 in frame
let returnCode = Enquire(name, ReadRStringWork, lv op)
if string eq 0 then
   @lvEC = returnCode<<ReturnCode.code eq rcBadRName? ecBadRName, ecAllDown
resultis string
]

//----------------------------------------------------------------------------
and ReadRStringWork(stream, name, lvOp) = valof
//----------------------------------------------------------------------------
// Local procedure used by ReadRString.
[
let returnCode = EnquireWithStamp(stream, lvOp!0, name)
if returnCode<<ReturnCode.code eq rcDone then lvOp!3 = ReceiveRName(stream, 0)
resultis returnCode
]

//----------------------------------------------------------------------------
and Authenticate(name, password) = valof
//----------------------------------------------------------------------------
// Checks name (an RName) and password (a 64-bit key, derived from a password
// string by calling MakeKey).  Returns one of the following:
// ecIndividual		successfully authenticated individual
// ecBadPassword	incorrect password
// ecBadRName		name does not exist or is not an individual
// ecAllDown		can't contact any R-Server for name's registry
[
let returnCode = Enquire(name, AuthenticateWork, password)
resultis selecton returnCode<<ReturnCode.code into
   [
   case rcDone: ecIndividual
   case rcBadPassword: ecBadPassword
   case rcBadRName: ecBadRName
   default: ecAllDown
   ]
]

//----------------------------------------------------------------------------
and AuthenticateWork(stream, name, password) = valof
//----------------------------------------------------------------------------
// Local procedure used by Authenticate.
[
SendWord(stream, opAuthenticate)
SendRName(stream, name)
BSPWriteBlock(stream, password, 0, 2*lenPassword)
BSPForceOutput(stream-offsetBSPStr, true)
resultis ReceiveWord(stream)
]