// IFSAccessControl.bcpl
// Copyright Xerox Corporation 1981, 1982

// Last modified April 11, 1982  11:18 AM by Taft

get "Ifs.decl"
get "IfsFiles.decl"
get "IfsDirs.decl"
get "IfsRs.decl"
get "Grapevine.decl"
get "GrapevineProtocol.decl"


external
[
// outgoing procedures
CheckAccess; CheckAllocation
UserOwns; RNamesEqual; MakeQualifiedRName; StripDefaultReg

// incoming procedures
GetDIF; UpdateCachedDIF; GetGroupName; IsInACL
ExtractSubstring; StringCompare; GetBit; SetBit; ExpandTemplate
DefaultArgs; SysFree; FreePointer; MoveBlock; Zero; DoubleUsc

// outgoing statics
enableGrapevineAuth; enableGrapevineGroup; defaultRegistry

// incoming statics
CtxRunning
]

static
[
enableGrapevineAuth = false  // authenticate via Grapevine if true
enableGrapevineGroup = false  // group membership via Grapevine if true
defaultRegistry = 0  // -> default Grapevine registry name if nonzero
]

// special group number for obtaining the real name of the "World" group
manifest groupNumWorld = size Protection

//----------------------------------------------------------------------------
let UserOwns(fd, userInfo; numargs na) = valof
//----------------------------------------------------------------------------
// Returns true if the user described by userInfo is the owner of
// the file described by fd.  The file need not exist.
[
DefaultArgs(lv na, -1, CtxRunning>>RSCtx.userInfo)
let dirName = ExtractSubstring(lv fd>>FD.dr>>DR.pathName, 2,
 fd>>FD.lenDirString-1)

// compare connected & login directory names to "<dir>" portion of filename
let res = RNamesEqual(userInfo>>UserInfo.connName, dirName)? true,
 RNamesEqual(userInfo>>UserInfo.userName, dirName)? true, false

SysFree(dirName)
resultis res
]

//----------------------------------------------------------------------------
and RNamesEqual(name1, name2) = valof
//----------------------------------------------------------------------------
// Returns true iff name1 is equal to name2, treated as R-Names.
// If either name is unqualified it is assumed to belong to defaultRegistry.
[
if name1>>String.length gr name2>>String.length then
   [ let t = name1; name1 = name2; name2 = t ]  // exchange names

// now name1.length le name2.length
switchon StringCompare(name1, name2) into
   [
   case 0:  // exact match
      resultis true
   case -2:  // name1 is an initial substring of name2
      if defaultRegistry ne 0 then
         [  // see if tail is ".<defaultRegistry>"
         let iDot = name1>>String.length+1
         if name2>>String.char^iDot eq $. &
          StringCompare(name2, defaultRegistry, iDot+1) eq 0 resultis true
	 ]
   ]

resultis false
]

//---------------------------------------------------------------------------
and MakeQualifiedRName(name) = valof
//---------------------------------------------------------------------------
// Returns a new string which is the fully-qualified form of name,
// using defaultRegistry if name is not already qualified.
[
if defaultRegistry eq 0 resultis ExtractSubstring(name)
for i = 1 to name>>String.length do
   if name>>String.char^i eq $. resultis ExtractSubstring(name)
resultis ExpandTemplate("$S.$S", name, defaultRegistry)
]

//---------------------------------------------------------------------------
and StripDefaultReg(name) = valof
//---------------------------------------------------------------------------
// Strips the registry from name if it is the default registry.
// Returns true if it stripped the registry and false if not.
[
if defaultRegistry ne 0 then
   for i = name>>String.length to 1 by -1 do
      if name>>String.char^i eq $. &
       StringCompare(name, defaultRegistry, i+1) eq 0 then
         [ name>>String.length = i-1; resultis true ]
resultis false
]

//----------------------------------------------------------------------------
and CheckAllocation(difRec, userInfo; numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -1, CtxRunning>>RSCtx.userInfo)
resultis userInfo>>UserInfo.capabilities.wheel ne 0 %
 DoubleUsc(lv difRec>>DIFRec.diskPageUsage,
  lv difRec>>DIFRec.diskPageLimit) ls 0
]

//----------------------------------------------------------------------------
and CheckAccess(prot, owner, userInfo; numargs na) = valof
//----------------------------------------------------------------------------
// Checks whether the user described by userInfo has access to
// the entity protected by the Protection "prot".  "owner" should
// be true if the user owns the entity in question and false
// otherwise.  Returns true if access is allowed.
[
DefaultArgs(lv na, -2, CtxRunning>>RSCtx.userInfo)
if userInfo>>UserInfo.capabilities.wheel resultis true
let userGroups = lv userInfo>>UserInfo.userGroups
userGroups>>Protection.owner = owner
unless enableGrapevineGroup do userGroups>>Protection.world = true

// First check the cached group membership
for i = 0 to lenProtection-1 do
   if (userGroups!i & prot!i) ne 0 resultis true
unless enableGrapevineGroup resultis false

// Local cache failed; do Grapevine access check.
// For each group present in the protection but absent in the user's
// locally-known group membership, ask Grapevine whether the user is a
// member of the group, and update the locally-known group membership.
// To minimize time wasted asking Grapevine about groups that the user is
// not a member of (which is relatively expensive), we check groups in
// two passes.  During the first pass skip over the groups indicated in
// the user's hintNotUserGroups.  Only if this fails do we check those
// groups (in case the hint has become obsolete).

// CheckAccess (cont'd)

let hintNotUserGroups = vec lenProtection
let dif = GetDIF(userInfo>>UserInfo.userName)
test dif eq 0
   ifso Zero(hintNotUserGroups, lenProtection)
   ifnot
      [
      unless dif>>DIF.validGrapevineRName do
         [ SysFree(dif); resultis false ] // not in Grapevine, no point asking
      MoveBlock(hintNotUserGroups, lv dif>>DIF.hintNotUserGroups, lenProtection)
      ]

let difChanged = false
let ignoreHint = false
let result = valof
   [ // repeat
   // do groups in reverse numerical order so as to pick up World first
   for group = size Protection-1 to 0 by -1 do
      if group ne offset Protection.owner &
       GetBit(prot, group) & not GetBit(userGroups, group) &
       GetBit(hintNotUserGroups, group) eq ignoreHint then
         [
         let groupName = GetGroupName((group eq offset Protection.world?
          groupNumWorld, group))
         let ec = ecBadRName
         if groupName ne 0 then
            [  // ask Grapevine: IsMember, UpArrow closure
            ec = IsInACL(groupName, userInfo>>UserInfo.userName,
             dItself+dMember+dUpArrow)
            SysFree(groupName)
            ]

         switchon ec into
            [
            case ecIsMember:
               SetBit(userGroups, group, true)
               if dif ne 0 then
                  [
                  SetBit(lv dif>>DIF.userGroups, group, true)
                  SetBit(lv dif>>DIF.hintNotUserGroups, group, false)
                  difChanged = true
                  ]
               resultis true

            case ecBadRName:
               // If "World" group is not specified or is unknown to
               // Grapevine then let it include everyone.  For other groups,
               // if no group name is specified or Grapevine never heard
               // of the name, consider the user not to be a member.
               if group eq offset Protection.world then docase ecIsMember

            case ecIsNotMember:
            case ecAllDown:  // not a member if Grapevine is unresponsive
               if dif ne 0 & not ignoreHint then
                  [
                  SetBit(lv dif>>DIF.hintNotUserGroups, group, true)
                  difChanged = true
                  ]
               endcase
            ]
         ]
         
   if ignoreHint then resultis false
   ignoreHint = true
   ] repeat

if difChanged then UpdateCachedDIF(userInfo>>UserInfo.userName, dif)
FreePointer(lv dif)
resultis result
]