Class ::xo::ConnectionContext (public)

 ::xotcl::Class ::xo::ConnectionContext

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xo {}
::nsf::object::alloc ::xotcl::Class ::xo::ConnectionContext {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::xo::ConnectionContext proc require_package_id_from_url {{-package_id 0} url} {
    #
    # Get package_id from URL in case it is not known. In case, the
    # package_id is known, this method is essentially a no-op, but
    # takes care about ::ad_conn initialization.
    #
    if {$package_id == 0} {
      set node_info [site_node::get_from_url -url $url]
      set package_id [dict get $node_info package_id]
    }
    if {![info exists ::ad_conn(node_id)] && [info exists node_info]} {
      #
      # The following should not be necessary, but is here for
      # cases, where some oacs-code assumes wrongly it is running in a
      # connection thread (e.g. the site master requires to have a
      # node_id and a URL accessible via ad_conn)
      #
      if {![dict exists $node_info node_id]} {
        if {$url eq ""} {
          set url [lindex [site_node::get_url_from_object_id -object_id $package_id] 0]
        }
        set node_info [site_node::get_from_url -url $url]
      }
      set ::ad_conn(node_id) [dict get $node_info node_id]
      set ::ad_conn(url) $url
      set ::ad_conn(extra_url) [string range $url [string length [dict get $node_info url]] end]
    }
    return $package_id
  }
::xo::ConnectionContext proc require {-url {-package_id 0} {-parameter ""} {-user_id -1} {-actual_query " "} {-keep_cc false}} {
    #
    # This is a private method used for low-level connection context
    # creation. This function has to be called either with a valid
    # "-url" when being used outside connection threads.
    #
    set exists_cc [nsf::is object ::xo::cc]

    # if we have a connection context and we want to keep it, do
    # nothing and return.
    if {$exists_cc && $keep_cc} {
      return
    }

    if {[info exists ::ds_show_p] && [ds_database_enabled_p]} {
      ::xo::dc profile on
    }

    if {![info exists url]} {
      #:log "--CONN ns_conn url"
      if {[ns_conn isconnected]} {
        set url [ad_conn url]
      } else {
        set url ""
        ad_log error "fallback to empty url"
      }
    }
    set package_id [:require_package_id_from_url -package_id $package_id $url]
    #:log "--i [self args] URL='$url', pkg=$package_id"

    # get locale; TODO at some time, we should get rid of the ad_conn init problem
    if {[ns_conn isconnected]} {
      # This can be called, before ad_conn is initialized.
      # Since it is not possible to pass the user_id and ad_conn barfs
      # when it tries to detect it, we try to get it and reset it later
      ad_try {
        set locale [lang::conn::locale -package_id $package_id]
      } on error {errorMsg} {
        ns_log warning "fall back to locale en_US"
        set locale en_US
      }
    } else {
      set locale [lang::system::locale -package_id $package_id]
    }
    if {!$exists_cc} {
      try {
        :create ::xo::cc  -package_id $package_id  -parameter_declaration $parameter  -user_id $user_id  -actual_query $actual_query  -locale $locale  -url $url
      } on error {errorMsg} {
        if {[nsf::is object ::xo::cc]} {
          ::xo::cc destroy
        }
        return -code error -errorcode $::errorCode -errorinfo $::errorInfo $errorMsg
      }
      ::xo::cc destroy_on_cleanup

      # if {[ns_conn isconnected]} {
      #   ns_log notice "XXX ::xo::cc created [ns_conn id] [ns_conn request]"
      #   ::xo::cc set ID [ns_conn id]
      # } else {
      #   ns_log notice "XXX ::xo::cc created without connection"
      #   ::xo::cc set ID UNKNOWN
      # }
      # ::xo::cc proc destroy {args} {
      #   set ID [expr {[info exists :ID] ? ${:ID} : {-}}]
      #   ns_log notice "::xo::cc destroyed ID $ID"
      #   next
      # }

      #::xo::show_stack
      #:msg "--cc ::xo::cc created $url [::xo::cc serialize]"

    } else {
      #:msg "--cc ::xo::cc reused $url -package_id $package_id"
      ::xo::cc configure  -url $url  -actual_query $actual_query  -locale $locale  -parameter_declaration $parameter

      ::xo::cc package_id $package_id
      ::xo::cc set_user_id $user_id
      ::xo::cc process_query_parameter
    }

    # simple mobile detection
    ::xo::cc mobile 0
    if {[ns_conn isconnected]} {
      set user_agent [string tolower [ns_set iget [ns_conn headers] User-Agent]]
      ::xo::cc mobile [regexp (android|webos|iphone|ipad) $user_agent]
    }

    if {![info exists ::ad_conn(charset)]} {
      set ::ad_conn(charset) [lang::util::charset_for_locale $locale]
      set ::ad_conn(language) [::xo::cc lang]
      set ::ad_conn(file) ""
    }
  }
::xo::ConnectionContext instproc get_parameter {name {default {}}} {
    return [expr {[info exists :perconnectionparam($name)]
                  ? [set :perconnectionparam($name)]
                  : $default}]
  }
::xo::ConnectionContext instproc require_form_parameter {} {
    if {![info exists :form_parameter]} {
      :load_form_parameter
    }
  }
::xo::ConnectionContext instproc role=all {-user_id:required -package_id} {
    return 1
  }
::xo::ConnectionContext instproc permission {-object_id:integer,required -privilege:required -party_id:integer} {
    if {![info exists party_id]} {
      set party_id ${:user_id}
    }
    # :log "--  context permission user_id=$party_id uid=[::xo::cc user_id]"  "untrusted=[::xo::cc set untrusted_user_id]"
    if {$party_id == 0} {
      set granted [permission::permission_p -no_login -party_id $party_id  -object_id $object_id  -privilege $privilege]
      #:msg "--p lookup $key ==> $granted uid=${:user_id} uuid=${:untrusted_user_id}"
      if {$granted || ${:user_id} == ${:untrusted_user_id}} {
        return $granted
      }
      # The permission is not granted for the public.
      # We force the user to login
      #:log "-- require login"
      #auth::require_login
      return 0
    }

    #:msg "--p lookup $key"
    return [permission::permission_p -no_login  -party_id $party_id  -object_id $object_id  -privilege $privilege]
    #:log "--  context return [set :$key]"
    #set :$key
  }
::xo::ConnectionContext instproc lang {} {
    return [string range [:locale] 0 1]
  }
::xo::ConnectionContext instproc get_all_form_parameter {} {
    :require_form_parameter
    return [array get :form_parameter]
  }
::xo::ConnectionContext instproc load_form_parameter {} {
    if {[ns_conn isconnected] && [ns_conn method] eq "POST"} {
      :load_form_parameter_from_values [ns_set array [ns_getform]]
    } else {
      array set :form_parameter {}
    }
  }
::xo::ConnectionContext instproc role=app_group_member {-user_id:required -package_id} {
    return [:cache [list application_group::contains_party_p  -party_id $user_id  -package_id $package_id]]
  }
::xo::ConnectionContext instproc role=registered_user {-user_id:required -package_id} {
    return [expr {$user_id != 0}]
  }
::xo::ConnectionContext instproc init {} {
    :set_user_id ${:user_id}
    set pa [expr {[ns_conn isconnected] ? [ad_conn peeraddr] : "nowhere"}]

    if {${:user_id} != 0} {
      set :requester ${:user_id}
    } else {
      #
      # For requests bypassing the ordinary connection setup
      # (resources in oacs 5.2+) we have to get the user_id by
      # ourselves.
      #
      ad_try {
        set cookie_list [ad_get_signed_cookie_with_expr "ad_session_id"]
        set cookie_data [split [lindex $cookie_list 0] {,}]
        set untrusted_user_id [lindex $cookie_data 1]
        set :requester $untrusted_user_id
      } on error {errorMsg } {
        set :requester 0
      }
    }

    # if user not authorized, use peer address as requester key
    if {${:requester} == 0} {
      set :requester $pa
      set :user "client from $pa"
    } else {
      set user_url [acs_community_member_admin_url -user_id ${:requester}]
      set :user "<a href='$user_url'>${:requester}</a>"
    }
    #:log "--i requester = ${:requester}"

    :process_query_parameter
  }
::xo::ConnectionContext instproc set_user_id user_id {
    if {$user_id == -1} {  ;# not specified
      if {[info exists ::ad_conn(user_id)]} {
        set :user_id [ad_conn user_id]
        ad_try {
          set :untrusted_user_id [ad_conn untrusted_user_id]
        } on error {errorMsg} {
          set :untrusted_user_id ${:user_id}
        }
      } else {
        set :user_id 0
        set :untrusted_user_id 0
        array set ::ad_conn [list user_id $user_id untrusted_user_id $user_id session_id ""]
      }
    } else {
      set :user_id $user_id
      set :untrusted_user_id $user_id
      if {![info exists ::ad_conn(user_id)]} {
        array set ::ad_conn [list user_id $user_id untrusted_user_id $user_id session_id ""]
      }
    }
  }
::xo::ConnectionContext instproc query_parameter {__spec {default {}}} {
    #
    # Try to split up provided "__spec" argument into name and
    # value constraint components.
    #
    set __name $__spec
    regexp {^([^:]+):(.*)$} $__spec . __name constraint

    if {[:exists_parameter $__name]} {
      set value [:get_parameter $__name]
    } else {
      set value [next $__name $default]
    }
    #
    # If we have a value-constraint, we check for empty values only in
    # cases, where multiplicity is specified. This means effectively
    # that the default multiplicity is "0..1".
    #
    if {[info exists constraint]} {
      set r [xo::validate_parameter_constraints $__name $constraint $value]
      if {$r ne $value} {
        ns_log notice "converting value checker: query parameter <$__spec> -> '$value' -> '$r'"
        set value $r
      }
    }
    return $value
  }
::xo::ConnectionContext instproc role=unregistered_user {-user_id:required -package_id} {
    return [expr {$user_id == 0}]
  }
::xo::ConnectionContext instproc cache_set {cmd value} {
    return [set :cache($cmd) $value]
  }
::xo::ConnectionContext instproc role=creator {-user_id:required -package_id -object:required} {
    $object instvar creation_user
    return [expr {$creation_user == $user_id}]
  }
::xo::ConnectionContext instproc role=admin {-user_id:required -package_id:required} {
    return [:permission -object_id $package_id -privilege admin -party_id $user_id]
  }
::xo::ConnectionContext instproc exists_parameter name {
    info exists :perconnectionparam($name)
  }
::xo::ConnectionContext instproc eval_as_user {-user_id:integer cmd} {
    #ns_log notice "RUN AS USER $user_id $cmd"
    set result ""
    set current_user_id [:get_user_id]
    try  {
      :set_user_id $user_id
      :uplevel $cmd
    } on ok {r} {
      set result $r
    } finally {
      :set_user_id $current_user_id
    }
    return $result
  }
::xo::ConnectionContext instproc returnredirect {-allow_complete_url:switch url} {
    #:log "--rp"
    set :__continuation [expr {$allow_complete_url
                                 ? [list ad_returnredirect -allow_complete_url $url]
                                 : [list ad_returnredirect $url]}]
    return ""
  }
::xo::ConnectionContext instproc get_user_id {} {
    #
    # If the untrusted user_id exists, return it. This will return
    # consistently the user_id also in situations, where the login
    # cookie was expired. If no untrusted_user_id exists Otherwise
    # (maybe in a remoting setup), return the user_id.
    #
    if {[info exists :untrusted_user_id]} {
      return ${:untrusted_user_id}
    }
    return ${:user_id}
  }
::xo::ConnectionContext instproc requestor {} {
    #
    # Helper method to ease migration to the name without the spelling
    # error.
    #
    ad_log_deprecated method "... requestor" "... requester"
    return [expr {[info exists :requester] ? ${:requester} : ${:requester}}]
  }
::xo::ConnectionContext instproc cache_unset cmd {
    return [unset :cache($cmd)]
  }
::xo::ConnectionContext instproc role=swa {-user_id:required -package_id} {
    return [:cache [list acs_user::site_wide_admin_p -user_id $user_id]]
  }
::xo::ConnectionContext instproc perconnection_parameter_set_all pairs {
    unset -nocomplain :perconnectionparam
    array set :perconnectionparam $pairs
  }
::xo::ConnectionContext instproc cache_exists cmd {
    return [info exists :cache($cmd)]
  }
::xo::ConnectionContext instproc cache_get cmd {
    return [set :cache($cmd)]
  }
::xo::ConnectionContext instproc role=community_member {-user_id:required -package_id} {
    if {[info commands ::dotlrn_community::get_community_id] ne ""} {
      set community_id [:cache [list [dotlrn_community::get_community_id -package_id $package_id]]]
      if {$community_id ne ""} {
        return [:cache [list dotlrn::user_is_community_member_p  -user_id $user_id  -community_id $community_id]]
      }
    }
    return 0
  }
::xo::ConnectionContext instproc exists_form_parameter name {
    :require_form_parameter
    info exists :form_parameter($name)
  }
::xo::ConnectionContext instproc cache cmd {
    set key :cache($cmd)
    if {![info exists $key]} {set $key [:uplevel $cmd]}
    return [set $key]
  }
::xo::ConnectionContext instproc form_parameter {spec {default {}}} {
    :require_form_parameter

    set name $spec
    regexp {^([^:]+):(.*)$} $spec . name constraint

    if {[info exists :form_parameter($name)]} {
      if {[info exists :form_parameter_multiple($name)]} {
        set value [set :form_parameter($name)]
      } else {
        set value [lindex [set :form_parameter($name)] 0]
      }
      if {[info exists constraint]} {
        set r [xo::validate_parameter_constraints $name $constraint $value]
        if {$r ne $value} {
          ns_log notice "converting value checker: form parameter validate <$spec> -> '$value' -> '$r'"
          set value $r
        }
      } else {
        #:msg "FORM_PARAMETER spec <$spec> no constraint -> '$value'"
      }
      return $value
    } else {
      return $default
    }
  }
::xo::ConnectionContext instproc set_parameter {name value} {
    set key [list get_parameter $name]
    if {[:cache_exists $key]} {:cache_unset $key}
    set :perconnectionparam($name) $value
  }
::xo::ConnectionContext instproc load_form_parameter_from_values values {
    foreach {att value} $values {
      # For some unknown reasons, Safari 3.* returns sometimes
      # entries with empty names... We ignore these for now
      if {$att eq ""} continue
      if {[info exists :form_parameter($att)]} {
        set :form_parameter_multiple($att) 1
      }
      lappend :form_parameter($att) $value
    }
  }
::xo::ConnectionContext instproc perconnection_parameter_get_all {} {
    array get :perconnectionparam
  }
::xo::ConnectionContext instproc unset_parameter name {
    set key [list get_parameter $name]
    if {[:cache_exists $key]} {:cache_unset $key}
    unset -nocomplain :perconnectionparam($name)
  }
::xo::ConnectionContext instparametercmd requester
::xo::ConnectionContext instparametercmd mobile
::xo::ConnectionContext instparametercmd url
::xo::ConnectionContext instparametercmd user_id
::xo::ConnectionContext instparametercmd user
::nsf::relation::set ::xo::ConnectionContext superclass ::xo::Context

::nx::slotObj -container slot ::xo::ConnectionContext
::xo::ConnectionContext::slot eval {set :__parameter {
    user_id
    requester
    user
    url
    mobile
  }}

::nsf::object::alloc ::xotcl::Attribute ::xo::ConnectionContext::slot::url {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::ConnectionContext
   set :incremental 0
   set :manager ::xo::ConnectionContext::slot::url
   set :methodname url
   set :multiplicity 1..1
   set :name url
   set :parameterSpec -url
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::ConnectionContext::slot::user_id {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::ConnectionContext
   set :incremental 0
   set :manager ::xo::ConnectionContext::slot::user_id
   set :methodname user_id
   set :multiplicity 1..1
   set :name user_id
   set :parameterSpec -user_id
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::ConnectionContext::slot::user {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::ConnectionContext
   set :incremental 0
   set :manager ::xo::ConnectionContext::slot::user
   set :methodname user
   set :multiplicity 1..1
   set :name user
   set :parameterSpec -user
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::ConnectionContext::slot::mobile {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::ConnectionContext
   set :incremental 0
   set :manager ::xo::ConnectionContext::slot::mobile
   set :methodname mobile
   set :multiplicity 1..1
   set :name mobile
   set :parameterSpec -mobile
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::ConnectionContext::slot::requester {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::ConnectionContext
   set :incremental 0
   set :manager ::xo::ConnectionContext::slot::requester
   set :methodname requester
   set :multiplicity 1..1
   set :name requester
   set :parameterSpec -requester
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

XQL Not present:

Generic, PostgreSQL, Oracle