xo::Policy instproc check_permissions (public)

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

Defined in packages/xotcl-core/tcl/policy-procs.tcl

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):

Testcases:

xowiki_test_cases

Source code:

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

XQL Not present:

Generic, PostgreSQL, Oracle