Index: openacs-4/packages/xotcl-core/tcl/ical-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/ical-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/xotcl-core/tcl/ical-procs.tcl	10 Jul 2008 22:10:31 -0000	1.6
+++ openacs-4/packages/xotcl-core/tcl/ical-procs.tcl	23 Sep 2008 09:49:40 -0000	1.7
@@ -219,178 +219,11 @@
     return $t
   }
 
-}
-
-namespace eval ::xo {
-  Class create dav -parameter {
+  #
+  # Subclass ::xo::ProtocolHander for dav (as used by ical)
+  #
+  Class create ::xo::dav -superclass ProtocolHandler -parameter {
     {url /webdav}
-    {package}
   }
 
-  dav ad_instproc unknown {method args} {
-    Return dav specific connection info similar to ad_conn
-  } {
-    my log "--dav unknown called with '$method' <$args>"
-    switch [llength $args] {
-      0 {if {[my exists $method]} {return [my set method]}
-        return [ad_conn $method]
-      }
-      1 {my set method $args}
-      default {my log "--dav ignoring <$method> <$args>"}
-    }
-  }
-
-  dav ad_instproc set_user_id {} {
-    Set user_id based on authentication header
-  } {
-    set ah [ns_set get [ns_conn headers] Authorization]
-    if {$ah ne ""} {
-      # should be something like "Basic 29234k3j49a"
-      my debug "auth_check authentication info $ah"
-      # get the second bit, the base64 encoded bit
-      set up [lindex [split $ah " "] 1]
-      # after decoding, it should be user:password; get the username
-      set user [lindex [split [ns_uudecode $up] ":"] 0]
-      set password [lindex [split [ns_uudecode $up] ":"] 1]
-      array set auth [auth::authenticate \
-                          -username $user \
-                          -authority_id [::auth::get_register_authority] \
-                          -password $password]
-      my debug "auth $user $password returned [array get auth]"
-      if {$auth(auth_status) ne "ok"} {
-        array set auth [auth::authenticate \
-                            -email $user \
-                            -password $password]
-        if {$auth(auth_status) ne "ok"} {
-          my debug "auth status $auth(auth_status)"
-          ns_returnunauthorized
-          my set user_id 0
-          return 0
-        }
-      }
-      my debug "auth_check user_id='$auth(user_id)'"
-      ad_conn -set user_id $auth(user_id)
-      
-    } else {
-      # no authenticate header, anonymous visitor
-      ad_conn -set user_id 0
-      ad_conn -set untrusted_user_id 0
-    }
-    my set user_id [ad_conn user_id]
-  }
-
-  dav ad_instproc initialize {} {
-    Setup connection object and authenticate user
-  } {
-    my instvar uri method urlv destination
-    ad_conn -reset
-    set uri [ns_urldecode [ns_conn url]]
-    set dav_url_regexp "^[my url]"
-    regsub $dav_url_regexp $uri {} uri
-    if {$uri eq ""} {
-      set uri "/"
-    }
-    my set_user_id
-
-    set method [string toupper [ns_conn method]]
-    #my log "--dav conn_setup: uri '$uri' method $method"
-    set urlv [split [string trimright $uri "/"] "/"]
-    set destination [ns_urldecode [ns_set iget [ns_conn headers] Destination]]
-    regsub {https?://[^/]+/} $destination {/} dest
-    regsub $dav_url_regexp $dest {} destination
-    #my log "--dav conn_setup: destination = $destination"
-  }
-
-  dav ad_instproc preauth { args } {
-    Check if user_id has permission to perform the WebDAV method on
-    the URI
-  } {
-    #my log "--dav preauth args=<$args>"
-    my instvar user_id 
-    
-    # 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 
-    my initialize
-
-    # for now, require for every user authentification
-    if {$user_id == 0} {
-      ns_returnunauthorized
-      return filter_return
-    }
-    
-    #my log "--dav preauth filter_ok"
-    return filter_ok    
-  }
-
-  dav ad_instproc register { } {
-    Register the the aolserver filter and traces.
-    This method is typically called via *-init.tcl.
-  } {
-    set filter_url [my url]*
-    set url [my url]/*
-    foreach method {
-      GET HEAD PUT POST MKCOL COPY MOVE PROPFIND PROPPATCH
-      DELETE LOCK UNLOCK
-    } {
-      ns_register_filter preauth $method $filter_url  [self]
-      ns_register_proc $method $url [self] handle_request
-      #my log "--dav ns_register_filter preauth $method $filter_url  [self]"
-      #my log "--dav ns_register_proc $method $url [self] handle_request"
-    }
-  }
-
-  dav instproc GET {} {
-    my instvar uri
-    my log "--dav handle_request GET method"
-    #set with_recurrences [ns_queryget with_recurrences 1]
-    # ...
-    ns_return 200 text/plain GET-$uri
-  }
-  dav instproc PUT {} {
-    my log "--dav handle_request PUT method [ns_conn content]"
-    #set calendar_id_list [ns_queryget calendar_id_list 0]
-    #if {[llength $write_calendar_ids] == 0} {
-    #ns_return 403 text/plain "no permissions to write to calendar"
-    #} else {
-    ns_return 201 text/plain "0 items processed"
-    #}
-  }
-  dav instproc PROPFIND {} {
-    my log "--dav PROPFIND [ns_conn content]"
-    ns_return 204 text/xml {<?xml version="1.0" encoding="utf-8" ?>}
-  }
-
-  dav ad_instproc get_package_id {} {
-    initialize the given package 
-    @return package_id 
-  } {
-    my instvar uri package
-    $package initialize -url $uri
-    #my log "--dav [my package] initialize -url $uri"
-    return $package_id
-  }
-
-  dav ad_instproc handle_request { args } {
-    Process the incoming web-dav request. This method
-    could be overloaded by the application and
-    dispatches the HTTP requests.
-  } {
-    my instvar uri method user_id
-  
-    #my log "--dav handle_request method=$method uri=$uri\
-    #	userid=$user_id -ns_conn query '[ns_conn query]'"
-    if {[my exists package]} {
-      my get_package_id
-    }
-    if {[my procsearch $method] ne ""} {
-      my $method
-    } else {
-      ns_return 404 text/plain "not implemented"
-    }
-  }
 }