Index: openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl,v
diff -u -r1.19.2.4 -r1.19.2.5
--- openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl 28 Dec 2021 16:58:27 -0000 1.19.2.4
+++ openacs-4/packages/oacs-dav/tcl/tDAV-procs.tcl 25 Sep 2022 20:54:41 -0000 1.19.2.5
@@ -113,18 +113,7 @@
# returns xml text of request
proc tdav::read_xml {} {
- set fp ""
- while {$fp eq ""} {
- set tmpfile [ad_tmpnam]
- set fp [ns_openexcl $tmpfile]
- }
- #fconfigure $fp -translation binary -encoding binary
- # fconfigure $fp -encoding utf-8
- ns_conncptofp $fp
- seek $fp 0
- set xml [read $fp]
- close $fp
- file delete -- $tmpfile
+ set xml [ns_getcontent -as_file false -binary false]
ns_log debug "\n-----tdav::read_xml XML = -----\n $xml \n ----- end ----- \n "
return $xml
}
@@ -143,16 +132,11 @@
# file written including contents of list
proc tdav::dbm_write_list {uri list} {
- set file [tdav::get_prop_file $uri]
- if {[catch {set f [open $file w]} err]} {
- # probably no parent dir, create it:
- file mkdir [file dirname $file]
- # open again:
- set f [open $file w]
- }
- fconfigure $f -encoding utf-8
- puts $f $list
- close $f
+ regsub {^/} $uri {} uri
+ ad_set_client_property \
+ -persistent t \
+ -session_id 0 \
+ oacs-dav $uri $list
}
# tdav::get_prop_file
@@ -229,9 +213,11 @@
# File containing user properties for URI is deleted
proc tdav::delete_props {uri} {
- set entry [tdav::get_prop_file $uri]
- catch {[file delete -force -- $entry]} err
- return err
+ regsub {^/} $uri {} uri
+ ad_set_client_property \
+ -persistent t \
+ -session_id 0 \
+ oacs-dav $uri ""
}
# tdav::move_props
@@ -247,9 +233,20 @@
# to the relative location for newuri
proc tdav::move_props {uri newuri} {
- set entry [tdav::get_prop_file $uri]
- set dest [tdav::get_prop_file $newuri]
- catch {[file copy -force -- $entry $dest]}
+ regsub {^/} $uri {} uri
+ regsub {^/} $newuri {} newuri
+ set props [ad_get_client_property \
+ -session_id 0 \
+ -default "" \
+ oacs-dav $uri]
+ ad_set_client_property \
+ -persistent t \
+ -session_id 0 \
+ oacs-dav $newuri $props
+ ad_set_client_property \
+ -persistent t \
+ -session_id 0 \
+ oacs-dav $uri ""
}
# tdav::copy_props
@@ -266,9 +263,16 @@
# location corresponding to newuri.
proc tdav::copy_props {uri newuri} {
- set entry [tdav::get_prop_file $uri]
- set dest [tdav::get_prop_file $newuri]
- catch {[file copy -force -- $entry $dest]}
+ regsub {^/} $uri {} uri
+ regsub {^/} $newuri {} newuri
+ set props [ad_get_client_property \
+ -session_id 0 \
+ -default "" \
+ oacs-dav $uri]
+ ad_set_client_property \
+ -persistent t \
+ -session_id 0 \
+ oacs-dav $newuri $props
}
proc tdav::write_lock {uri list} {
@@ -278,11 +282,11 @@
}
proc tdav::dbm_read_list {uri} {
- set f [open [tdav::get_prop_file $uri] {CREAT RDONLY}]
- fconfigure $f -encoding utf-8
- set s [read $f]
- close $f
- return $s
+ regsub {^/} $uri {} uri
+ return [ad_get_client_property \
+ -session_id 0 \
+ -default "" \
+ oacs-dav $uri]
}
# tdav::read_lock
@@ -532,27 +536,13 @@
return filter_return
}
- set setl [$xd getElementsByTagName "*set"]
- set rml [$xd getElementsByTagName "*remove"]
+ set property_update [$xd documentElement]
+
set prop_req [list]
- foreach node $rml {
- set p [[$node childNodes] childNodes]
- # we use localname because we always resolve the URI namespace
- # for the tag name
- set ns [$p namespaceURI]
- if {$ns eq ""} {
- set name [$p nodeName]
- } else {
- set name [$p localName]
- }
- if {[catch {set value [[$p childNodes] nodeValue]}]} {
- set value ""
- }
- lappend prop_req remove [list [list $ns $name] $value]
- }
- foreach node $setl {
- set p [[$node childNodes] childNodes]
+ foreach node [$property_update childNodes] {
+ regsub {^.*:} [$node nodeName] {} operation
+ set p [[$node firstChild] firstChild]
# we use localname because we always resolve the URI namespace
# for the tag name
set ns [$p namespaceURI]
@@ -564,7 +554,7 @@
if {[catch {set value [[$p childNodes] nodeValue]}]} {
set value ""
}
- lappend prop_req set [list [list $ns $name] $value]
+ lappend prop_req $operation [list [list $ns $name] $value]
}
tdav::conn -set prop_req $prop_req
@@ -1340,6 +1330,11 @@
# we don't have to check the tdav fs props or lock properties
# they should already be there
+ set request_properties [list]
+ foreach pr [tdav::conn prop_req] {
+ lappend request_properties $pr ""
+ }
+
set d [dom createDocumentNS "DAV:" "D:multistatus"]
set n [$d documentElement]
$n setAttribute "xmlns:b" "urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"
@@ -1350,17 +1345,24 @@
$n appendChild $r
set h [$d createElement D:href]
$h appendChild [$d createTextNode ${href}]
- set propstat [$d createElement D:propstat]
- set prop [$d createElement D:prop]
$r appendChild $h
- $r appendChild $propstat
- foreach {i j} $props {
- # interestingly enough, adding the namespace here to the prop is fine
+ #
+ # We will return both the properties we have and the
+ # properties that were requested (as per RFC). When the
+ # requested property does not exist, 404 will be returned in
+ # the status.
+ #
+ foreach {i j} [dict merge $request_properties $props] {
+ set propstat [$d createElement D:propstat]
+ set prop [$d createElement D:prop]
+ $r appendChild $propstat
+
+ # interestingly enough, adding the namespace here to the prop is fine
lassign $i ns name
if {"D" ne $ns && "ns0" ne $ns } {
- # for user properties set the namespace explicitly in
- # the tag
+ # for user properties set the namespace explicitly in
+ # the tag
if {$ns ne ""} {
set pnode [$d createElementNS $ns $name]
} else {
@@ -1394,73 +1396,75 @@
$prop appendChild $pnode
- }
+ set supportedlock [$d createElement D:supportedlock]
- set supportedlock [$d createElement D:supportedlock]
+ set lockentry [$d createElement D:lockentry]
+ set lockscope [$d createElement D:lockscope]
+ set exclusive [$d createElement D:exclusive]
+ set locktype [$d createElement D:locktype]
+ set write_type [$d createElement D:write]
- set lockentry [$d createElement D:lockentry]
- set lockscope [$d createElement D:lockscope]
- set exclusive [$d createElement D:exclusive]
- set locktype [$d createElement D:locktype]
- set write_type [$d createElement D:write]
+ $supportedlock appendChild $lockentry
- $supportedlock appendChild $lockentry
+ $locktype appendChild $write_type
+ $lockscope appendChild $exclusive
- $locktype appendChild $write_type
- $lockscope appendChild $exclusive
+ $lockentry appendChild $lockscope
+ $lockentry appendChild $locktype
- $lockentry appendChild $lockscope
- $lockentry appendChild $locktype
+ $prop appendChild $supportedlock
- $prop appendChild $supportedlock
+ set lockdiscovery [$d createElement D:lockdiscovery]
+ regsub {https?://[^/]+/} $href {/} local_uri
+ if {[file exists [tdav::get_lock_file $local_uri]]} {
+ # check for timeout
+ set lockinfo [tdav::read_lock $local_uri]
+ set lock_timeout_left [tdav::lock_timeout_left [lindex $lockinfo 4] [lindex $lockinfo 6]]
+ if {$lock_timeout_left > 0} {
- set lockdiscovery [$d createElement D:lockdiscovery]
- regsub {https?://[^/]+/} $href {/} local_uri
- if {[file exists [tdav::get_lock_file $local_uri]]} {
- # check for timeout
- set lockinfo [tdav::read_lock $local_uri]
- set lock_timeout_left [tdav::lock_timeout_left [lindex $lockinfo 4] [lindex $lockinfo 6]]
- if {$lock_timeout_left > 0} {
+ set activelock [$d createElement D:activelock]
+ set locktype [$d createElement D:locktype]
+ set lockscope [$d createElement D:lockscope]
+ set depth [$d createElement D:depth]
+ set owner [$d createElement D:owner]
+ set timeout [$d createElement D:timeout]
+ set locktoken [$d createElement D:locktoken]
+ set locktokenhref [$d createElement D:href]
- set activelock [$d createElement D:activelock]
- set locktype [$d createElement D:locktype]
- set lockscope [$d createElement D:lockscope]
- set depth [$d createElement D:depth]
- set owner [$d createElement D:owner]
- set timeout [$d createElement D:timeout]
- set locktoken [$d createElement D:locktoken]
- set locktokenhref [$d createElement D:href]
+ $locktype appendChild [$d createElement D:[lindex $lockinfo 0]]
+ $lockscope appendChild [$d createElement D:[lindex $lockinfo 1]]
+ $depth appendChild [$d createTextNode [lindex $lockinfo 5]]
- $locktype appendChild [$d createElement D:[lindex $lockinfo 0]]
- $lockscope appendChild [$d createElement D:[lindex $lockinfo 1]]
- $depth appendChild [$d createTextNode [lindex $lockinfo 5]]
+ $timeout appendChild [$d createTextNode Second-$lock_timeout_left]
+ $owner appendChild [$d createTextNode [lindex $lockinfo 2]]
+ $locktokenhref appendChild [$d createTextNode [lindex $lockinfo 3]]
+ $locktoken appendChild $locktokenhref
- $timeout appendChild [$d createTextNode Second-$lock_timeout_left]
- $owner appendChild [$d createTextNode [lindex $lockinfo 2]]
- $locktokenhref appendChild [$d createTextNode [lindex $lockinfo 3]]
- $locktoken appendChild $locktokenhref
+ $activelock appendChild $locktype
+ $activelock appendChild $lockscope
+ $activelock appendChild $depth
+ $activelock appendChild $timeout
+ $activelock appendChild $owner
+ $activelock appendChild $locktoken
- $activelock appendChild $locktype
- $activelock appendChild $lockscope
- $activelock appendChild $depth
- $activelock appendChild $timeout
- $activelock appendChild $owner
- $activelock appendChild $locktoken
-
- $lockdiscovery appendChild $activelock
+ $lockdiscovery appendChild $activelock
+ }
}
- }
- $prop appendChild $lockdiscovery
- $propstat appendChild $prop
+ $prop appendChild $lockdiscovery
+ $propstat appendChild $prop
- set status [$d createElement D:status]
- set status_text [$d createTextNode "HTTP/1.1 200 OK"]
+ set status [$d createElement D:status]
+ set status_code [expr {
+ [dict exists $props $i] ?
+ "HTTP/1.1 200 OK" : "HTTP/1.1 404 Not Found"
+ }]
+ set status_text [$d createTextNode $status_code]
- $status appendChild $status_text
- $propstat appendChild $status
+ $status appendChild $status_text
+ $propstat appendChild $status
+ }
-
}