Skip to content

O
oacs-dav
Commit c252259f authored by Frank Bergmann's avatar Frank Bergmann
Browse files
Options

- OpenACS 5.9

parent 0eb9bbb1
Hide whitespace changes
Inline Side-by-side
Showing with 143 additions and 142 deletions
oacs-dav.info
View file @ c252259f
......@@ -8,14 +8,16 @@
<singleton-p>t</singleton-p>
<auto-mount>webdav-support</auto-mount>
<version name="1.2.0" url="http://openacs.org/repository/download/apm/oacs-dav-1.2.0.apm">
<version name="1.2.0d3" url="http://openacs.org/repository/download/apm/oacs-dav-1.2.0d3.apm">
<owner url="mailto:dave@thedesignexperience.org">Dave Bauer</owner>
<summary>Provides services to enable webDAV access to content repository items.</summary>
<release-date>2004-09-27</release-date>
<release-date>2013-09-08</release-date>
<vendor>OpenACS</vendor>
<maturity>1</maturity>
<description format="text/html">An interface to the tDAV webDAV package. oacs-dav provides services to offer webDAV access to content repository data.</description>
<provides url="oacs-dav" version="1.2.0"/>
<provides url="oacs-dav" version="1.2.0d3"/>
<requires url="acs-kernel" version="5.8.1"/>
<callbacks>
<callback type="after-install" proc="oacs_dav::install::package_install"/>
......
tcl/oacs-dav-procs.tcl
View file @ c252259f
......@@ -72,19 +72,19 @@ ad_proc oacs_dav::set_user_id {} {
-password $password \
-authority_id $authority_id \
-no_cookie]
if {![string equal $auth(auth_status) "ok"]} {
if {$auth(auth_status) ne "ok" } {
array set auth [auth::authenticate \
-email $user \
-password $password \
-authority_id $authority_id \
-no_cookie]
}
if {[string equal $auth(auth_status) "ok"]} {
if {$auth(auth_status) eq "ok"} {
# we can stop checking
break
}
}
if {![string equal $auth(auth_status) "ok"]} {
if {$auth(auth_status) ne "ok" } {
ns_log debug "\nTDAV 5.0 auth status $auth(auth_status)"
ns_returnunauthorized
return 0
......@@ -121,8 +121,8 @@ ad_proc oacs_dav::authorize { args } {
ns_log debug "\nOACS-DAV oacs_dav::authorize user_id $user_id method $method item_id $item_id"
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]} {
if {$item_id eq ""} {
if {"put" ne $method && "mkcol" ne $method && "lock" ne $method } {
ns_log debug "\noacs_dav::authorize file not found"
ns_return 404 text/plain "File Not Found"
return filter_return
......@@ -143,7 +143,7 @@ ad_proc oacs_dav::authorize { args } {
-privilege "delete"]
}
lock {
if {![empty_string_p $item_id]} {
if {$item_id ne ""} {
set authorized_p [permission::permission_p \
-object_id $item_id \
-party_id $user_id \
......@@ -180,7 +180,7 @@ ad_proc oacs_dav::authorize { args } {
-privilege "write"]]
}
propfind {
if {[empty_string_p $user_id]} {
if {$user_id eq ""} {
ns_returnunauthorized
} else {
set authorized_p [permission::permission_p \
......@@ -198,7 +198,7 @@ ad_proc oacs_dav::authorize { args } {
-privilege "read"]
}
}
if {![string equal $authorized_p 1]} {
if {$authorized_p ne "1" } {
ns_returnunauthorized
return filter_return
}
......@@ -212,7 +212,7 @@ ad_proc -public oacs_dav::conn {
} {
global tdav_conn
set flag [lindex $args 0]
if { [string index $flag 0] != "-" } {
if { [string index $flag 0] ne "-" } {
set var $flag
set flag "-get"
} else {
......@@ -273,7 +273,7 @@ ad_proc -public oacs_dav::item_parent_folder_id {
get the folder_id of the parent of an item
from the uri
@param uri
@returns parent_folder_id or empty string if folder does not exist
@return parent_folder_id or empty string if folder does not exist
} {
array set sn [oacs_dav::request_site_node $uri]
......@@ -281,12 +281,12 @@ ad_proc -public oacs_dav::item_parent_folder_id {
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 [llength $urlv]-2] "/" ]
} else {
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) "/"]]} {
if {[string trimright $parent_name "/"] eq [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
......@@ -314,7 +314,7 @@ ad_proc -public oacs_dav::conn_setup {} {
ns_log debug "\nconn_setp uri \"$uri\" "
set dav_url_regexp "^[oacs_dav::uri_prefix]"
regsub $dav_url_regexp $uri {} uri
if {[empty_string_p $uri]} {
if {$uri eq ""} {
set uri "/"
}
oacs_dav::conn -set uri $uri
......@@ -336,7 +336,7 @@ ad_proc -public oacs_dav::conn_setup {} {
oacs_dav::conn -set oacs_destination $dest
if {![empty_string_p $dest]} {
if {$dest ne ""} {
oacs_dav::conn -set dest_parent_id [oacs_dav::item_parent_folder_id $dest]
}
......@@ -345,13 +345,13 @@ ad_proc -public oacs_dav::conn_setup {} {
# 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 [llength $urlv]-2] "/" ]
} else {
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]} {
if {$item_name eq ""} {
# 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]
......@@ -362,7 +362,7 @@ ad_proc -public oacs_dav::conn_setup {} {
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) "/"]]} {
if {[string trimright $uri "/"] eq [string trimright $sn(url) "/"]} {
set item_id [oacs_dav::conn -set item_id $folder_id]
}
......@@ -385,8 +385,8 @@ ad_proc -public oacs_dav::children_have_permission_p {
ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n child_count = $child_count \n ----- \n"
incr child_count [db_string revision_perms ""]
ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n child_count = $child_count \n ----- \n"
ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n return [expr $child_count == 0] \n ----- \n"
return [expr $child_count == 0]
ns_log notice "\n ----- \n oacs_dav::children_have_permission_p \n return [expr {$child_count == 0}] \n ----- \n"
return [expr {$child_count == 0}]
}
ad_proc -public oacs_dav::handle_request { uri method args } {
......@@ -403,7 +403,7 @@ ad_proc -public oacs_dav::handle_request { uri method args } {
set package_key [apm_package_key_from_id $package_id]
ns_log debug "\noacs_dav::handle_request item_id is $item_id"
if {[empty_string_p $item_id]} {
if {$item_id eq ""} {
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
......@@ -414,14 +414,14 @@ ad_proc -public oacs_dav::handle_request { uri method args } {
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]
set content_type [acs_sc::invoke -contract dav_mkcol_type -operation get_type -call_args "" -impl $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]
set content_type [acs_sc::invoke -contract dav_put_type -operation get_type -call_args "" -impl $package_key]
}
}
......@@ -467,7 +467,7 @@ ad_proc -public oacs_dav::handle_request { uri method args } {
ns_log debug "\noacs_dav::handle_request method $method uri $uri item_id $item_id folder_id $folder_id package_id $package_id node_id $node_id content_type $content_type args $args"
set response [acs_sc_call dav $method "" $content_type]
set response [acs_sc::invoke -contract dav -operation $method -call_args "" -impl $content_type]
# here the sc impl might return us some data,
# then we would probably have to send that to tDAV for processing
......@@ -494,7 +494,7 @@ ad_proc -public oacs_dav::request_site_node { uri } {
ad_proc -public oacs_dav::request_folder_id { node_id } {
resolves a node_id to a DAV enabled folder_id
@param node_id site node_id of request
@returns folder_id, or empty string if no folder exists
@return folder_id, or empty string if no folder exists
in dav_package_folder_map for this node_id
} {
return [db_string get_folder_id "" -default ""]
......@@ -537,10 +537,10 @@ ad_proc oacs_dav::impl::content_folder::mkcol {} {
set item_id [oacs_dav::conn item_id]
set fname [oacs_dav::conn item_name]
set parent_id [oacs_dav::item_parent_folder_id $uri]
if {[empty_string_p $parent_id]} {
if {$parent_id eq ""} {
return [list 409]
}
if { ![empty_string_p $item_id]} {
if { $item_id ne ""} {
return [list 405]
}
......@@ -578,12 +578,12 @@ ad_proc oacs_dav::impl::content_folder::copy {} {
# when depth is 0 copy just the folder
# 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]} {
if {$new_parent_folder_id eq ""} {
return [list 409]
}
set dest_item_id [db_string get_dest_id "" -default ""]
if {![empty_string_p $dest_item_id]} {
if {$dest_item_id ne ""} {
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]
......@@ -599,7 +599,7 @@ ad_proc oacs_dav::impl::content_folder::copy {} {
if {!$children_permission_p} {
return [list 409]
}
if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
if {"unlocked" ne [tdav::check_lock $target_uri] } {
return [list 423]
}
db_exec_plsql delete_for_copy ""
......@@ -644,11 +644,11 @@ ad_proc oacs_dav::impl::content_folder::move {} {
set new_name [lindex $turlv end]
set overwrite [oacs_dav::conn overwrite]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
return [list 423]
}
if {[empty_string_p $new_parent_folder_id]} {
if {$new_parent_folder_id eq ""} {
set response [list 412]
return $response
}
......@@ -656,7 +656,7 @@ ad_proc oacs_dav::impl::content_folder::move {} {
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 {$dest_item_id ne ""} {
if {![string equal -nocase $overwrite "T"]} {
return [list 412]
......@@ -668,7 +668,7 @@ ad_proc oacs_dav::impl::content_folder::move {} {
}
# according to the spec move with overwrite means
# delete then move
if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
if {"unlocked" ne [tdav::check_lock $target_uri] } {
return [list 423]
}
# TODO check if we have permission over everything inside
......@@ -685,20 +685,20 @@ ad_proc oacs_dav::impl::content_folder::move {} {
# don't let anyone move root DAV folders in the
# dav_site_node_folder_map
if {![string equal [db_string site_node_folder ""] 0]} {
if {[db_string site_node_folder ""] ne "0" } {
return [list 403]
}
set err_p 0
db_transaction {
if {![string equal $cur_parent_folder_id $new_parent_folder_id]} {
if {$cur_parent_folder_id ne $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]} {
if {$new_name ne $item_name } {
db_dml update_label ""
}
} elseif {![empty_string_p $new_name]} {
} elseif {$new_name ne ""} {
ns_log debug "\n@@DAV@@ move folder rename $move_folder_id to $new_name"
db_exec_plsql rename_folder ""
}
......@@ -726,7 +726,7 @@ ad_proc oacs_dav::impl::content_folder::delete {} {
set item_id [oacs_dav::conn item_id]
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
return [list 423]
}
set children_permission_p [oacs_dav::children_have_permission_p -item_id $item_id -user_id $user_id -privilege "delete"]
......@@ -764,7 +764,7 @@ ad_proc oacs_dav::impl::content_folder::propfind {} {
# with a trailing slash, sometimes (but not always) it will
# get confused and show the collection as a member of itself
regsub {/$} $folder_uri {} folder_uri
if {[empty_string_p $depth]} {
if {$depth eq ""} {
set depth 0
}
......@@ -831,7 +831,7 @@ ad_proc oacs_dav::impl::content_folder::proppatch {} {
} {
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
return [list 423]
}
......@@ -847,14 +847,14 @@ ad_proc oacs_dav::impl::content_folder::lock {} {
set scope [oacs_dav::conn lock_scope]
set type [oacs_dav::conn lock_type]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
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]} {
if {$timeout eq ""} {
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]
......@@ -869,7 +869,7 @@ ad_proc oacs_dav::impl::content_folder::unlock {} {
} {
set uri [oacs_dav::conn uri]
if {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} {
if {"unlocked" ne [tdav::check_lock_for_unlock $uri] } {
set ret_code 423
set body "Resource is locked."
} else {
......@@ -923,7 +923,7 @@ ad_proc oacs_dav::impl::content_revision::put {} {
set root_folder_id [oacs_dav::conn folder_id]
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
return [list 423]
}
......@@ -938,7 +938,7 @@ ad_proc oacs_dav::impl::content_revision::put {} {
set name [oacs_dav::conn item_name]
set parent_id [oacs_dav::item_parent_folder_id $uri]
if {[empty_string_p $parent_id]} {
if {$parent_id eq ""} {
set response [list 409]
return $response
}
......@@ -946,7 +946,7 @@ ad_proc oacs_dav::impl::content_revision::put {} {
# create new item if necessary
db_transaction {
set mime_type [cr_filename_to_mime_type $name]
if {[empty_string_p $item_id]} {
if {$item_id eq ""} {
# this won't really work very nicely if we support
# abstract url type names... maybe chop off the extension
# when we name the object?
......@@ -1036,7 +1036,7 @@ ad_proc oacs_dav::impl::content_revision::proppatch {} {
# get the properties out of the list
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
return [list 423]
}
......@@ -1055,7 +1055,7 @@ ad_proc oacs_dav::impl::content_revision::delete {} {
set peer_addr [oacs_dav::conn peeraddr]
set item_id [oacs_dav::conn item_id]
set uri [oacs_dav::conn uri]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
return [list 423]
}
if {[catch {db_exec_plsql delete_item ""} errmsg]} {
......@@ -1083,12 +1083,12 @@ ad_proc oacs_dav::impl::content_revision::copy {} {
set turlv [split $target_uri "/"]
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]} {
if {$new_parent_folder_id eq ""} {
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]} {
if {$dest_item_id ne ""} {
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]
......@@ -1101,7 +1101,7 @@ ns_log debug "\nDAV Revision Copy dest $target_uri parent_id $new_parent_folder_
# 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]]} {
if {"unlocked" ne [tdav::check_lock $target_uri] } {
return [list 423]
}
......@@ -1145,16 +1145,16 @@ ad_proc oacs_dav::impl::content_revision::move {} {
set turlv [split $target_uri "/"]
set new_name [lindex $turlv end]
set overwrite [oacs_dav::conn overwrite]
if {[empty_string_p $new_parent_folder_id]} {
if {$new_parent_folder_id eq ""} {
return [list 409]
}
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
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]} {
if {$dest_item_id ne ""} {
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]
......@@ -1164,7 +1164,7 @@ ns_log debug "\nDAV Revision move dest $target_uri parent_id $new_parent_folder_
-privilege "write"]} {
return [list 401]
}
if {![string equal "unlocked" [tdav::check_lock $target_uri]]} {
if {"unlocked" ne [tdav::check_lock $target_uri] } {
return [list 423]
}
......@@ -1177,13 +1177,13 @@ ns_log debug "\nDAV Revision move dest $target_uri parent_id $new_parent_folder_
set err_p 0
db_transaction {
if {![string equal $cur_parent_folder_id $new_parent_folder_id]} {
if {$cur_parent_folder_id ne $new_parent_folder_id } {
db_exec_plsql move_item ""
} elseif {![empty_string_p $new_name] } {
} elseif {$new_name ne "" } {
db_exec_plsql rename_item ""
}
if {![string equal $item_name $new_name]} {
if {$item_name ne $new_name } {
db_dml update_title ""
}
} on_error {
......@@ -1219,14 +1219,14 @@ ad_proc oacs_dav::impl::content_revision::lock {} {
set scope [oacs_dav::conn lock_scope]
set type [oacs_dav::conn lock_type]
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
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]} {
if {$timeout eq ""} {
set timeout 300
}
set token [tdav::set_lock $uri $depth $type $scope $owner $timeout]
......@@ -1241,7 +1241,7 @@ ad_proc oacs_dav::impl::content_revision::unlock {} {
} {
set uri [oacs_dav::conn uri]
if {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} {
if {"unlocked" ne [tdav::check_lock_for_unlock $uri] } {
set ret_code 423
set body "Resource is locked."
} else {
......
tcl/tDAV-procs.tcl
View file @ c252259f
......@@ -114,8 +114,8 @@ proc tdav::xml_valid_p {xml_doc} {
proc tdav::read_xml {} {
set fp ""
while {$fp == ""} {
set tmpfile [ns_tmpnam]
while {$fp eq ""} {
set tmpfile [ad_tmpnam]
set fp [ns_openexcl $tmpfile]
}
#fconfigure $fp -translation binary -encoding binary
......@@ -124,7 +124,7 @@ proc tdav::read_xml {} {
seek $fp 0
set xml [read $fp]
close $fp
ns_unlink -nocomplain $tmpfile
file delete $tmpfile
ns_log debug "\n-----tdav::read_xml XML = -----\n $xml \n ----- end ----- \n "
return $xml
}
......@@ -172,8 +172,8 @@ proc tdav::get_prop_file {uri} {
# log this for failed config section
set name [ns_config "ns/server/[ns_info server]/tdav" propdir]
if {[string equal "" $name]} {
set name [file join [ns_info pageroot] "../propdir/${uri}"]
if {$name eq ""} {
set name [file join $::acs::pageroot "../propdir/${uri}"]
} else {
set name [file join $name $uri]
}
......@@ -204,8 +204,8 @@ proc tdav::get_lock_file {uri} {
# log this for failed config section
set name [ns_config "ns/server/[ns_info server]/tdav" lockdir]
if {[string equal "" $name]} {
set name [file join [ns_info pageroot] "../lockdir/${uri}"]
if {$name eq ""} {
set name [file join $::acs::pageroot "../lockdir/${uri}"]
} else {
set name [file join $name $uri]
}
......@@ -317,7 +317,7 @@ proc tdav::read_lock {uri} {
# Lock file for URI is deleted
proc tdav::remove_lock {uri} {
ns_unlink -nocomplain [tdav::get_lock_file $uri]
file delete [tdav::get_lock_file $uri]
}
# tdav::dbm_write_array
......@@ -344,7 +344,7 @@ proc tdav::dbm_write_array {uri arr} {
proc tdav::lock_timeout_left { timeout locktime } {
set locktime [clock scan $locktime]
set lockexpiretime [clock scan "$timeout seconds" -base $locktime]
set timeout_left [expr $lockexpiretime - [clock seconds]]
set timeout_left [expr {$lockexpiretime - [clock seconds]}]
if {$timeout_left < 0} {
set timeout_left 0
}
......@@ -391,7 +391,7 @@ proc tdav::check_lock {uri} {
regexp {(<https?://[^/]+([^>]+)>\s+)?\(<([^>]+)>\)} $hdr nil maybe hdr_uri token
set ftk [lindex $lockinfo 3]
if {![info exists token] || ![string equal $token $ftk]} {
if {![info exists token] || $token ne $ftk } {
ns_log Debug "tdav::check_lock: token mismatch $ftk expected hdr: $hdr token: $token"
ns_return 423 {text/plain} {}
return filter_return
......@@ -427,7 +427,7 @@ proc tdav::check_lock_for_unlock {uri} {
if {[info exists hdr] && [string length $hdr]} {
regexp {<([^>]+)>} $hdr nil token
set ftk [lindex [tdav::read_lock $uri] 3]
if {[info exists token] && [string equal $token $ftk]} {
if {[info exists token] && $token eq $ftk} {
# it's good, the tokens match. carry on.
} else {
return filter_return
......@@ -540,7 +540,7 @@ proc tdav::filter_webdav_proppatch {args} {
# we use localname because we always resolve the URI namespace
# for the tag name
set ns [$p namespaceURI]
if {[string equal "" $ns]} {
if {$ns eq ""} {
set name [$p nodeName]
} else {
set name [$p localName]
......@@ -556,7 +556,7 @@ proc tdav::filter_webdav_proppatch {args} {
# we use localname because we always resolve the URI namespace
# for the tag name
set ns [$p namespaceURI]
if {[string equal "" $ns]} {
if {$ns eq ""} {
set name [$p nodeName]
} else {
set name [$p localName]
......@@ -591,13 +591,13 @@ proc tdav::filter_webdav_proppatch {args} {
proc tdav::webdav_proppatch {} {
set uri [ns_conn url]
regsub {^/} $uri {} uri
set filename [file join [ns_info pageroot] $uri]
set filename [file join $::acs::pageroot $uri]
set body ""
set ret_code 200
if {![file exists $filename]} {
set ret_code 404
} else {
if {![string equal unlocked [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
set ret_code 423
set response "The resource is locked"
} else {
......@@ -640,16 +640,16 @@ proc tdav::webdav_propfind {} {
# wait, no, this is right as long as the DAV request is correct
# so fuck it
if {$depth > 0} {
set entries [glob -nocomplain [file join [ns_info pageroot] $uri *]]
set entries [glob -nocomplain [file join $::acs::pageroot $uri *]]
} else {
set entries [glob -nocomplain [file join [ns_info pageroot] $uri]]
set entries [glob -nocomplain [file join $::acs::pageroot $uri]]
}
foreach entry $entries {
set entry_props [list]
set filename [lindex [file split $entry] end]
# Tcl befuddles me:
set href [string replace $entry 1 [string length [ns_info pageroot]] ""]
set href [string replace $entry 1 [string length $::acs::pageroot] ""]
file stat $entry file_stat
set collection_p [string equal "directory" $file_stat(type)]
......@@ -749,24 +749,24 @@ proc tdav::filter_webdav_propfind {args} {
# test for url existence
regsub {^/} [ns_conn url] {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
# parse the xml body to check if its valid
if {![string equal "" $xml] && [catch {dom parse $xml} xd]} {
if {"" ne $xml && [catch {dom parse $xml} xd]} {
ns_return 400 text/plain "XML request not well-formed."
return filter_return
}
set xml_prop_list [list]
if {[info exists xd] && ![string equal "" $xd]} {
if {[info exists xd] && "" ne $xd } {
set prop [$xd getElementsByTagNameNS "DAV:" "prop"]
# if <prop> element doesn't exist we return all properties
if {![string equal "" $prop]} {
if {$prop ne ""} {
set xml_prop_list [$prop childNodes]
}
foreach node $xml_prop_list {
set ns [$node namespaceURI]
if {[string equal $ns ""]} {
if {$ns eq ""} {
set name [$node nodeName]
} else {
set name [$node localName]
......@@ -791,7 +791,7 @@ proc tdav::filter_webdav_propfind {args} {
proc tdav::filter_webdav_put {args} {
set tmpfile [ns_tmpnam]
set tmpfile [ad_tmpnam]
set fd [open $tmpfile w+]
ns_writecontent $fd
close $fd
......@@ -817,13 +817,13 @@ proc tdav::filter_webdav_put {args} {
proc tdav::webdav_put {} {
set uri [ns_conn url]
set uri [string trimleft $uri "/"]
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
set filename [lindex [file split $entry] end]
set tmpfile [tdav::conn tmpfile]
set ret_code 500
set body ""
if {[file exists $entry]} {
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
set ret_code 423
set body "Resource is locked."
} else {
......@@ -871,7 +871,7 @@ proc tdav::filter_webdav_delete {args} {
proc tdav::webdav_delete {} {
set uri [ns_conn url]
regsub {^/} $uri {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
set filename [lindex [file split $entry] end]
set ret_code 500
......@@ -879,9 +879,8 @@ proc tdav::webdav_delete {} {
if {[file exists $entry]} {
# 423's and returns:
if {[string equal unlocked [tdav::check_lock $uri]]} {
if {"unlocked" eq [tdav::check_lock $uri]} {
file delete -force -- $entry
ns_unlink -nocomplain $entry
tdav::delete_props $uri
tdav::remove_lock $uri
set ret_code 204
......@@ -913,7 +912,7 @@ proc tdav::webdav_delete {} {
# registered procedure.
proc tdav::filter_webdav_mkcol {args} {
if [ns_conn contentlength] {
if {[ns_conn contentlength]} {
set ret_code 415
set html_response ""
tdav::respond [list 415]
......@@ -938,15 +937,15 @@ proc tdav::webdav_mkcol {} {
set uri [ns_conn url]
regsub {^/} $uri {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
set filename [lindex [file split $entry] end]
regsub {/[^/]*/*$} $entry {} parent_dir
if ![file exists $parent_dir] {
if {![file exists $parent_dir]} {
set ret_code 409
} elseif ![file exists $entry] {
} elseif {![file exists $entry]} {
file mkdir $entry
file mkdir [file join [ns_info pageroot] "../props/" $uri]
file mkdir [file join $::acs::pageroot "../props/" $uri]
set ret_code 201
} else {
set ret_code 405
......@@ -972,30 +971,30 @@ proc tdav::webdav_copy {} {
set dest [tdav::conn destination]
set local_dest [ns_info pageroot]
set local_dest $::acs::pageroot
append local_dest $dest
set newuri [string replace $local_dest 1 [string length [ns_info pageroot]] ""]
set newuri [string replace $local_dest 1 [string length $::acs::pageroot] ""]
regsub {^/} $newuri {} newuri
set uri [ns_conn url]
regsub {^/} $uri {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
set filename [lindex [file split $entry] end]
regsub {^/} [ns_conn url] {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
if {![file exists $entry]} {
set ret_code 404
} else {
if {[file exists $local_dest]} {
if {![string equal "unlocked" [tdav::check_lock $dest]]} {
if {"unlocked" ne [tdav::check_lock $dest] } {
# ns_return 423 {text/plain} {Resource is locked.}
set ret_code 423
set body "Resource is locked."
} else {
if [string equal -nocase $overwrite "F"] {
if {[string equal -nocase $overwrite "F"]} {
set ret_code 412
} else {
set ret_code 204
......@@ -1030,15 +1029,15 @@ proc tdav::webdav_move { args } {
set overwrite [tdav::conn overwrite]
set dest [tdav::conn destination]
set uri [ns_conn url]
set local_dest [ns_info pageroot]
set local_dest $::acs::pageroot
append local_dest $dest
set newuri [string replace $local_dest 1 [string length [ns_info pageroot]] ""]
set newuri [string replace $local_dest 1 [string length $::acs::pageroot] ""]
regsub {^/} $newuri {} newuri
set uri [ns_conn url]
regsub {^/} $uri {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
set filename [lindex [file split $entry] end]
set ret_code 500
......@@ -1047,12 +1046,12 @@ proc tdav::webdav_move { args } {
if {![file exists $entry]} {
set ret_code 404
} else {
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
# ns_return 423 {text/plain} {Resource is locked.}
set ret_code 423
set body "Resource is locked."
} elseif [file exists $local_dest] {
if [string equal -nocase $overwrite "F"] {
} elseif {[file exists $local_dest]} {
if {[string equal -nocase $overwrite "F"]} {
set ret_code 412
} else {
set ret_code 204
......@@ -1091,7 +1090,7 @@ proc tdav::filter_webdav_lock {args} {
set timeout [ns_set iget [ns_conn headers] Timeout]
regsub {^Second-} $timeout {} timeout
tdav::conn -set lock_timeout $timeout
if {![string length $depth]} {
if {$depth eq ""} {
set depth 0
}
tdav::conn -set depth $depth
......@@ -1105,10 +1104,10 @@ proc tdav::filter_webdav_lock {args} {
}
proc tdav::set_lock {uri depth type scope owner {timeout ""} {locktime ""} } {
if {[string equal "" $timeout]} {
if {$timeout eq ""} {
set timeout [ns_config "ns/server/[ns_info server]/tdav" "defaultlocktimeout" "300"]
}
if {[string equal "" $locktime]} {
if {$locktime eq ""} {
set locktime [clock format [clock seconds] -format "%T %D"]
}
set token "opaquelocktoken:[ns_rand 2147483647]"
......@@ -1124,23 +1123,23 @@ proc tdav::webdav_lock {} {
set owner [tdav::conn lock_owner]
set uri [ns_conn url]
regsub {^/} $uri {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
set filename [lindex [file split $entry] end]
set existing_lock_token [tdav::conn lock_token]
# if {![file exists $entry]} {
# set ret_code 404
# } else
if {![string equal "unlocked" [tdav::check_lock $uri]]} {
if {"unlocked" ne [tdav::check_lock $uri] } {
set ret_code 423
tdav::respond [list $ret_code]
} else {
set depth [tdav::conn depth]
set timeout [tdav::conn lock_timeout]
if {[string equal "" $timeout]} {
if {$timeout eq ""} {
#probably make this a paramter?
set timeout 180
}
if {![string equal "" $existing_lock_token] && [file exists [tdav::get_lock_file $uri]} {
if {"" ne $existing_lock_token && [file exists [tdav::get_lock_file $uri]} {
set old_lock [tdav::read_lock $uri]
set new_lock [list [lindex $old_lock 0] [lindex $old_lock 1] [lindex $old_lock 2] [lindex $old_lock 3] $timeout [clock format [clock seconds]]]
......@@ -1166,13 +1165,13 @@ proc tdav::filter_webdav_unlock {args} {
proc tdav::webdav_unlock {} {
set uri [ns_conn url]
regsub {^/} $uri {} uri
set entry [file join [ns_info pageroot] $uri]
set entry [file join $::acs::pageroot $uri]
set filename [lindex [file split $entry] end]
if {![file exists $entry]} {
set ret_code 404
set body {}
} elseif {![string equal unlocked [tdav::check_lock_for_unlock $uri]]} {
} elseif {"unlocked" ne [tdav::check_lock_for_unlock $uri] } {
set ret_code 423
set body "Resource is locked."
} else {
......@@ -1205,14 +1204,14 @@ proc tdav::return_unauthorized { {realm ""} } {
proc tdav::respond { response } {
set response_code [lindex $response 0]
if {[string equal "423" $response_code]} {
if {"423" eq $response_code} {
set response_body "The resource is locked"
set mime_type "text/plain"
} else {
set response_list [tdav::respond::[string tolower [ns_conn method]] $response]
set response_body [lindex $response_list 0]
set mime_type [lindex $response_list 1]
if {[string equal "" $mime_type]} {
if {$mime_type eq ""} {
set mime_type "text/plain"
}
if {[string match "text/xml*" $mime_type]} {
......@@ -1282,8 +1281,8 @@ proc tdav::respond::proppatch { response } {
foreach res [lindex $response 1] {
set status [lindex $res 0]
set ns [lindex [lindex $res 1] 0]
set name [lindex [lindex $res 1] 1]
set ns [lindex $res 1 0]
set name [lindex $res 1 1]
append body [subst {<D:propstat>
<D:prop><$name xmlns='$ns'/></D:prop>
<D:status>$status</D:status>
......@@ -1362,10 +1361,10 @@ proc tdav::respond::propfind { response } {
# interestingly enough, adding the namespace here to the prop is fine
set name [lindex $i 1]
set ns [lindex $i 0]
if {![string equal "D" $ns] && ![string equal "ns0" $ns]} {
if {"D" ne $ns && "ns0" ne $ns } {
# for user properties set the namespace explicitly in
# the tag
if {![string equal "" $ns]} {
if {$ns ne ""} {
set pnode [$d createElementNS $ns $name]
} else {
set pnode [$d createElement $name]
......@@ -1374,19 +1373,19 @@ proc tdav::respond::propfind { response } {
set pnode [$d createElement ${ns}:${name}]
}
if {[string equal "creationdate" $name]} {
if {"creationdate" eq $name} {
$pnode setAttribute "b:dt" "dateTime.tz"
}
if {[string equal "getlastmodified" $name]} {
if {"getlastmodified" eq $name} {
$pnode setAttribute "b:dt" "dateTime.rfc1123"
}
if {[string equal "D:collection" $j]} {
if {"D:collection" eq $j} {
$pnode appendChild [$d createElement $j]
......@@ -1478,7 +1477,7 @@ proc tdav::respond::propfind { response } {
proc tdav::conn {args} {
global tdav_conn
set flag [lindex $args 0]
if { [string index $flag 0] != "-" } {
if { [string index $flag 0] ne "-" } {
set var $flag
set flag "-get"
} else {
......@@ -1509,7 +1508,7 @@ proc tdav::apply_filters {{uri "/*"} {options "OPTIONS GET HEAD POST DELETE TRAC
set required_options [list OPTIONS PROPFIND PROPPATCH MKCOL GET HEAD POST]
foreach required_option $required_options {
if {[lsearch -exact [string toupper $options] $required_option] < 0} {
if {$required_option ni [string toupper $options]} {
ns_log error "Required option $required_option missing from tDAV options for URI '$uri'.
Required web dav options are: '$required_options'."
return
......@@ -1531,7 +1530,7 @@ Allowed web dav options are: '$allowed_options'."
# url matching for registered filters
set filter_uri "[string trimright $uri /*]*"
foreach option $options {
if {[lsearch -exact [list GET POST HEAD] $option] < 0} {
if {$option ni [list GET POST HEAD]} {
ns_log debug "tDAV registering filter for $filter_uri on $option"
ns_register_filter postauth [string toupper $option] "${filter_uri}" tdav::filter_webdav_[string tolower $option]
}
......@@ -1541,10 +1540,10 @@ Allowed web dav options are: '$allowed_options'."
# Register procedures for selected tDAV options. Do not register a
# proc for OPTIONS, GET, POST or HEAD.
if {[string equal "true" $enable_filesystem]} {
if {"true" eq $enable_filesystem} {
foreach option $options {
if {[lsearch -exact [list OPTIONS GET POST HEAD] $option] < 0} {
if {$option ni [list OPTIONS GET POST HEAD]} {
ns_log debug "tDAV registering proc for $uri on $option"
ns_register_proc [string toupper $option] "${uri}" tdav::webdav_[string tolower $option]
}
......@@ -1640,7 +1639,7 @@ if {![nsv_exists tdav_filters_installed filters_installed]} {
# ns_perm addgroup tdav tdav tdav1
set tdav_shares [ns_configsection "ns/server/[ns_info server]/tdav/shares"]
if { ![string equal "" $tdav_shares] } {
if { "" ne $tdav_shares } {
for {set i 0} {$i < [ns_set size $tdav_shares]} {incr i} {
set tdav_share [ns_configsection "ns/server/[ns_info server]/tdav/share/[ns_set key $tdav_shares $i]"]
tdav::apply_filters [ns_set get $tdav_share uri] [ns_set get $tdav_share options] [ns_set get $tdav_share enablefilesystem]
......
tcl/test/oacs-dav-procs.tcl
View file @ c252259f
......@@ -21,7 +21,7 @@ aa_register_case oacs_dav_sc_create {
set sc_ops [db_list get_dav_ops ""]
set valid_ops [list get put mkcol copy propfind proppatch move delete]
foreach op_name $valid_ops {
aa_true "$op_name operation created" [expr [lsearch $sc_ops $op_name] > -1]
aa_true "$op_name operation created" [expr {[lsearch $sc_ops $op_name] > -1}]
}
aa_true "DAV put_type Service contract created" [expr [db_0or1row get_dav_pt_sc ""]]
......@@ -61,9 +61,9 @@ aa_register_case oacs_dav_put {
aa_log "Response was $response"
set new_item_id [db_string item_exists "" -default ""]
aa_log "Item_id=$new_item_id"
aa_true "Content Item Created" [expr ![empty_string_p $new_item_id]]
aa_true "Content Item Created" [expr {$new_item_id ne ""}]
set revision_id [db_string revision_exists "" -default ""]
aa_true "Content Revision Created" [expr ![empty_string_p $revision_id]]
aa_true "Content Revision Created" [expr {$revision_id ne ""}]
set cr_filename "[cr_fs_path]/[db_string get_content_filename ""]"
aa_true "Content Attribute Set" [string equal [file size [oacs_dav::conn tmpfile]] [file size $cr_filename]]
......@@ -98,7 +98,7 @@ aa_register_case oacs_dav_mkcol {
aa_log "name $fname uri $uri"
set response [oacs_dav::impl::content_folder::mkcol]
set new_folder_id [db_string folder_exists "" -default ""]
aa_true "Content Folder $fname created" [expr ![empty_string_p $new_folder_id]]
aa_true "Content Folder $fname created" [expr {$new_folder_id ne ""}]
}
}
......
www/admin/disable.tcl
View file @ c252259f
......@@ -8,7 +8,7 @@ ad_page_contract {
@creation-date 2004-02-15
@cvs-id $Id$
} {
folder_id:integer,multiple
folder_id:naturalnum,multiple
} -properties {
} -validate {
} -errors {
......
www/admin/enable.tcl
View file @ c252259f
......@@ -8,7 +8,7 @@ ad_page_contract {
@creation-date 2004-02-15
@cvs-id $Id$
} {
folder_id:integer,multiple
folder_id:naturalnum,multiple
} -properties {
} -validate {
} -errors {
......
www/admin/index.adp
View file @ c252259f
<master>
<property name="title">@title@</property>
<property name="context">@context@</property>
<property name="doc(title)">@title;literal@</property>
<property name="context">@context;literal@</property>
<listtemplate name="folders"></listtemplate>
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment