Index: openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl 24 Feb 2005 13:33:24 -0000 1.12
+++ openacs-4/packages/oacs-dav/tcl/oacs-dav-procs.tcl 8 Aug 2006 21:27:07 -0000 1.13
@@ -30,7 +30,7 @@
} {
set encoded_string [ns_urlencode $string]
set encoded_string [string map -nocase \
- {+ %20 %2d - %5f _ %24 $ %2e . %21 ! %28 ( %29 ) %27 ' %2c ,} $encoded_string]
+ {+ %20 %2d - %5f _ %24 $ %2e . %21 ! %28 ( %29 ) %27 ' %2c ,} $encoded_string]
return $encoded_string
}
@@ -54,35 +54,35 @@
# should be something like "Basic 29234k3j49a"
set a [ns_set get [ns_conn headers] Authorization]
if {[string length $a]} {
- ns_log debug "\nTDAV auth_check authentication info $a"
- # get the second bit, the base64 encoded bit
- set up [lindex [split $a " "] 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]
- ns_log debug "\nACS VERSION [ad_acs_version]"
-
-
- ns_log debug "\nTDAV 5.0 authentication"
- array set auth [auth::authenticate \
- -username $user \
- -password $password]
- if {![string equal $auth(auth_status) "ok"]} {
- array set auth [auth::authenticate \
- -email $user \
- -password $password]
- if {![string equal $auth(auth_status) "ok"]} {
- ns_log debug "\nTDAV 5.0 auth status $auth(auth_status)"
- ns_returnunauthorized
- return 0
- }
- }
- ns_log debug "\nTDAV: auth_check openacs 5.0 user_id= $auth(user_id)"
- ad_conn -set user_id $auth(user_id)
+ ns_log debug "\nTDAV auth_check authentication info $a"
+ # get the second bit, the base64 encoded bit
+ set up [lindex [split $a " "] 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]
+ ns_log debug "\nACS VERSION [ad_acs_version]"
+
+
+ ns_log debug "\nTDAV 5.0 authentication"
+ array set auth [auth::authenticate \
+ -username $user \
+ -password $password]
+ if {![string equal $auth(auth_status) "ok"]} {
+ array set auth [auth::authenticate \
+ -email $user \
+ -password $password]
+ if {![string equal $auth(auth_status) "ok"]} {
+ ns_log debug "\nTDAV 5.0 auth status $auth(auth_status)"
+ ns_returnunauthorized
+ return 0
+ }
+ }
+ ns_log debug "\nTDAV: auth_check openacs 5.0 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
+ # no authenticate header, anonymous visitor
+ ad_conn -set user_id 0
ad_conn -set untrusted_user_id 0
}
}
@@ -95,8 +95,8 @@
# Restrict to SSL if required
if { [security::RestrictLoginToSSLP] && ![security::secure_conn_p] } {
- ns_returnunauthorized
- return filter_return
+ ns_returnunauthorized
+ return filter_return
}
# set common data for all requests
@@ -110,85 +110,85 @@
set authorized_p 0
# if item doesn't exist don't bother checking....
if {[empty_string_p $item_id]} {
- if {![string equal "put" $method] && ![string equal "mkcol" $method] && ![string equal "lock" $method]} {
- ns_log debug "\noacs_dav::authorize file not found"
- ns_return 404 text/plain "File Not Found"
- return filter_return
- }
+ if {![string equal "put" $method] && ![string equal "mkcol" $method] && ![string equal "lock" $method]} {
+ ns_log debug "\noacs_dav::authorize file not found"
+ ns_return 404 text/plain "File Not Found"
+ return filter_return
+ }
}
switch $method {
- put -
- mkcol {
- set authorized_p [permission::permission_p \
- -object_id $folder_id \
- -party_id $user_id \
- -privilege "create"]
- }
- delete {
- set authorized_p [permission::permission_p \
- -object_id $item_id \
- -party_id $user_id \
- -privilege "delete"]
- }
- lock {
- if {![empty_string_p $item_id]} {
- set authorized_p [permission::permission_p \
- -object_id $item_id \
- -party_id $user_id \
- -privilege "write"]
- } else {
- # if item does not exist yet check for create on
- # the collection and create a null lock
- set authorized_p [permission::permission_p \
- -object_id $folder_id \
- -party_id $user_id \
- -privilege "create"]
- }
- }
- unlock -
- proppatch {
- set authorized_p [permission::permission_p \
- -object_id $item_id \
- -party_id $user_id \
- -privilege "write"]
- }
- copy -
- move {
- set authorized_p [expr [permission::permission_p \
+ put -
+ mkcol {
+ set authorized_p [permission::permission_p \
+ -object_id $folder_id \
+ -party_id $user_id \
+ -privilege "create"]
+ }
+ delete {
+ set authorized_p [permission::permission_p \
+ -object_id $item_id \
+ -party_id $user_id \
+ -privilege "delete"]
+ }
+ lock {
+ if {![empty_string_p $item_id]} {
+ set authorized_p [permission::permission_p \
+ -object_id $item_id \
+ -party_id $user_id \
+ -privilege "write"]
+ } else {
+ # if item does not exist yet check for create on
+ # the collection and create a null lock
+ set authorized_p [permission::permission_p \
+ -object_id $folder_id \
+ -party_id $user_id \
+ -privilege "create"]
+ }
+ }
+ unlock -
+ proppatch {
+ set authorized_p [permission::permission_p \
+ -object_id $item_id \
+ -party_id $user_id \
+ -privilege "write"]
+ }
+ copy -
+ move {
+ set authorized_p [expr [permission::permission_p \
-object_id $item_id \
-party_id $user_id \
-privilege "read"] \
- && ([permission::permission_p \
- -object_id [oacs_dav::conn dest_parent_id ] \
- -party_id $user_id \
- -privilege "create"] \
- || [permission::perission_p \
- -object_id [oacs_dav::conn dest_parent_id ] \
- -party_id $user_id \
- -privilege "write"])]
- }
- propfind {
- if {!$user_id} {
- ns_returnunauthorized
- } else {
- set authorized_p [permission::permission_p \
- -object_id $item_id \
- -party_id $user_id \
- -privilege "read"]
- }
- }
- head -
- get {
- # default for GET PROPFIND
- set authorized_p [permission::permission_p \
- -object_id $item_id \
- -party_id $user_id \
- -privilege "read"]
- }
+ && [permission::permission_p \
+ -object_id [oacs_dav::conn dest_parent_id ] \
+ -party_id $user_id \
+ -privilege "create"]\
+ || [permission::permission_p \
+ -object_id [oacs_dav::conn dest_parent_id ] \
+ -party_id $user_id \
+ -privilege "write"]]
+ }
+ propfind {
+ if {[empty_string_p $user_id]} {
+ ns_returnunauthorized
+ } else {
+ set authorized_p [permission::permission_p \
+ -object_id $item_id \
+ -party_id $user_id \
+ -privilege "read"]
+ }
+ }
+ head -
+ get {
+ # default for GET PROPFIND
+ set authorized_p [permission::permission_p \
+ -object_id $item_id \
+ -party_id $user_id \
+ -privilege "read"]
+ }
}
if {![string equal $authorized_p 1]} {
- ns_returnunauthorized
- return filter_return
+ ns_returnunauthorized
+ return filter_return
}
return filter_ok
}
@@ -207,18 +207,18 @@
set var [lindex $args 1]
}
switch -- $flag {
- -set {
- set value [lindex $args 2]
- set tdav_conn($var) $value
- return $value
- }
+ -set {
+ set value [lindex $args 2]
+ set tdav_conn($var) $value
+ return $value
+ }
-get {
if { [info exists tdav_conn($var)] } {
return $tdav_conn($var)
- } else {
- return [ad_conn $var]
- }
- }
+ } else {
+ return [ad_conn $var]
+ }
+ }
}
}
@@ -237,10 +237,10 @@
} {
db_transaction {
- db_dml add_folder ""
+ db_dml add_folder ""
} on_error {
- ns_log error "OACS-DAV Failed attempt to add folder_id $folder_id as a WebDAV enabled folder for node_id $node_id. One folder is already registered"
- error "Only one folder per node_id may be registered."
+ ns_log error "OACS-DAV Failed attempt to add folder_id $folder_id as a WebDAV enabled folder for node_id $node_id. One folder is already registered"
+ error "Only one folder per node_id may be registered."
}
}
@@ -269,19 +269,19 @@
set root_folder_id [oacs_dav::request_folder_id $node_id]
set urlv [split [string trimright [string range $uri [string length $sn(url)] end] "/"] "/"]
if {[llength $urlv] >1} {
- set parent_name [join [lrange $urlv 0 [expr [llength $urlv] -2 ] ] "/" ]
+ set parent_name [join [lrange $urlv 0 [expr [llength $urlv] -2 ] ] "/" ]
} else {
- set parent_name "/"
+ set parent_name "/"
}
ns_log debug "\nparent_folder_id urlv $urlv parent_name $parent_name uri $uri"
if {[string equal [string trimright $parent_name "/"] [string trimright $sn(url) "/"]]} {
- # content_item__get_id can't resolve "/"
- # because it strips the leading and trailing /
- # from the url you pass in, and cr_items.name of the folder
- # is not and empty string
- set parent_id $root_folder_id
+ # content_item__get_id can't resolve "/"
+ # because it strips the leading and trailing /
+ # from the url you pass in, and cr_items.name of the folder
+ # is not and empty string
+ set parent_id $root_folder_id
} else {
- set parent_id [db_exec_plsql get_parent_folder_id ""]
+ set parent_id [db_exec_plsql get_parent_folder_id ""]
}
return $parent_id
}
@@ -303,7 +303,7 @@
set dav_url_regexp "^[oacs_dav::uri_prefix]"
regsub $dav_url_regexp $uri {} uri
if {[empty_string_p $uri]} {
- set uri "/"
+ set uri "/"
}
oacs_dav::conn -set uri $uri
set method [ns_conn method]
@@ -325,24 +325,24 @@
oacs_dav::conn -set oacs_destination $dest
if {![empty_string_p $dest]} {
- oacs_dav::conn -set dest_parent_id [oacs_dav::item_parent_folder_id $dest]
+ oacs_dav::conn -set dest_parent_id [oacs_dav::item_parent_folder_id $dest]
}
# we need item_id and content_type
# we should use content::init but that has caching and I don't
# have time to resolve the issues that raises right now
# a full-featured, consistently used tcl api for CR will fix that
if {[llength $urlv] > 2} {
- set parent_url [join [lrange $urlv 0 [expr [llength $urlv] -2 ] ] "/" ]
+ set parent_url [join [lrange $urlv 0 [expr [llength $urlv] -2 ] ] "/" ]
} else {
- set parent_url "/"
+ set parent_url "/"
}
ns_log debug "\noacs_dav::conn_setup: handle request parent_url $parent_url length urlv [llength $urlv] urlv $urlv"
set item_name [lindex $urlv end]
if {[empty_string_p $item_name]} {
- # for propget etc we need the name of the folder
- # the last element in urlv for a folder is an empty string
- set item_name [lindex [split [string trimleft $parent_url "/"] "/"] end]
+ # for propget etc we need the name of the folder
+ # the last element in urlv for a folder is an empty string
+ set item_name [lindex [split [string trimleft $parent_url "/"] "/"] end]
}
oacs_dav::conn -set item_name $item_name
ns_log debug "\noacs_dav::conn_setup: handle request parent_url $parent_url length urlv [llength $urlv] urlv $urlv item_name $item_name"
@@ -351,7 +351,7 @@
set item_id [oacs_dav::conn -set item_id [db_exec_plsql get_item_id ""]]
ns_log debug "\noacs_dav::conn_setup: uri $uri parent_url $parent_url folder_id $folder_id"
if {[string equal [string trimright $uri "/"] [string trimright $sn(url) "/"]]} {
- set item_id [oacs_dav::conn -set item_id $folder_id]
+ set item_id [oacs_dav::conn -set item_id $folder_id]
}
ns_log debug "\noacs_dav::conn_setup: item_id $item_id"
@@ -392,58 +392,58 @@
ns_log debug "\noacs_dav::handle_request item_id is $item_id"
if {[empty_string_p $item_id]} {
- ns_log debug "\noacs_dav::handle_request item_id is empty"
- # set this to null if nothing exists, only valid on PUT or MKCOL
- # to create a new item, otherwise we bail
- # item for URI does not exist
- # ask package what content type to use
- switch -- $method {
- mkcol {
- if {![acs_sc_binding_exists_p dav_mkcol_type $package_key]} {
- set content_type "content_folder"
- } else {
- set content_type [acs_sc_call dav_mkcol_type get_type "" $package_key]
- }
- }
- put {
- if {![acs_sc_binding_exists_p dav_put_type $package_key]} {
- set content_type "content_revision"
- } else {
- set content_type [acs_sc_call dav_put_type get_type "" $package_key]
- }
+ ns_log debug "\noacs_dav::handle_request item_id is empty"
+ # set this to null if nothing exists, only valid on PUT or MKCOL
+ # to create a new item, otherwise we bail
+ # item for URI does not exist
+ # ask package what content type to use
+ switch -- $method {
+ mkcol {
+ if {![acs_sc_binding_exists_p dav_mkcol_type $package_key]} {
+ set content_type "content_folder"
+ } else {
+ set content_type [acs_sc_call dav_mkcol_type get_type "" $package_key]
+ }
+ }
+ put {
+ if {![acs_sc_binding_exists_p dav_put_type $package_key]} {
+ set content_type "content_revision"
+ } else {
+ set content_type [acs_sc_call dav_put_type get_type "" $package_key]
+ }
- }
- lock {
- # asssume resource on NULL LOCK
- set content_type "content_revision"
- }
- default {
- # return a 404 or other error
- ns_log debug "\noacs_dav::handle_request: 404 handle request Item not found method $method URI $uri"
- ns_return 404 text/html "File Not Found"
- return
- }
- }
+ }
+ lock {
+ # asssume resource on NULL LOCK
+ set content_type "content_revision"
+ }
+ default {
+ # return a 404 or other error
+ ns_log debug "\noacs_dav::handle_request: 404 handle request Item not found method $method URI $uri"
+ ns_return 404 text/html "File Not Found"
+ return
+ }
+ }
} else {
- # get content type of existing item
- set content_type \
- [oacs_dav::conn -set content_type \
- [db_string get_content_type "" -default "content_revision"]]
+ # get content type of existing item
+ set content_type \
+ [oacs_dav::conn -set content_type \
+ [db_string get_content_type "" -default "content_revision"]]
}
# use content type
# i think we should walk up the object type hierarchy up to
# content_revision if we don't find an implementation
# implementation name is content_type
if {![acs_sc_binding_exists_p dav $content_type]} {
- # go up content_type hierarchy
- # we do the query here to avoid running the query
- # when the implementation for the content_type does
- # exist
+ # go up content_type hierarchy
+ # we do the query here to avoid running the query
+ # when the implementation for the content_type does
+ # exist
- #FIXME: write the query etc
- set content_type "content_revision"
+ #FIXME: write the query etc
+ set content_type "content_revision"
}
oacs_dav::conn -set content_type $content_type
@@ -459,9 +459,9 @@
ns_log debug "\nDAV: response is \"$response\""
if {![string equal -nocase "get" $method]
- && ![string equal -nocase "head" $method]} {
+ && ![string equal -nocase "head" $method]} {
- tdav::respond $response
+ tdav::respond $response
}
}
@@ -523,24 +523,24 @@
set fname [oacs_dav::conn item_name]
set parent_id [oacs_dav::item_parent_folder_id $uri]
if {[empty_string_p $parent_id]} {
- return [list 409]
+ return [list 409]
}
if { ![empty_string_p $item_id]} {
- return [list 405]
+ return [list 405]
}
# probably have to revisit setting content_types allowed
# and permissions, but inheriting from the parent seems
# reasonable
db_transaction {
- set new_folder_name $fname
- set label $fname
- set description $fname
- set new_folder_id [db_exec_plsql create_folder ""]
- set response [list 201]
+ set new_folder_name $fname
+ set label $fname
+ set description $fname
+ set new_folder_id [db_exec_plsql create_folder ""]
+ set response [list 201]
} on_error {
- set response [list 500]
+ set response [list 500]
}
return $response
@@ -564,49 +564,49 @@
# when depth is 1 copy contents
ns_log debug "\nDAV Folder Copy dest $target_uri parent_id $new_parent_folder_id"
if {[empty_string_p $new_parent_folder_id]} {
- return [list 409]
+ return [list 409]
}
set dest_item_id [db_string get_dest_id "" -default ""]
if {![empty_string_p $dest_item_id]} {
- ns_log debug "\n ----- \n DAV Folder Copy Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n"
- if {![string equal -nocase $overwrite "T"]} {
- return [list 412]
- } elseif {![permission::permission_p \
- -object_id $dest_item_id \
- -party_id $user_id \
- -privilege "write"]} {
- ns_returnunauthorized
- }
- # according to the spec copy with overwrite means
+ ns_log debug "\n ----- \n DAV Folder Copy Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n"
+ if {![string equal -nocase $overwrite "T"]} {
+ return [list 412]
+ } elseif {![permission::permission_p \
+ -object_id $dest_item_id \
+ -party_id $user_id \
+ -privilege "write"]} {
+ ns_returnunauthorized
+ }
+ # according to the spec copy with overwrite means
# delete then copy
- set children_permission_p [oacs_dav::children_have_permission_p -item_id $copy_folder_id -user_id $user_id -privilege "delete"]
- if {!$children_permission_p} {
- return [list 409]
- }
- if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
- return [list 423]
- }
+ set children_permission_p [oacs_dav::children_have_permission_p -item_id $copy_folder_id -user_id $user_id -privilege "delete"]
+ if {!$children_permission_p} {
+ return [list 409]
+ }
+ if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
+ return [list 423]
+ }
db_exec_plsql delete_for_copy ""
- set response [list 204]
- ns_log debug "\n ----- \n CONTENT_FOLDER::COPY OVERWRITING RETURNING 204 \n ----- \n"
+ set response [list 204]
+ ns_log debug "\n ----- \n CONTENT_FOLDER::COPY OVERWRITING RETURNING 204 \n ----- \n"
} else {
- set response [list 201]
+ set response [list 201]
}
set err_p 0
db_transaction {
- db_exec_plsql copy_folder ""
- # we need to do this because in oracle content_folder__copy
- # is a procedure and does not return the new folder_id
- set new_folder_id [db_string get_new_folder_id ""]
- # update all child items revisions to live revision
- db_dml update_child_revisions ""
+ db_exec_plsql copy_folder ""
+ # we need to do this because in oracle content_folder__copy
+ # is a procedure and does not return the new folder_id
+ set new_folder_id [db_string get_new_folder_id ""]
+ # update all child items revisions to live revision
+ db_dml update_child_revisions ""
} on_error {
- set err_p 1
+ set err_p 1
}
if { $err_p } {
- return [list 500]
+ return [list 500]
}
tdav::copy_props $uri $target_uri
@@ -630,70 +630,70 @@
set overwrite [oacs_dav::conn overwrite]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- return [list 423]
+ return [list 423]
}
if {[empty_string_p $new_parent_folder_id]} {
set response [list 412]
- return $response
+ return $response
}
set dest_item_id [db_string get_dest_id "" -default ""]
ns_log debug "\n@DAV@@ folder move new_name $new_name dest_id $dest_item_id new_folder_id $new_parent_folder_id \n"
if {![empty_string_p $dest_item_id]} {
- if {![string equal -nocase $overwrite "T"]} {
- return [list 412]
- } elseif {![permission::permission_p \
- -object_id $dest_item_id \
- -party_id $user_id \
- -privilege "write"]} {
- ns_returnunauthorized
- }
- # according to the spec move with overwrite means
+ if {![string equal -nocase $overwrite "T"]} {
+ return [list 412]
+ } elseif {![permission::permission_p \
+ -object_id $dest_item_id \
+ -party_id $user_id \
+ -privilege "write"]} {
+ ns_returnunauthorized
+ }
+ # according to the spec move with overwrite means
# delete then move
- if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
- return [list 423]
- }
- # TODO check if we have permission over everything inside
- set children_permission_p [oacs_dav::children_have_permission_p -item_id $move_folder_id -user_id $user_id -privilege "delete"]
- if {!$children_permission_p} {
- return [list 409]
- }
+ if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
+ return [list 423]
+ }
+ # TODO check if we have permission over everything inside
+ set children_permission_p [oacs_dav::children_have_permission_p -item_id $move_folder_id -user_id $user_id -privilege "delete"]
+ if {!$children_permission_p} {
+ return [list 409]
+ }
db_exec_plsql delete_for_move ""
- set response [list 204]
- ns_log debug "\n ----- \n CONTENT_FOLDER::MOVE OVERWRITING RETURNING 204 \n ----- \n"
+ set response [list 204]
+ ns_log debug "\n ----- \n CONTENT_FOLDER::MOVE OVERWRITING RETURNING 204 \n ----- \n"
} else {
- set response [list 201]
+ set response [list 201]
}
# don't let anyone move root DAV folders in the
# dav_site_node_folder_map
if {![string equal [db_string site_node_folder ""] 0]} {
- return [list 403]
+ return [list 403]
}
set err_p 0
db_transaction {
- if {![string equal $cur_parent_folder_id $new_parent_folder_id]} {
- ns_log debug "\n@@DAV@@ move folder $move_folder_id"
- db_exec_plsql move_folder ""
- # change label if name is different
- if {![string equal $new_name $item_name]} {
- db_dml update_label ""
- }
- } elseif {![empty_string_p $new_name]} {
- ns_log debug "\n@@DAV@@ move folder rename $move_folder_id to $new_name"
- db_exec_plsql rename_folder ""
- }
-
+ if {![string equal $cur_parent_folder_id $new_parent_folder_id]} {
+ ns_log debug "\n@@DAV@@ move folder $move_folder_id"
+ db_exec_plsql move_folder ""
+ # change label if name is different
+ if {![string equal $new_name $item_name]} {
+ db_dml update_label ""
+ }
+ } elseif {![empty_string_p $new_name]} {
+ ns_log debug "\n@@DAV@@ move folder rename $move_folder_id to $new_name"
+ db_exec_plsql rename_folder ""
+ }
+
} on_error {
- set err_p 1
+ set err_p 1
}
if { $err_p } {
- return [list 500]
+ return [list 500]
}
tdav::copy_props $uri $target_uri
@@ -712,20 +712,20 @@
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- return [list 423]
+ return [list 423]
}
set children_permission_p [oacs_dav::children_have_permission_p -item_id $item_id -user_id $user_id -privilege "delete"]
- if {!$children_permission_p} {
- return [list 403]
- }
+ if {!$children_permission_p} {
+ return [list 403]
+ }
if {[catch {db_exec_plsql delete_folder ""} errmsg]} {
- ns_log error "content_folder::delete $errmsg"
- set response [list 500]
-# ns_log debug "\nCONTEXT IDS [db_list get_ids "select object_id from acs_objects where context_id=:item_id"]"
+ ns_log error "content_folder::delete $errmsg"
+ set response [list 500]
+# ns_log debug "\nCONTEXT IDS [db_list get_ids "select object_id from acs_objects where context_id=:item_id"]"
} else {
- set response [list 204]
- tdav::delete_props $uri
- tdav::remove_lock $uri
+ set response [list 204]
+ tdav::delete_props $uri
+ tdav::remove_lock $uri
}
return $response
@@ -738,7 +738,7 @@
set depth [oacs_dav::conn depth]
set encoded_uri [list]
foreach fragment [split [ad_conn url] "/"] {
- lappend encoded_uri [oacs_dav::urlencode $fragment]
+ lappend encoded_uri [oacs_dav::urlencode $fragment]
}
set folder_uri "[ad_conn location][join $encoded_uri "/"]"
@@ -750,7 +750,7 @@
# get confused and show the collection as a member of itself
regsub {/$} $folder_uri {} folder_uri
if {[empty_string_p $depth]} {
- set depth 0
+ set depth 0
}
set prop_req [oacs_dav::conn prop_req]
@@ -762,43 +762,43 @@
# until we stop supporting oracle 8i
set os_time_zone [clock format [clock seconds] -format %Z]
db_foreach get_properties "" {
- set name $name
- set etag "1f9a-400-3948d0f5"
- set properties [list]
- # is "D" the namespace??
- lappend properties [list "D" "getcontentlength"] $content_length
+ set name $name
+ set etag "1f9a-400-3948d0f5"
+ set properties [list]
+ # is "D" the namespace??
+ lappend properties [list "D" "getcontentlength"] $content_length
-# ns_log debug "\nDAVEB item_id $item_id folder_id $folder_id $item_uri"
- if {$item_id == $folder_id} {
- set item_uri "/"
- } else {
- set encoded_uri [list]
- foreach fragment [split $item_uri "/"] {
- lappend encoded_uri [oacs_dav::urlencode $fragment]
-# ns_log debug "\npropfind: fragment \"$fragment\" encoded_uri \"$encoded_uri\" "
- }
- set item_uri "/[join $encoded_uri "/"]"
-
- }
-
- lappend properties [list "D" "getcontenttype"] $mime_type
- # where do we get an etag from?
- lappend properties [list "D" "getetag"] $etag
- lappend properties [list "D" "getlastmodified"] $last_modified
- lappend properties [list "D" "creationdate"] $creation_date
- if {$collection_p} {
- lappend properties [list "D" "resourcetype"] "D:collection"
- } else {
- lappend properties [list "D" "resourcetype"] ""
- }
+# ns_log debug "\nDAVEB item_id $item_id folder_id $folder_id $item_uri"
+ if {$item_id == $folder_id} {
+ set item_uri "/"
+ } else {
+ set encoded_uri [list]
+ foreach fragment [split $item_uri "/"] {
+ lappend encoded_uri [oacs_dav::urlencode $fragment]
+# ns_log debug "\npropfind: fragment \"$fragment\" encoded_uri \"$encoded_uri\" "
+ }
+ set item_uri "/[join $encoded_uri "/"]"
+
+ }
+
+ lappend properties [list "D" "getcontenttype"] $mime_type
+ # where do we get an etag from?
+ lappend properties [list "D" "getetag"] $etag
+ lappend properties [list "D" "getlastmodified"] $last_modified
+ lappend properties [list "D" "creationdate"] $creation_date
+ if {$collection_p} {
+ lappend properties [list "D" "resourcetype"] "D:collection"
+ } else {
+ lappend properties [list "D" "resourcetype"] ""
+ }
- # according to Todd's example
- # resourcetype for a folder(collection) is
- # and getcontenttype is */*
- foreach i [tdav::get_user_props ${folder_uri}${item_uri} $depth $prop_req] {
- lappend properties $i
- }
- lappend all_properties [list ${folder_uri}${item_uri} $collection_p $properties]
+ # according to Todd's example
+ # resourcetype for a folder(collection) is
+ # and getcontenttype is */*
+ foreach i [tdav::get_user_props ${folder_uri}${item_uri} $depth $prop_req] {
+ lappend properties $i
+ }
+ lappend all_properties [list ${folder_uri}${item_uri} $collection_p $properties]
}
set response [list 207 $all_properties]
@@ -817,7 +817,7 @@
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- return [list 423]
+ return [list 423]
}
set response [tdav::update_user_props $uri [oacs_dav::conn prop_req]]
@@ -833,18 +833,18 @@
set type [oacs_dav::conn lock_type]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- set ret_code 423
-
- set response [list $ret_code]
+ set ret_code 423
+
+ set response [list $ret_code]
} else {
- set depth [tdav::conn depth]
- set timeout [tdav::conn lock_timeout]
- if {[empty_string_p $timeout]} {
- set timeout [parameter::get_from_package_key -parameter "DefaultLockTimeout" -package_key "oacs-dav" -default "300"]
- }
- set token [tdav::set_lock $uri $depth $type $scope $owner $timeout]
- set ret_code 200
- set response [list $ret_code [list depth $depth token $token timeout $timeout owner $owner scope $scope type $type]]
+ set depth [tdav::conn depth]
+ set timeout [tdav::conn lock_timeout]
+ if {[empty_string_p $timeout]} {
+ set timeout [parameter::get_from_package_key -parameter "DefaultLockTimeout" -package_key "oacs-dav" -default "300"]
+ }
+ set token [tdav::set_lock $uri $depth $type $scope $owner $timeout]
+ set ret_code 200
+ set response [list $ret_code [list depth $depth token $token timeout $timeout owner $owner scope $scope type $type]]
}
return $response
}
@@ -855,13 +855,13 @@
set uri [oacs_dav::conn uri]
if {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} {
- set ret_code 423
- set body "Resource is locked."
+ set ret_code 423
+ set body "Resource is locked."
} else {
- ns_log debug "\ntdav::check_lock_for_unlock = [tdav::check_lock_for_unlock $uri]]"
- tdav::remove_lock $uri
- set ret_code 204
- set body ""
+ ns_log debug "\ntdav::check_lock_for_unlock = [tdav::check_lock_for_unlock $uri]]"
+ tdav::remove_lock $uri
+ set ret_code 204
+ set body ""
}
return [list $ret_code $body]
@@ -909,7 +909,7 @@
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- return [list 423]
+ return [list 423]
}
set tmp_filename [oacs_dav::conn tmpfile]
@@ -924,45 +924,45 @@
set name [oacs_dav::conn item_name]
set parent_id [oacs_dav::item_parent_folder_id $uri]
if {[empty_string_p $parent_id]} {
- set response [list 409]
- return $response
+ set response [list 409]
+ return $response
}
# create new item if necessary
db_transaction {
set mime_type [cr_filename_to_mime_type $name]
- if {[empty_string_p $item_id]} {
- # this won't really work very nicely if we support
- # abstract url type names... maybe chop off the extension
- # when we name the object?
+ if {[empty_string_p $item_id]} {
+ # this won't really work very nicely if we support
+ # abstract url type names... maybe chop off the extension
+ # when we name the object?
- set revision_id [cr_import_content \
- -storage_type file \
- $parent_id \
- $tmp_filename \
- $tmp_size \
- $mime_type \
- $name]
+ set revision_id [cr_import_content \
+ -storage_type file \
+ $parent_id \
+ $tmp_filename \
+ $tmp_size \
+ $mime_type \
+ $name]
- if {[file exists [tdav::get_lock_file $uri]]} {
- # if there is a null lock use 204
- set response [list 204]
- } else {
- set response [list 201]
- }
+ if {[file exists [tdav::get_lock_file $uri]]} {
+ # if there is a null lock use 204
+ set response [list 204]
+ } else {
+ set response [list 201]
+ }
- } else {
- set revision_id [cr_import_content \
- -item_id $item_id \
- -storage_type file \
- $parent_id \
- $tmp_filename \
- $tmp_size \
- $mime_type \
- $name]
+ } else {
+ set revision_id [cr_import_content \
+ -item_id $item_id \
+ -storage_type file \
+ $parent_id \
+ $tmp_filename \
+ $tmp_size \
+ $mime_type \
+ $name]
set response [list 204]
- }
- db_dml set_live_revision ""
+ }
+ db_dml set_live_revision ""
} on_error {
set response [list 500]
@@ -1002,9 +1002,9 @@
lappend properties [list "D" "creationdate"] $creation_date
lappend properties [list "D" "resourcetype"] ""
- foreach i [tdav::get_user_props ${uri} $depth $prop_req] {
- lappend properties $i
- }
+ foreach i [tdav::get_user_props ${uri} $depth $prop_req] {
+ lappend properties $i
+ }
set response [list 207 [list [list $uri "" $properties]]]
@@ -1022,7 +1022,7 @@
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- return [list 423]
+ return [list 423]
}
# set the values
@@ -1041,14 +1041,14 @@
set item_id [oacs_dav::conn item_id]
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- return [list 423]
+ return [list 423]
}
if {[catch {db_exec_plsql delete_item ""} errmsg]} {
- set response [list 500]
+ set response [list 500]
} else {
- set response [list 204]
- tdav::delete_props $uri
- tdav::remove_lock $uri
+ set response [list 204]
+ tdav::delete_props $uri
+ tdav::remove_lock $uri
}
return $response
}
@@ -1069,44 +1069,44 @@
set new_name [lindex $turlv end]
set new_parent_folder_id [oacs_dav::conn dest_parent_id]
if {[empty_string_p $new_parent_folder_id]} {
- return [list 409]
+ return [list 409]
}
set dest_item_id [db_string get_dest_id "" -default ""]
ns_log debug "\nDAV Revision Copy dest $target_uri parent_id $new_parent_folder_id"
if {![empty_string_p $dest_item_id]} {
- ns_log debug "\n ----- \n DAV Revision Copy Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n"
- if {![string equal -nocase $overwrite "T"]} {
- return [list 412]
- } elseif {![permission::permission_p \
- -object_id $dest_item_id \
- -party_id $user_id \
- -privilege "write"]} {
- ns_returnunauthorized
- }
- # according to the spec copy with overwrite means
+ ns_log debug "\n ----- \n DAV Revision Copy Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n"
+ if {![string equal -nocase $overwrite "T"]} {
+ return [list 412]
+ } elseif {![permission::permission_p \
+ -object_id $dest_item_id \
+ -party_id $user_id \
+ -privilege "write"]} {
+ ns_returnunauthorized
+ }
+ # according to the spec copy with overwrite means
# delete then copy
- ns_log debug "\noacs_dav::revision::copy checking for lock on target"
- if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
- return [list 423]
- }
+ ns_log debug "\noacs_dav::revision::copy checking for lock on target"
+ if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
+ return [list 423]
+ }
db_exec_plsql delete_for_copy ""
- set response [list 204]
- ns_log debug "\n ----- \n CONTENT_REVISION::COPY OVERWRITING RETURNING 204 \n ----- \n"
+ set response [list 204]
+ ns_log debug "\n ----- \n CONTENT_REVISION::COPY OVERWRITING RETURNING 204 \n ----- \n"
} else {
- set response [list 201]
+ set response [list 201]
}
set err_p 0
db_transaction {
- set item_id [db_exec_plsql copy_item ""]
- db_dml set_live_revision ""
+ set item_id [db_exec_plsql copy_item ""]
+ db_dml set_live_revision ""
} on_error {
- set err_p 1
+ set err_p 1
}
if { $err_p } {
- return [list 500]
+ return [list 500]
}
tdav::copy_props $uri $target_uri
@@ -1131,52 +1131,52 @@
set new_name [lindex $turlv end]
set overwrite [oacs_dav::conn overwrite]
if {[empty_string_p $new_parent_folder_id]} {
- return [list 409]
+ return [list 409]
}
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- return [list 423]
+ return [list 423]
}
ns_log debug "\nDAV Revision move dest $target_uri parent_id $new_parent_folder_id"
set dest_item_id [db_string get_dest_id "" -default ""]
if {![empty_string_p $dest_item_id]} {
- ns_log debug "\n ----- \n DAV Revision move Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n"
- if {![string equal -nocase $overwrite "T"]} {
- return [list 412]
- } elseif {![permission::permission_p \
- -object_id $dest_item_id \
- -party_id $user_id \
- -privilege "write"]} {
- return [list 401]
- }
- if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
- return [list 423]
- }
+ ns_log debug "\n ----- \n DAV Revision move Folder Exists item_id $dest_item_id overwrite $overwrite \n ----- \n"
+ if {![string equal -nocase $overwrite "T"]} {
+ return [list 412]
+ } elseif {![permission::permission_p \
+ -object_id $dest_item_id \
+ -party_id $user_id \
+ -privilege "write"]} {
+ return [list 401]
+ }
+ if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
+ return [list 423]
+ }
db_exec_plsql delete_for_move ""
- set response [list 204]
- ns_log debug "\n ----- \n CONTENT_REVISION::MOVE OVERWRITING RETURNING 204 \n ----- \n"
+ set response [list 204]
+ ns_log debug "\n ----- \n CONTENT_REVISION::MOVE OVERWRITING RETURNING 204 \n ----- \n"
} else {
- set response [list 201]
+ set response [list 201]
}
set err_p 0
db_transaction {
- if {![string equal $cur_parent_folder_id $new_parent_folder_id]} {
- db_exec_plsql move_item ""
+ if {![string equal $cur_parent_folder_id $new_parent_folder_id]} {
+ db_exec_plsql move_item ""
- } elseif {![empty_string_p $new_name] } {
- db_exec_plsql rename_item ""
- }
+ } elseif {![empty_string_p $new_name] } {
+ db_exec_plsql rename_item ""
+ }
if {![string equal $item_name $new_name]} {
- db_dml update_title ""
+ db_dml update_title ""
}
} on_error {
- set err_p 1
+ set err_p 1
}
if { $err_p } {
- return [list 500]
+ return [list 500]
}
tdav::copy_props $uri $target_uri
@@ -1205,18 +1205,18 @@
set type [oacs_dav::conn lock_type]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
- set ret_code 423
-
- set response [list $ret_code]
+ set ret_code 423
+
+ set response [list $ret_code]
} else {
- set depth [tdav::conn depth]
- set timeout [tdav::conn lock_timeout]
- if {[empty_string_p $timeout]} {
- set timeout 300
- }
- set token [tdav::set_lock $uri $depth $type $scope $owner $timeout]
- set ret_code 200
- set response [list $ret_code [list depth $depth token $token timeout $timeout owner $owner scope $scope type $type]]
+ set depth [tdav::conn depth]
+ set timeout [tdav::conn lock_timeout]
+ if {[empty_string_p $timeout]} {
+ set timeout 300
+ }
+ set token [tdav::set_lock $uri $depth $type $scope $owner $timeout]
+ set ret_code 200
+ set response [list $ret_code [list depth $depth token $token timeout $timeout owner $owner scope $scope type $type]]
}
return $response
}
@@ -1227,13 +1227,13 @@
set uri [oacs_dav::conn uri]
if {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} {
- set ret_code 423
- set body "Resource is locked."
+ set ret_code 423
+ set body "Resource is locked."
} else {
- ns_log debug "\ntdav::check_lock_for_unlock = [tdav::check_lock_for_unlock $uri]]"
- tdav::remove_lock $uri
- set ret_code 204
- set body ""
+ ns_log debug "\ntdav::check_lock_for_unlock = [tdav::check_lock_for_unlock $uri]]"
+ tdav::remove_lock $uri
+ set ret_code 204
+ set body ""
}
return [list $ret_code $body]