%3 ::xotcl::Object ::xotcl::Object → getExitHandler → setExitHandler → unsetExitHandler __object_configureparameter __timediff abstract ad_doc ad_forward ad_proc asHTML check class db_0or1row db_1row debug destroy_on_cleanup ds extractConfigureArg filter filtersearch forward hasclass init invar isclass ismetaclass ismixin isobject istype log method mixin mset msg parametercmd proc procsearch qn self serialize set_instance_vars_defaults unknown vwait www-show-object ::xo::Policy ::xo::Policy check_permissions check_privilege defined_methods enforce_permissions get_permission get_privilege ::xo::Policy->::xotcl::Object ::xowiki::Policy ::xowiki::Policy ::xowiki::Policy->::xo::Policy

Class ::xo::Policy

::xo::Policy[i] create ...

Class Relations

  • class: ::xotcl::Class[i]
  • superclass: ::xotcl::Object[i]
  • subclass: ::xowiki::Policy[i]
::xotcl::Class create ::xo::Policy \
     -superclass ::xotcl::Object

Methods (to be applied on instances)

  • check_permissions (scripted, public)

     <instance of xo::Policy[i]> check_permissions [ -user_id user_id ] \
    [ -package_id package_id ] [ -link link ] object method

    This method checks whether the current or specified user is allowed to invoke a method based on the given policy. This method is purely checking and does not force logins or other side effects. It can be safely used for example to check whether links should be shown or not.

    Switches:
    -user_id
    (optional)
    -package_id
    (optional)
    -link
    (optional)
    Parameters:
    object
    method
    Returns:
    0 or 1
    See Also:
    • enforce_permissions

    Partial Call Graph (max 5 caller/called nodes):
    %3 test_xowiki_test_cases xowiki_test_cases (test xowiki) xo::Policy instproc check_permissions xo::Policy instproc check_permissions test_xowiki_test_cases->xo::Policy instproc check_permissions

    Testcases:
    xowiki_test_cases
    if {![info exists user_id]} {
  set user_id [::xo::cc user_id]
}
if {![info exists package_id]} {
  set package_id [::xo::cc package_id]
}
#:msg [info exists package_id]=>$package_id-[info exists :logical_package_id]
set ctx "::xo::cc"
if {$link ne ""} {
  #
  # Extract the query parameter from the link
  #
  set questionMarkPos [string first ? $link]
  if {$questionMarkPos > -1} {
    set query [string range $link $questionMarkPos+1 end]
  } else {
    set query ""
  }
  set ctx [::xo::Context new -destroy_on_cleanup -actual_query $query]
  $ctx process_query_parameter
}

set allowed 0
set permission [:get_permission $object $method]
#:log "--permission for o=$object, m=$method => $permission"

#:log "--     user_id=$user_id uid=[::xo::cc user_id] untrusted=[::xo::cc set untrusted_user_id]"
if {$permission ne ""} {
  lassign [:get_privilege -query_context $ctx $permission $object $method] kind p
  #:msg "--privilege = $p kind = $kind"
  switch -- $kind {
    primitive {
      set allowed [:check_privilege -login false  -package_id $package_id -user_id $user_id  $p $object $method]
    }
    complex {
      lassign $p attribute privilege
      set id [$object set $attribute]
      set allowed [::xo::cc permission -object_id $id -privilege $privilege -party_id $user_id]
    }
  }
}
#:log "--p check_permissions {$object $method} : $permission ==> $allowed"
return $allowed

  • check_privilege (scripted)

    #:log "--p [self proc] [self args]"
if {$privilege eq "nobody"} {
  return 0
}
if {$privilege eq "everybody" || $privilege eq "public" || $privilege eq "none"} {
  return 1
}

#:log "--login $login user_id=$user_id uid=[::xo::cc user_id] untrusted=[::xo::cc set untrusted_user_id]"
if {$login && $user_id == 0} {
  #
  # The tests below depend on the user_id.
  # The main reason, we call auth:require_login here is to check for exired logins.
  #
  #:log "--p [self proc] calls require_login"
  set user_id [auth::require_login]
}

if {$privilege eq "login" || $privilege eq "registered_user"} {
  return [expr {$user_id != 0}]
}

if {[::xo::cc cache [list acs_user::site_wide_admin_p -user_id $user_id]]} {
  # swa is allowed to do everything handled below as well
  return 1
} elseif {$privilege eq "swa"} {
  return 0
}

if {[::xo::cc permission -object_id $package_id -privilege admin -party_id $user_id]} {
  # package_admin is allowed to do everything handled below as well
  return 1
} elseif {$privilege eq "admin"} {
  return 0
}

set allowed -1   ;# undecided
# try object specific privileges. These have the signature:
#
# <class> instproc privilege=<name> {{-login true} user_id package_id method}
#
if {[$object info methods privilege=$privilege] ne ""} {
  if {![info exists package_id]} {set package_id [::xo::cc package_id]}
  set allowed [$object privilege=$privilege -login $login $user_id $package_id $method]
}
#:msg "--check_privilege {$privilege $object $method} ==> $allowed"
return $allowed

  • defined_methods (scripted)

    set c [self]::$class
expr {[:isclass $c] ? [$c array names require_permission] : {}}

  • enforce_permissions (scripted, public)

     <instance of xo::Policy[i]> enforce_permissions \
    [ -user_id user_id ] [ -package_id package_id ] object method

    This method checks whether the current user is allowed or not to invoke a method based on the given policy and forces logins if required.

    Switches:
    -user_id
    (optional)
    -package_id
    (optional)
    Parameters:
    object
    method
    Returns:
    0 or 1
    See Also:
    • check_permissions

    Partial Call Graph (max 5 caller/called nodes):
    %3 test_xowiki_test_cases xowiki_test_cases (test xowiki) xo::Policy instproc enforce_permissions xo::Policy instproc enforce_permissions test_xowiki_test_cases->xo::Policy instproc enforce_permissions _ _ (public) xo::Policy instproc enforce_permissions->_ ad_return_forbidden ad_return_forbidden (public) xo::Policy instproc enforce_permissions->ad_return_forbidden ad_script_abort ad_script_abort (public) xo::Policy instproc enforce_permissions->ad_script_abort auth::require_login auth::require_login (public) xo::Policy instproc enforce_permissions->auth::require_login

    Testcases:
    xowiki_test_cases
    if {![info exists user_id]} {set user_id [::xo::cc user_id]}
if {![info exists package_id]} {set package_id [::xo::cc package_id]}

set allowed 0
set permission [:get_permission $object $method]
if {$permission ne ""} {
  lassign [:get_privilege $permission $object $method] kind p
  switch -- $kind {
    primitive {
      set allowed [:check_privilege  -user_id $user_id -package_id $package_id  $p $object $method]
      set privilege $p
    }
    complex {
      lassign $p attribute privilege
      set id [$object set $attribute]
      set allowed [::xo::cc permission -object_id $id  -privilege $privilege  -party_id $user_id]
    }
  }
}

#:log "--p enforce_permissions {$object $method} : $permission ==> $allowed"

if {!$allowed} {
  #
  # In case the request does not come from a connected client
  # (e.g. via some magic way via background processing) then
  # just abort in the call (raising an exception).
  #
  if {[ns_conn isconnected]} {
    set untrusted_user_id [::xo::cc set untrusted_user_id]
    if {$permission eq ""} {
      ns_log notice "enforce_permissions: no permission for $object->$method defined"
    } elseif {$user_id == 0 && $untrusted_user_id} {
      ns_log notice "enforce_permissions: force login, user_id=0 and untrusted_id=$untrusted_user_id"
      auth::require_login
    } else {
      ns_log notice "enforce_permissions: $user_id doesn't have $privilege on $object"
    }

    ad_return_forbidden [_ xotcl-core.permission_denied]  [_ xotcl-core.policy-error-insufficient_permissions]
  } else {
    ns_log warning "enforce_permissions: $user_id has no right to $method on $object in background operation"
  }
  ad_script_abort
}

return $allowed

  • get_permission (scripted)

    #ns_log notice "[self] [self proc] [self args] // object=$object"
set o [self]::[namespace tail $object]
set key require_permission($method)
if {[::nsf::is object $o]} {
  if {[$o exists $key]} {
    set permission [$o set $key]
  } elseif {[$o exists default_permission]} {
    set permission [$o set default_permission]
  } else {
    set permission ""
  }
} elseif {$check_classes} {
  #
  # We have no object specific policy information, check the
  # class tree up to the root.
  #
  #ns_log notice "---check [list $object info class]"
  set c [$object info class]
  foreach class [concat $c [$c info heritage]] {
    set c [self]::[namespace tail $class]
    if {![::nsf::is class $c]} {
      continue
    }
    set permission [:get_permission -check_classes false $class $method]
    if {$permission ne ""} {
      break
    }
  }
  if {![info exists permission]} {
    #
    # This can happen only in error situations, when
    #
    set class_info [expr {[info exists c] && [::nsf::is class $c] ?
                          "using the class hierarchy [concat $c [$c info heritage]]" :
                          ""}]
    ad_log error "get_permission could not find an appropriate class for checking"  "permissions for '$object' and '$method' in policy [self]"  $class_info
    set permission ""
  }
}
return $permission

  • get_privilege (scripted)

    #
# The privilege might be primitive (one word privilege),
# or it might be complex (attribute + privilege),
# or it might be conditional (primitive or complex) in a list of privileges.
#
foreach p $permission {
  #:msg "checking permission '$p'"
  set condition [lindex $p 0]
  if {[llength $condition]>1} {
    # we have a condition
    lassign $condition cond value
    if {[$object condition=$cond $query_context $value]} {
      return [:get_privilege [list [lrange $p 1 end]] $object $method]
    }
  } else {
    # we have no condition
    return [list [expr {[llength $p] == 1 ? "primitive" : "complex"}] $p]
  }
}
# In cases, where is no permission defined, or all conditions
# fail, and no unconditional privilege is defined, reject access.
# Maybe, we should search the class hierarchy up in the future.
return [list primitive nobody]