---

Class ::xo::ProtocolHandler

::xo::ProtocolHandler create ... \
           [ -package package ] \
           [ -url url ]

Class Relations

• class: ::xotcl::Class
• superclass: ::xotcl::Object
• subclass: ::xo::dav

::xotcl::Class create ::xo::ProtocolHandler \
     -superclass ::xotcl::Object

Methods (to be applied on instances)

• GET (scripted)

  :log "--GET method"
  ns_return 200 text/plain GET-${:uri}

• OPTIONS (scripted)

  ns_set put [ns_conn outputheaders] Allow OPTIONS
  ns_return 200 text/plain {}

• PROPFIND (scripted)

  #:log "--ProtocolHandler PROPFIND [ns_conn content]"
  # when GET is not supported on this resource, the get* properties are not be sent
  # see http://www.webdav.org/specs/rfc4918.html, 9.1.5
  lappend davprops  lp1:resourcetype    <D:collection/>  lp1:creationdate    [:tcl_time_to_iso8601 "2013-06-30 01:21:22.648325+02"]  D:supportedlock     {}  D:lockdiscovery     {}
  
  ns_return 207 text/xml [:multiStatus  [:multiStatusResponse  -href ${:uri}  -propstats [list $davprops "HTTP/1.1 200 OK"]]]

• PUT (scripted)

  :log "--PUT method [ns_conn content]"
  ns_return 201 text/plain "received put with content-length [string length [ns_conn content]]"

• get_package_id (scripted, public)

   <instance of xo::ProtocolHandler> get_package_id

  Initialize the given package and return the package_id

  Returns:

  package_id

  Partial Call Graph (max 5 caller/called nodes):

  Testcases:

  No testcase defined.

  ${:package} initialize -url ${:uri}
  :log "-- ${:package} initialize -url ${:uri}"
  return $package_id

• handle_request (scripted, public)

   <instance of xo::ProtocolHandler> handle_request args \
      [ args... ]

  Process the incoming HTTP request. This method could be overloaded by the application and dispatches the HTTP requests.

  Parameters:

  args
  

  Partial Call Graph (max 5 caller/called nodes):

  Testcases:

  No testcase defined.

  :log "--handle_request method=${:method} uri=${:uri} userid=${:user_id} -ns_conn query '[ns_conn query]'"
  if {[info exists :package] && ${:uri} ne "/"} {
    # We don't call package-initialize for ${:uri} = "/"
    set :package_id [:get_package_id]
  }
  if {[:procsearch ${:method}] ne ""} {
    :${:method}
  } else {
    ns_return 404 text/plain "not implemented"
  }

• http_date (scripted)

  # HTTP-Date as defined in RFC2068#section-3.3.1
  return "[clock format $seconds -format {%a, %d %b %Y %T} -gmt 1] GMT"

• initialize (scripted, public)

   <instance of xo::ProtocolHandler> initialize

  Setup connection object and authenticate user

  Partial Call Graph (max 5 caller/called nodes):

  Testcases:

  No testcase defined.

  ad_conn -reset
  
  #
  # Make sure, there is no ::ad_conn(request); otherwise the
  # developer support will add all its output to a single var, which
  # can lead easily to running out of resources in busy sites. When
  # unset, the developer support will create its own id.
  unset -nocomplain ::ad_conn(request)
  
  set :uri [ns_urldecode [ns_conn url]]
  if {[string length ${:uri}] < [string length ${:url}]} {append :uri /}
  set url_regexp "^${:url}"
  regsub $url_regexp ${:uri} {} :uri
  if {![regexp {^[./]} ${:uri}]} {set :uri /${:uri}}
  #:log "--conn_setup: uri '${:uri}' url='${:url}' con='[ns_conn url]'"
  :set_user_id
  
  set :method [string toupper [ns_conn method]]
  #:log "--conn_setup: uri '${:uri}' method ${:method}"
  set :urlv [split [string trim ${:uri} "/"] "/"]
  set :user_agent [ns_set iget [ns_conn headers] user-agent]
  set :destination [ns_urldecode [ns_set iget [ns_conn headers] Destination]]
  if {${:destination} ne ""} {
    regsub {https?://[^/]+/} ${:destination} {/} dest
    regsub $url_regexp $dest {} :destination
    if {![regexp {^[./]} ${:destination}]} {set :destination /${:destination}}
  }
  :log "--conn_setup: method ${:method} destination '${:destination}' uri '${:uri}' peer [ns_conn peeraddr]"

• log (scripted)

  #
  # Comment/uncomment one of the two following lines to
  # activate/silence the logging.
  #
  #next "xo::ProtocolHandler: $message"
  #ns_log notice "xo::ProtocolHandler [self]: $message"

• multiStatus (scripted)

  append _ {<?xml version="1.0" encoding="utf-8" ?>} \n  {<D:multistatus xmlns:D="DAV:">} $body \n </D:multistatus> \n

• multiStatusError (scripted)

  lappend davprops  D:getlastmodified ""  D:getcontentlength ""  D:creationdate ""  D:resourcetype ""
  set r [:multiStatus [:multiStatusResponse  -href [ns_urldecode [ns_conn url]]  -propstats [list $davprops $status]]]
  :log multiStatusError=$r
  ns_return 207 text/xml $r

• multiStatusResponse (scripted)

  :log "multiStatusResponse href $href propstats $propstats"
  append reply \n  {<D:response xmlns:lp1="DAV:" xmlns:lp2="http://apache.org/dav/props/" xmlns:g0="DAV:">}  "\n<D:href>$href</D:href>\n"
  # The multi-status response has 2 formats
  # - with <D:propstat> (used in PROPFIND and PROPPATCH)
  # - without <D:propstat> (used in other cases, e.g. DELETE, COPY, MOVE for collections)
  # http://www.webdav.org/specs/rfc4918.html#multi-status.response
  #
  foreach {props status} $propstats {
    if {$propstatus} {
      append reply <D:propstat>\n
      if {[llength $props] > 0} {
        append reply <D:prop>\n
        foreach {name value} $props {
          if {$value ne ""} {
            append reply <$name>$value</$name>\n
          } else {
            append reply <$name/>\n
          }
        }
        append reply </D:prop>\n
      } else {
        append reply <D:prop/>\n
      }
      append reply <D:status>$status</D:status>\n</D:propstat>\n
    } else {
      append reply <D:status>$status</D:status>\n
    }
  }
  append reply </D:response>\n

• package (setter)

• preauth (scripted, public)

   <instance of xo::ProtocolHandler> preauth args [ args... ]

  Handle authorization. This method is called via ns_filter.

  Parameters:

  args
  

  Partial Call Graph (max 5 caller/called nodes):

  Testcases:

  No testcase defined.

  #:log "--preauth args=<$args>"
  
  # Restrict to SSL if required
  if { [security::RestrictLoginToSSLP]  && ![security::secure_conn_p] } {
    ns_returnunauthorized
    return filter_return
  }
  
  #
  # Set common data for all kind of requests. A possible outcome is
  # that we cannot proceed (authentication failure), so we have
  # to trap such cases.
  try {
    :initialize
  } trap {AUTH UNAUTHORIZED} {errorMsg} {
    :log "not authorized: $errorMsg"
    ns_returnunauthorized
    return filter_return
  } on error {errorMsg} {
    ns_log error "ProtocolHandler: exception during initialization: $errorMsg"
    return filter_return
  }
  
  if {${:user_id} == 0} {
    #
    # Check, if we are running under the regression test. For this,
    # the nsv must exist and the peeraddr must be the regression
    # test. If this is all true, accept the user_id if provided.
    #
    if {[nsv_array exists aa_test]
        && [nsv_get aa_test logindata logindata]
        && [ns_conn peeraddr] eq [dict get $logindata peeraddr]
      } {
      #ns_log notice logindata=$logindata
      if {[dict exists $logindata user_id]} {
        ad_conn -set user_id [dict get $logindata user_id]
        ad_conn -set untrusted_user_id [dict get $logindata user_id]
        set :user_id [ad_conn user_id]
      }
    } else {
      # for now, require for every user authentication
      :log "not authorized 2 uri ${:uri} conn-url [ns_conn url]"
      if {${:uri} ne "xxx/principal/"} {
        ns_returnunauthorized
        return filter_return
      }
    }
  }
  
  :log "--preauth filter_ok - user_id ${:user_id}"
  return filter_ok

• register (scripted, public)

   <instance of xo::ProtocolHandler> register

  Register the NaviServer/AOLserver filter and traces. This method is typically called via *-init.tcl. Note that the specified url must not have an entry in the site-nodes, otherwise the OpenACS request processor performs always the cockie-based authorization. To change that, it would be necessary to register the filter before the request processor (currently, there are no hooks for that).

  Partial Call Graph (max 5 caller/called nodes):

  Testcases:

  No testcase defined.

  set filter_url ${:url}*
  set url ${:url}/*
  set root [string trimright ${:url} /]
  #
  # Methods defined by RFC 2086 (19.6.1 Additional Request Methods):
  #
  #    LINK UNLINK PATCH
  #
  # Methods defined by RFC 2616:
  #
  #    OPTIONS GET HEAD POST PUT DELETE TRACE CONNECT
  #
  # Methods defined by RF C2518:
  #
  #    PROPFIND PROPPATCH MKCOL COPY MOVE LOCK UNLOCK
  #
  # Methods defined by RFC 3253 (versioning extensions):
  #
  #    VERSION-CONTROL REPORT CHECKOUT CHECKIN UNCHECKOUT
  #    MKWORKSPACE UPDATE LABEL MERGE BASELINE-CONTROL
  #    MKACTIVITY
  #
  # Methods defined by RFC 3648 (ordered collections):
  #
  #    ORDERPATCH
  #
  # Methods defined by RFC 3744 (WebDAV):
  #
  #    ACL REPORT
  #
  # Methods defined by RFC 4437 (redirect reference resources):
  #
  #    MKREDIRECTREF UPDATEREDIRECTREF
  #
  # Methods defined by RFC $791 (CalDAV):
  #
  #    MKCALENDAR
  #
  # Methods defined by RFC 4918 (HTTP Extensions):
  #
  #    COPY LOCK MKCOL MOVE PROPFIND PROPPATCH UNLOCK
  #
  # Methods defined by RFC 5323 (WebDAV SEARCH):
  #
  #    SEARCH
  #
  # Methods defined by RFC 5789:
  #
  #    PATCH
  #
  foreach method {
    GET HEAD PUT POST MKCOL COPY MOVE PROPFIND PROPPATCH
    DELETE LOCK UNLOCK OPTIONS
    REPORT
  } {
    ns_register_filter preauth $method $filter_url [self]
    ns_register_filter preauth $method $root       [self]
    ns_register_proc $method $url  [self] handle_request
    ns_register_proc $method $root [self] handle_request
  
    :log "ns_register_filter preauth $method $filter_url  [self]"
    :log "ns_register_filter preauth $method $root  [self]"
    :log "ns_register_proc $method $url [self] handle_request"
    :log "ns_register_proc $method $root [self] handle_request"
  }
  ns_register_proc OPTIONS  / ::xo::minimalProctocolHandler OPTIONS
  ns_register_proc PROPFIND / ::xo::minimalProctocolHandler PROPFIND

• set_user_id (scripted, public)

   <instance of xo::ProtocolHandler> set_user_id

  Set user_id based on authentication header

  Partial Call Graph (max 5 caller/called nodes):

  Testcases:

  No testcase defined.

  :log "[ns_conn method] request comes with headers [ns_set array [ns_conn headers]]"
  set ah [ns_set iget [ns_conn headers] Authorization]
  if {$ah ne ""} {
    #
    # Get credentials from a basic authentication string like
    # "Basic 29234k3j49a".
    #
    set credentials [http_auth::basic_authentication_decode $ah]
    set auth [auth::authenticate  -username [dict get $credentials user]  -authority_id [::auth::get_register_authority]  -password [dict get $credentials password]]
  
    if {[dict get $auth auth_status] ne "ok"} {
      set auth [auth::authenticate  -email [dict get $credentials user]  -password [dict get $credentials password]]
  
      if {[dict get $auth auth_status] ne "ok"} {
        :log "auth status [dict get $auth auth_status]"
        set :user_id 0
        throw {AUTH UNAUTHORIZED {unauthorized}} [dict get $auth auth_status]
      }
    }
    :log "auth_check user_id='[dict get $auth user_id]'"
    ad_conn -set user_id [dict get $auth user_id]
  
  } else {
    # no authenticate header, anonymous visitor
    ad_conn -set user_id 0
    ad_conn -set untrusted_user_id 0
  }
  set :user_id [ad_conn user_id]

• tcl_time_to_http_date (scripted)

  # RFC2518 requires this e.g. for getlastmodified
  if {$datetime eq ""} return ""
  return [:http_date [clock scan [::xo::db::tcl_date $datetime tz]]]

• tcl_time_to_iso8601 (scripted)

  # RFC2518 requires this just for creationdate
  if {$datetime eq ""} return ""
  set tcl_time [::xo::db::tcl_date $datetime tz]
  return [clock format [clock scan $tcl_time] -format "%Y-%m-%dT%H:%M:%SZ" -gmt 1]

• unknown (scripted, private)

   <instance of xo::ProtocolHandler> unknown method args \
      [ args... ]

  Return connection information similar to ad_conn

  Parameters:

  method
  args
  

  Partial Call Graph (max 5 caller/called nodes):

  Testcases:

  No testcase defined.

  :log "--[self class] unknown called with '$method' <$args>"
  switch -- [llength $args] {
    0 {
      if {[info exists :$method]} {
        return ${:method}
      }
      return [ad_conn $method]
    }
    1 {set :method $args}
    default {:log "--[self class] ignoring <$method> <$args>"}
  }

• url (setter)

---