#
# tDAV.tcl
# 
# Portions Copyright 2003 Musea Technologies
#
# http://www.museatech.net
#
# $Id
#
# bugs to:
# toddg@tdav.museatech.net
#
# Authors: Todd Gillespie
#          Dave Bauer 
#
# Based upon sources from:
#
# webdav.tcl    
#
# A WebDAV implementation for AOLserver 3.x.
#
# Copyright (c) 2000-2001 Panoptic Computer Network.
# All rights reserved.
#
# http://www.panoptic.com/
#

#  The contents of this file are subject to the AOLserver Public License
#  Version 1.1 (the "License"); you may not use this file except in
#  compliance with the License. You may obtain a copy of the License at
#  http://aolserver.com/.

#  Software distributed under the License is distributed on an "AS IS"
#  basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
#  the License for the specific language governing rights and limitations
#  under the License.

#  Portions created by AOL are Copyright (C) 2004 America Online,
#  Inc. All Rights Reserved.

#  Alternatively, the contents of this file may be used under the terms
#  of the GNU General Public License (the "GPL"), in which case the
#  provisions of GPL are applicable instead of those above.  If you wish
#  to allow use of your version of this file only under the terms of the
#  GPL and not to allow others to use your version of this file under the
#  License, indicate your decision by deleting the provisions above and
#  replace them with the notice and other provisions required by the GPL.
#  If you do not delete the provisions above, a recipient may use your
#  version of this file under either the License or the GPL.

# LEG27032005
# Added improved configurability: if the authcommand is
#     auth:tdav:local then suppose user and or group parameters to
#     exist. these are whitespace separated lists of users/groups,
#     which are given access via ns_perm.  This is acomplished by
#     init_tDAV, which is run at the end of the file
#
# I tried to make / work as a DAV Resource, but failed.  One problem
# is the creation of erroneous lockfilenames with a "//" resource in 
# tdav::lock::local::get_lock_file.  The fix is however just a
# workaround.
#


# ------------------------------------------------------------
# Silly workaround so that AOLserver can find scripts via "package require".
# set tcl_library [file join $tcl_pkgPath tcl${tcl_version}]
# source [file join $tcl_library init.tcl]
# ------------------------------------------------------------

package require tdom

namespace eval tdav {}


proc tdav::urlencode { string } {
#     urlencode allowing characters according to rfc 1738
#     http://www.w3.org/Addressing/rfc1738.txt

#     "Thus, only alphanumerics, the special characters "$-_.+!*'(),", and
#     reserved characters used for their reserved purposes may be used
#     unencoded within a URL."
    
#     ignore + used to encode spaces in query strings
#     we can turn + into %20 after the string is encoded by
#     ns_urlencode
#     and real spaces in the url will be encoded to %2b
#     This is mainly to support MS Web Folders which do not follow the
#     spec which states that any character may be urlencoded. Web Folders
#     rejects the entire collection as invalid if a filename contains
#     one of these characters encoded.


    set encoded_string [ns_urlencode $string]
    set encoded_string [string map -nocase \
			    {+ %20 %2d - %5f _ %24 $ %2e . %21 ! %28 ( %29 ) %27 ' %2c ,} $encoded_string]
     
   return $encoded_string
}

# tdav::filter_webdav_get
#
#     Handles GET HTTP requests
#
# Arguments:
#     conn not used, required by ns_register_filter
#     share share name used in config file
#     why HTTP method of request, required by ns_register_filter
#
# Results:
#     returns a file to the client or a 404 response
#

proc tdav::filter_webdav_get { conn share why }  {

    tdav::authenticate $share
    tdav::before_callback $share

    set uri [tdav::conn url]
    # check if a redirect is registered for this URI
    set redirects \
	[ns_config "ns/server/[ns_info server]/tdav/share/${share}" redirects]    
    if {[llength $redirects]} {
	foreach {pattern redirect} $redirects {
	    if {[string match $pattern $uri]} {
		ns_returnredirect ${redirect}/[file tail $uri]
		return filter_return
	    }
	}
    }

    # Use ns_conn url to obtain the Url specified on the http
    # request being serviced.  Pass that string through ns_url2file,
    # in order to get the name of the File implied.
	
    set fname [ns_url2file $uri]
    
    # Use Tcl's open command to connect a Tcl channel to the specified file.
    # Catch any error the open may throw, so that we can do whatever
    # appropriate for references to something that does not exist.

    if {[catch {set chan [open $fname r]} err]} {
	# file can't be opened, probably does not exists
	ns_returnnotfound
    } else {

        # We'll use ns_returnfp, to get the contents of the
        # identified file sent as the response.  AOLserver will use
        # the Tcl IO commands against the channel we give it,
        # accomplishing the need to go though the VirtFS.
        # Unfortunatly, this needs to know the size, so we use the tcl
        # command to get that.

        fconfigure $chan -translation binary
	# use file stat because we need mtime and size
	# since we can generate etags it might be a good idea to
	# return an etag header, but it looks like most clients
	# just use last modified
	
	file stat $fname file_stat

        # can't GET a directory
        if {[string equal "directory" $file_stat(type)]} {
            set directorycmd [ns_config "ns/server/[ns_info server]/tdav/share/${share}" getdirectorycmd]
            if {[string equal "" $directorycmd]} {
                ns_return 405 text/plain {}
            } else {
                eval [list $getdirectorycmd $uri]
            }
            
        }
	# handle Last-Modified header, and return 304 Not Modified if
	# file is not newer than date passed by client

	set if_modified_since [ns_set iget [ns_conn headers] if-modified-since]
	set if_modified_since [lindex [split $if_modified_since ";"] 0]
	# catch this in case the client sends something clock can't
	# parse. if clock can't parse it, we just sent the file since
	# we can't compare he if-modified-since header
	set propcmd [tdav::share::propcmd $share]
	if {![catch {clock scan $if_modified_since} if_modified_since_scan]} {
	    if {![string equal "" $if_modified_since] \
		    && $if_modified_since_scan > $file_stat(mtime)} {
		ns_set put [ns_conn outputheaders] "ETag" [eval [list $propcmd get_etag $uri]]
		ns_return 304 text/plain {}
		return filter_return
			     }
	}
	# make sure we return information related to the file
	# including content length and last modified headers
	# MS clients need to see this information
        ns_set put [ns_conn outputheaders] "Content-Length" $file_stat(size)
	ns_set put [ns_conn outputheaders] "Last-Modified" [clock format $file_stat(mtime) -format "%a, %d %b %Y %H:%M:%S %Z" -gmt 1]

	ns_set put [ns_conn outputheaders] "ETag" [eval [list $propcmd get_etag $uri]]
	if {$file_stat(size) == 0} {
	    close $chan
	    ns_return 200 text/plain {}
	} else {
	    ns_returnfp 200 [ns_guesstype $fname] $chan $file_stat(size)
	    close $chan
	}

    }
    return filter_return
}


# tdav::filter_webdav_head
#
#     Handles HEAD HTTP requests
#
# Arguments:
#     conn not used, necessary for 3 arg filter
#     share share name used in config file
#     why HTTP method of request
#
# Results:
#     returns an HTTP response containing header inforamtion for URI
#

proc tdav::filter_webdav_head { conn share why }  {

    tdav::authenticate $share
    tdav::before_callback $share    
    # Use ns_conn url to obtain the Url specified on the http request
    # being serviced.
    # Pass that string through ns_url2file, in order to get the name
    # of the File implied.
    set uri [tdav::conn url]
    set redirects \
	[ns_config "ns/server/[ns_info server]/tdav/share/${share}" redirects]    
    if {[llength $redirects]} {
	foreach {pattern redirect} $redirects {
	    if {[string match $pattern $uri]} {
		ns_returnredirect ${redirect}/[file tail $uri]
		return filter_return
	    }
	}
    }

    set fname [ns_url2file $uri]

    # Use Tcl's open command to connect a Tcl channel to the specified file.
    # Catch any error the open may throw, so that we can do whatever
    # appropriate for references to something that does not exist.

    if {![file exists $fname]} {
	ns_returnnotfound
    } else {

	# use file stat because we need mtime and size
	file stat $fname file_stat

	# handle Last-Modified header, and return 304 Not Modified if
	# file is not newer than date passed by client

	set if_modified_since [ns_set iget [ns_conn headers] if-modified-since]
	set if_modified_since [lindex [split $if_modified_since ";"] 0]

	# catch this in case the client sends something clock can't
	# parse. if clock can't parse it, we just sent the file since
	# we can't compare he if-modified-since header

        set propcmd [tdav::share::propcmd $share]
	if {![catch {clock scan $if_modified_since} if_modified_since_scan]} {
	    if {![string equal "" $if_modified_since] \
		    && $if_modified_since_scan > $file_stat(mtime)} {
		ns_set put [ns_conn outputheaders] "ETag" [eval [list $propcmd get_etag $uri]]
		ns_return 304 text/plain {}
		return filter_return
			     }
	}

        # make sure we return information related to the file
	# including content length and last modified headers
	# MS clients need to see this information
        ns_set put [ns_conn outputheaders] "Content-Length" $file_stat(size)
	ns_set put [ns_conn outputheaders] "Last-Modified" [clock format $file_stat(mtime) -format "%a, %d %b %Y %H:%M:%S %Z" -gmt 1]
	ns_set put [ns_conn outputheaders] "ETag" [eval [list $propcmd get_etag $uri]]
	ns_return 200 text/plain {}
    }
    return filter_return
}

# tdav::filter_webdav_options
#
#     Handles OPTIONS HTTP requests
#
# Arguments:
#     none
#
# Results:
#     returns an HTTP response containing WebDAV options supported
#
# TODO Make this smart to return options based on URI
# We still need to pretend that the site root supports DAV 
# methods or some clients get confused.

proc tdav::filter_webdav_options {conn share why} {
    tdav::authenticate $share
    tdav::before_callback $share    
    set dav_level {1,2}
    ns_set put [ns_conn outputheaders] DAV $dav_level

    # The allowed webdav options for the share that the requested
    # URL belongs to.

    # TODO: This should be URI dependent and return that actual
    # allowed options for the URI
    # although it has to always claim DAV compatibility on the root
    # for MS client compatibility
    
   foreach {uri options} [nsv_array get tdav_options] {
       if {[regexp "${uri}" [ns_conn url]]} {
	    ns_set put [ns_conn outputheaders] Allow [join $options {,}]
	    break
	}
    }
    
    ns_set put [ns_conn outputheaders] Content-Length 0
    # This tells MSFT products to skip looking for FrontPage extensions.
    ns_set put [ns_conn outputheaders] MS-Author-Via DAV
    ns_return 200 text/plain {}
    return filter_return
}


# tdav::read_xml
#
#     reads xml from connection
#
# Arguments:
#     none
#
# Results:
#
#     returns xml text of request

proc tdav::read_xml {} {
    set xml [ns_conn content]
    return $xml
}

# tdav::filter_webdav_proppatch
#
#     Prepare request data for PROPPATCH method
#
# Arguments:
#     none
#
# Results:
#     Parses XML body and puts the formatted result in tdav_conn(prop_req)
#     global variable. Accessed from tdav::conn prop_req command.
#     Sets tdav_conn(depth) from HTTP Depth header

proc tdav::filter_webdav_proppatch { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    set uri [ns_conn url]
    tdav::conn -set share $share
    set depth [tdav::conn -set depth [ns_set iget [ns_conn headers] Depth]]

    set xml [tdav::read_xml]
    if {[catch {dom parse $xml} xd]} {
	# xml body is not well formed
	ns_returnbadrequest
	return filter_return
    }
    tdav::proppatch_parse_xml $xd
    $xd delete
    set response [tdav::webdav_proppatch $uri $share]
    tdav::respond $response
    return filter_return

}

# tdav::proppatch_parse_xml
#    parse xml proppatch request into
#    a list of properties and actions
# Arguments:
#    xd tDOM parsed XML document command
# Results:
#    stores parsed list in tdav::conn propreq

proc tdav::proppatch_parse_xml { xd } {    
    set setl [$xd getElementsByTagName "*set"]
    set rml [$xd getElementsByTagName "*remove"]
    set prop_req [list]
    foreach node $rml {
	foreach p [[$node childNodes] childNodes] {
            # we use localname because we always resolve the URI namespace
            # for the tag name
            set ns [$p namespaceURI]
            if {[string equal "" $ns]} {
                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 {
	foreach p [[$node childNodes] childNodes] {
            # we use localname because we always resolve the URI namespace
            # for the tag name
            set ns [$p namespaceURI]
            if {[string equal "" $ns]} {
                set name [$p nodeName]
            } else {
                set name [$p localName]
            }
            if {[catch {set value [[$p childNodes] nodeValue]}]} {
                set value ""
            }
            lappend prop_req set [list [list $ns $name] $value]
        }
    }

    tdav::conn -set prop_req $prop_req
}

# tdav::webdav_proppatch
#
#     Handle proppatch method for tDAV filesystem storage
#
# Arguments:
#     none
#
# Results:
#     Attempts to set or unset properties based on the request
#     contained in tdav_conn(prop_req).
#
#     Returns a list containing the HTTP status code and
#     the status of each property set/unset. The status is a list
#     of HTTP status code and text for each property.

proc tdav::webdav_proppatch {uri share} {
    set filename [ns_url2file "${uri}"]
    set ret_code 200

    if {![file exists $filename]} {
	set ret_code 404
	set response ""
    } else {
	if {![string equal unlocked [tdav::check_lock "${uri}"]]} {
	    set ret_code 423
	    set response "The resource is locked"
	} else {
	    set prop_req [tdav::conn prop_req]
	    set propcmd [tdav::share propcmd $share]
	    set response [eval [list ${propcmd} update "${uri}" ${prop_req}]]
	}
	set ret_code 207
    }
    
    return [list $ret_code $response]

}


# tdav::webdav_propfind
#
#     Handle propfind request for tDAV filesystem storage
# Arguments:
#     none
#
# Results:
#     Returns a list of HTTP status for the request, and if sucessful a
#     list of properties in the format of
#     {href collection_p {properies_list}}
#     where properties list is a list of pairs
#     {namespace name} value.

proc tdav::webdav_propfind { uri share } {
    set props [list]
    set depth [tdav::conn depth]
    set prop_req [tdav::conn prop_req]
	
    set propcmd [tdav::share propcmd $share]
    
    set props [eval [list $propcmd get "${uri}" $prop_req $depth]]
    
    return [list 207 $props]
}

# tdav::filter_webdav_propfind
#
#     Prepare incoming PROPFIND request
#
# Arguments:
#     none
#
# Results:
#     sets global values in tdav_conn array for
#     depth, and prop_req
#     prop_req is a list of lists of namespace/name pairs

proc tdav::filter_webdav_propfind { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    tdav::conn -set share $share

    # test for url existence    
    set uri [ns_conn url]
    set entry [ns_url2file "${uri}"]
    if {![file exists $entry]} {
	ns_returnnotfound
	return filter_return	
    }
    set prop_req [list]
    set depth [ns_set iget [ns_conn headers] Depth]
    tdav::conn -set depth $depth

    set body ""
    set ret_code 207

    set xml [tdav::read_xml]

    # parse the xml body to check if its valid
    # don't try to parse it if the body is empty
    if {![string equal "" $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 there is an XML body, extract the properties
    # there are being requested
    if {[info exists xd] && ![string equal "" $xd]} {
	set prop [$xd getElementsByTagNameNS "DAV:" "prop"]
	# if <prop> element doesn't exist we return all properties
	if {![string equal "" $prop]} {
	    set xml_prop_list [$prop childNodes]
	}
	foreach node $xml_prop_list {
	    set ns [$node namespaceURI]
	    if {[string equal $ns ""]} {
		set name [$node nodeName]
	    } else {
		set name [$node localName]
	    }
	    lappend prop_req [list $ns $name]
	}
    }
    tdav::conn -set prop_req $prop_req
    set response [tdav::webdav_propfind $uri $share]
    tdav::respond $response
    return filter_return
}

# tdav::filter_webdav_put
#
#     Prepare incoming PUT request
#
# Arguments:
#     none
#
# Results
#     Copies content to a temporary file and sets tdav_conn(tmpfile)

proc tdav::filter_webdav_put { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    set uri [tdav::conn url]
    tdav::conn -set share $share
    set filepath [ns_url2file $uri]

    set body ""

    # check if parent directory exists
    if {![file exists [file dirname $filepath]]} {
        set ret_code 409
        tdav::respond [list $ret_code "text/html" ${body}]    
        return filter_return        
    }
    
    if {[file exists $filepath]} {
	# check for lock 
	if {![string equal "unlocked" [tdav::check_lock "${uri}"]]} {
	    set ret_code 423
	    set body "Resource is locked."
	} elseif {[string equal -nocase "f" \
                       [ns_set iget [ns_conn headers] Overwrite]]} {
            set ret_code 412
        } else {
	    # move the temporary file to the final location
            if {[catch {tdav::webdav_put_write_file $filepath} err]} {
                ns_log error "\n ----- \n webdav_put error OVER writing file $filepath \n '$err' \n ----- \n "
		set ret_code 500
	    } else {
		set ret_code 204
	    }
	}
    } else {
	if {[catch {tdav::webdav_put_write_file $filepath} err]} {
                ns_log error "\n ----- \n webdav_put error writing file $filepath \n '$err' \n ----- \n "
	    set ret_code 500
	} else {
	    set ret_code 201
	    set body "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0/EN\">
		<html><head>
		<title>201 Created</title>
		</head><body>
		<h1>Created</h1>
		<p>Resource $uri has been created.</p>
                <hr />
                </body></html>
                "
	}
    }

    tdav::respond [list $ret_code "text/html" ${body}]    
    return filter_return
}

# tdav::webdav_put_write_file
#
#     Handle PUT for tDAV filesystem storage
#
# Arguments:
#     filepath absolute path to file
#
# Results:
#     If sucessful file is created under AOLserver pageroot
#     that corresponds to the URI of the request.

proc tdav::webdav_put_write_file { filepath } {

    set fd [open $filepath w+]
    ns_writecontent $fd
    close $fd
    return
    
}

# tdav::filter_webdav_delete
#
#     Prepare incoming DELETE request
#
# Arguments:
#     none
#
# Results:
#     none
#

proc tdav::filter_webdav_delete { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    set uri [tdav::conn url]
    tdav::conn -set share $share    
    set response [tdav::webdav_delete $uri $share]
    tdav::respond $response
    return filter_return
}

# tdav::webdav_delete
#
#    Handle DELETE method for tDAV filesystem storage
#
# Arguments:
#     none
#
# Results:
#     If sucessful file corresponding to URI is removed from
#     the filesystem. In addition properties and lock files
#     are also removed. Calls tdav::respond to return the results
#     to the client.

proc tdav::webdav_delete { uri share } {

    set entry [ns_url2file "${uri}"]
    set filename [file tail $entry]
    set ret_code 500
    set body ""
    
    if {[file exists $entry]} {
	#check for lock
	if {[string equal unlocked [tdav::check_lock $uri]]} {
	    file delete -force -- $entry
	    # remove properties
	    set propcmd [tdav::share::propcmd $share]
	    eval [list $propcmd remove "${uri}"]
	    # remove locks
	    set lockcmd [tdav::share::lockcmd $share]
	    eval [list $lockcmd remove "${uri}"]
	    set ret_code 204
	} else {
	    set ret_code 423
	    set body "Resource is locked."
	}
    } else {
	set ret_code 404
    }
    
    return [list $ret_code $body]
    
}

# tdav::filter_webdav_mkcol
#
#     Prepares MKCOL request
#
# Arguments:
#     none
#
# Results:
#     This handles the invalid request with
#      a content body. Otherwise it passes on to the
#      registered procedure.

proc tdav::filter_webdav_mkcol { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    set uri [tdav::conn url]
    tdav::conn -set share $share
    # no body should be sent on MKCOL
    if [ns_conn contentlength] {
	set ret_code 415
	set html_response ""
	tdav::respond [list 415]
	return filter_return
    }
    set response [tdav::webdav_mkcol $uri $share]
    tdav::respond $response
    return filter_return
}

# tdav::webdav_mkcol
#
#     Handles MKCOL method 
#
# Arguments:
#     none
#
# Results:
#     Creates a directory under the AOLserver pageroot
#     corresponding to the URI. Calls tdav::respond to
#     return the results to the client.

proc tdav::webdav_mkcol { uri share } {

    set entry [ns_url2file "${uri}"]
    set filename [file tail $entry]
    set parent_dir [file dirname $entry]
    # if parent directory does not exist return CONFLICT
    # RFC 2518 specifies that all elements up the the directory to be
    # created must already exist.
    if ![file exists $parent_dir] {
	set ret_code 409
    } elseif ![file exists $entry] {
	set ret_code 201
	if {[catch {file mkdir $entry} err]} {
	    set ret_code 403
	}

    } else {
	# directory already exists
	set ret_code 405
    }

    return [list $ret_code]
}

# tdav::filter_webdav_copy
#
#     Setup for COPY method
#
# Arguments:
#
# Results:
#
#

proc tdav::filter_webdav_copy { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    set uri [tdav::conn url]
    tdav::conn -set share $share
    set overwrite [tdav::conn -set overwrite [ns_set iget [ns_conn headers] Overwrite]]
    set destination [ns_urldecode [ns_set iget [ns_conn headers] Destination]]
    regsub {https?://[^/]+/} "${destination}" {/} dest
    tdav::conn -set destination "${dest}"

    set response [tdav::webdav_copy $uri $share]
    tdav::respond $response
    return filter_return
    
}

# tdav::webdav_copy
#
#     Handles COPY method
#
# Arguments:
#
# Results:
#
#

proc tdav::webdav_copy { uri share } {

    set overwrite [tdav::conn overwrite]

    set dest [tdav::conn destination]
    # this is the file path to copy to
    regsub {^~} $dest {./~} dest
    set local_dest [ns_normalizepath [ns_url2file "${dest}"]]
    set local_regexp "^[ns_info pageroot]"
    if {![regexp $local_regexp $local_dest]} {
	return [list 409]
    }

    set newuri [string replace $local_dest 1 [string length [ns_info pageroot]] ""]
    regsub {^/} "${newuri}" {} newuri
    
    set entry [ns_url2file "${uri}"]
    set isdirectory [file isdirectory $entry]
    set filename [file tail $entry]
    
    if {![file exists $entry]} {
	set ret_code 404
    } else {
	if {[file exists $local_dest]} {
	    if {![string equal "unlocked" [tdav::check_lock "${dest}"]]} {
		set ret_code 423
		set body "Resource is locked."
	    } else {
		# if overwrite is false and file exists return error
		if [string equal -nocase $overwrite "F"] {
		    set ret_code 412
		} else {



		    # overwrite is true, replace with new resource
		    set ret_code 204
                    if {[catch {
                        file delete -force $local_dest
                        file copy -force $entry $local_dest
                        # copy properties
                        set propcmd [tdav::share::propcmd $share]
                        eval [list $propcmd copy "${uri}" "${newuri}"]
                    } err]} {
                        # not sure which return code to use here on
                        # file error
                        set ret_code 409
                    }
		}
	    }
	} else {
	    set ret_code 201
            if {[catch {
                file copy $entry $local_dest
                # copy properties
                set propcmd [tdav::share::propcmd $share]
                eval [list $propcmd copy "${uri}" "${newuri}"]
            } err]} {
                set ret_code 409
            }
	}
    }
    return [list $ret_code]
}

proc tdav::filter_webdav_move { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    set uri [tdav::conn url]
    tdav::conn -set share $share
    set overwrite [tdav::conn -set overwrite [ns_set iget [ns_conn headers] Overwrite]]
    set destination [ns_urldecode [ns_set iget [ns_conn headers] Destination]]

    regsub {https?://[^/]+/} "${destination}" {/} dest

    tdav::conn -set destination "${dest}"
    set response [tdav::webdav_move $uri $share]
    tdav::respond $response
    return filter_return
}

proc tdav::webdav_move { uri share } {
    set overwrite [tdav::conn overwrite]
    set dest [tdav::conn destination]
    regsub {^~} $dest {./~} dest   
    set local_dest [ns_normalizepath [ns_url2file "${dest}"]]
    set local_regexp "^[ns_info pageroot]"
    if {![regexp $local_regexp $local_dest]} {
	return [list 409]
    }
    set newuri [string replace $local_dest 1 [string length [ns_info pageroot]] ""]
    regsub {^/} "${newuri}" {} newuri

    set entry [ns_url2file "${uri}"]

    set filename [file tail $entry]
    
    set ret_code 500
    set body {}

    if {![file exists $entry]} {
	set ret_code 404
    } else {
	if {![string equal "unlocked" [tdav::check_lock "${uri}"]]} {
	    set ret_code 423
	    set body "Resource is locked."
	} elseif [file exists $local_dest] {
	    if [string equal -nocase $overwrite "F"] {
		set ret_code 412
	    } else {
		set ret_code 204
                if {[catch {
                    file delete -force $local_dest
                    file rename $entry $local_dest
                    # move properties
                    set propcmd [tdav::share::propcmd $share]
                    eval [list $propcmd move "${uri}" "${newuri}"]
                } err]} {
                    set ret_code 409
                }
	    }
	} else {
	    set ret_code 201
	    if {[catch {
                file rename $entry $local_dest
                # move properties
                set propcmd [tdav::share::propcmd $share]
                eval [list $propcmd move "${uri}" "${newuri}"]
            } err]} {
                set ret_code 409
            }
	}
    }

    return [list $ret_code $body]

}

proc tdav::filter_webdav_lock { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share

    set uri [tdav::conn url]
    tdav::conn -set share $share

    set body {}

    # parse lock information from client
    set xml [tdav::read_xml]
    set d [[dom parse $xml] documentElement]
    set l [$d childNodes]
    set scope [[[lindex $l 0] childNodes] nodeName]
    set type [[[lindex $l 1] childNodes] nodeName]
    if {[catch {set owner [[[lindex $l 2] childNodes] nodeValue]} err]} {
	set owner ""
    }
    set depth [ns_set iget [ns_conn headers] Depth]
    set timeout [ns_set iget [ns_conn headers] Timeout]
    regsub {^Second-} $timeout {} timeout
    tdav::conn -set lock_timeout $timeout
     if {![string length $depth]} {
	set depth 0
    }
    tdav::conn -set depth $depth

    tdav::conn -set lock_scope $scope
    tdav::conn -set lock_type $type
    tdav::conn -set lock_owner $owner
    set lock_token [ns_set iget [ns_conn headers] Lock-Token]
    tdav::conn -set lock_token $lock_token

    set response [tdav::webdav_lock $uri $share]
    tdav::respond $response
    return filter_return
}

proc tdav::webdav_lock { uri share } {
    set scope [tdav::conn lock_scope]
    set type [tdav::conn lock_type]
    set owner [tdav::conn lock_owner]
    set entry [ns_url2file "${uri}"]
    set filename [file tail $entry]
    set existing_lock_token [tdav::conn lock_token]

    # normally you would check if the file exists, but WebDAV
    # has a null lock feature where a file can be locked
    # before it is created

    if {![string equal "unlocked" [tdav::check_lock "${uri}"]]} {
	set ret_code 423
	return [list $ret_code]
    } else {
	set depth [tdav::conn depth]
	set timeout [tdav::conn lock_timeout]
	if {[string equal "" $timeout]} {
	    set timeout 180
	}
	set lockcmd [tdav::share::lockcmd [tdav::conn share]]
	if {![string equal "" $existing_lock_token]} {
	    # refresh existing lock
	    set old_lock [eval [list $lockcmd get "${uri}"]]
	    eval [list $lockcmd update "${uri}" [lindex $old_lock 0] [lindex $old_lock 1] [lindex $old_lock 2] [lindex $old_lock 3] $timeout [clock format [clock seconds]] ]
	} else {
	    # new lock
	    set token [eval [list $lockcmd update "${uri}" $depth $type $scope $owner $timeout [clock format [clock seconds] ] ] ]
	}
	set ret_code 200

	return [list $ret_code [list depth $depth token $token timeout $timeout owner $owner scope $scope type $type]]
    }
}

proc tdav::filter_webdav_unlock { conn share why } {
    tdav::authenticate $share
    tdav::before_callback $share
    set uri [tdav::conn url]
    tdav::conn -set share $share
    set ret_code 500
    set body {}
    set lock_token [ns_set iget [ns_conn headers] Lock-Token]
    tdav::conn -set lock_token $lock_token

    set response [tdav::webdav_unlock $uri $share]
    tdav::respond $response
    return filter_return
}

proc tdav::webdav_unlock { uri share } {

    set entry [ns_url2file "${uri}"]
    set filename [file tail $entry]

    if {![file exists $entry]} {
	set ret_code 404
	set body {}
    } elseif {![string equal unlocked [tdav::check_lock_for_unlock "${uri}"]]} {
	set ret_code 423
	set body "Resource is locked."
    } else {
	tdav::lock::local::remove "${uri}"
	set ret_code 204
	set body ""
    }
    return [list $ret_code $body]
}

proc tdav::return_unauthorized { {realm ""} } {
    # TODO fix this to have realm make more sense
    ns_set put [ns_conn outputheaders] "WWW-Authenticate" "Basic realm=\"[ns_conn location]\""
    ns_return 401 {text/plain} "Unauthorized\n"
}

# tdav::respond
#     Take list formatted response data from process to return
#     the correct WebDAV XML response
#
# Arguments:
#     response: list of HTTP response code and body 
#     if the method requires it
#
# Results:
#     Response returned to client

proc tdav::respond { response } {
    set response_code [lindex $response 0]
    if {[string equal "423" $response_code]} {
	set response_body "The resource is locked"
	set mime_type "text/plain"
    } elseif {[string equal "404" $response_code]} {
	ns_returnnotfound
	return
    } 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]} {
	    set mime_type "text/plain"
	}
	if {[string match "text/xml*" $mime_type]} {
	    # make sure any XML response is utf-8
	    set response_body [encoding convertto utf-8 $response_body]
	}
    }
    tdav::after_callback [tdav::conn share]
    ns_return $response_code $mime_type $response_body
}

namespace eval tdav::respond {}

# tdav::respond::delete
#     Format WebDAV response for DELETE method
#
# Arguments:
#     response: list of HTTP response code and body for response
# Results:
#     This just passes on the response from the filter.
#     No XML is required on DELETE.

proc tdav::respond::delete { response } {
    set body ""
    set mime_type text/plain
    set body [lindex $response 1]
    return [list $body $mime_type]
}

proc tdav::respond::lock { response } {
    array set lock [lindex $response 1]

    set body [subst {<?xml version="1.0" encoding="utf-8"?>
	<prop xmlns="DAV:">
	<lockdiscovery>
	<activelock>
	<locktype><${lock(type)}/></locktype>
	<lockscope><${lock(scope)}/></lockscope>
	<depth>${lock(depth)}</depth>
	<owner>${lock(owner)}</owner><timeout>Second-${lock(timeout)}</timeout>
	<locktoken>
	<href>${lock(token)}</href>
	</locktoken>
	</activelock>
	</lockdiscovery>
	</prop>}]
    
    ns_set put [ns_conn outputheaders] "Lock-Token" "<${lock(token)}>"

    set ret_code 200

    return [list $body text/html]

}


# tdav::respond::unlock
#     Format WebDAV response for UNLOCK method
#
# Arguments:
#     response: list of HTTP response code and body for response
# Results:
#     No XML is required on UNLOCK.

proc tdav::respond::unlock { response } {

    set body ""

    return [list $body]
}

# tdav::respond::put
#     Format WebDAV response for PUT method
#
# Arguments:
#     response: list of HTTP response code and body for response
# Results:
#     No XML is required on PUT.

proc tdav::respond::put { response } {
    return  $response
}

# tdav::respond::proppatch
#
# Arguments:
#     response list of HTTP status and list of property elements
#              and status of the proppatch operations
#
# Results:
#     Formatted XML response

proc tdav::respond::proppatch { response } {
    # FIXME use tDOM to build XML response
    set resp_code [lindex $response 0]
    set href ""
    set body [subst {<?xml version="1.0" encoding="utf-8" ?>
	<D:multistatus xmlns:D="DAV:">
	    <D:response xmlns:ns0="DAV:">
	    <D:href>[ns_conn location]${href}</D:href>
    }]
    foreach {status_code properties } [lindex $response 1] {
	set status ""
	switch -- $status_code {
	    200 {
		set status "HTTP/1.1 200 OK"
	    }
	    409 {
		set status "HTTP/1.1 409 Conflict"
	    }
	}
	if {![string equal "" $status]} {
	    foreach prop $properties {
		set ns [lindex $prop 0]
		set name [lindex $prop 1]
		append body [subst {<D:propstat>
		    <D:prop><$name xmlns='$ns'/></D:prop>
		    <D:status>$status</D:status>
		    </D:propstat>
		}]
	    }
	}
    }
    append body {</D:response>
	</D:multistatus>}
    return [list $body {text/xml charset="utf-8"}]
}


# tdav::respond::copy
#     Format WebDAV response for COPY method
#
# Arguments:
#     response: list of HTTP response code and body for response
# Results:
#     No XML is required on COPY.

proc tdav::respond::copy { response } {
    return $response
}


# tdav::respond::move
#     Format WebDAV response for MOVE method
#
# Arguments:
#     response: list of HTTP response code and body for response
# Results:
#     No XML is required on MOVE.

proc tdav::respond::move { response } {
    return $response
}

# tdav::respond::mkcol
#     Format WebDAV response for MKCOL method
#
# Arguments:
#     response: list of HTTP response code and body for response
# Results:
#     No XML is required on MKCOL.

proc tdav::respond::mkcol { response } {
    set body ""
    switch -- [lindex $response 0] {
	415 {

	}
	490 {

	}
	201 {

	}
	405 {
	    	set body "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
<html><head>
<title>405 Method Not Allowed</title>
</head><body>
<h1>Method not allowed</h1>
</body></html>"
	}
    }
    return [list $body text/html]
}

# tdav::respond::propfind
#     format propfind list of elements as XML
#
# Arguments:
#     response HTTP status and propfind formatted list of elements
#
# Results:
#     list of HTTP status and XML body to return to the client

proc tdav::respond::propfind { response } {
    if {[string equal "404" [lindex $response 0]]} {
	return [list 404]
    }
    # create XML document
    set d [dom createDocumentNS "DAV:" "D:multistatus"]
    set n [$d documentElement]
    # special date formats for some MS clients
    $n setAttribute "xmlns:b" "urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"
    set mst_body ""
    # there is one element in response for each resource
    foreach res [lindex $response 1] {
        set href_list [list]
        foreach {href_element} [split [lindex $res 0] "/"] {
            lappend href_list [tdav::urlencode $href_element]
        }
	set href [join $href_list "/"]

	set r [$d createElementNS DAV: D:response]
	$n appendChild $r
	set h [$d createElement D:href]
	$h appendChild [$d createTextNode ${href}]
	$r appendChild $h	
	# there will be two lists in each response
	# 200 props and 404 props for requested properties
	# that were found, and not found
	foreach {code props} [lindex $res 2] {
	    if {[llength $props] == 0} {
		# if there are not properties for a status code
		# just continue
		continue
	    }
	    set propstat [$d createElement D:propstat]
	    set prop [$d createElement D:prop]
	    $r appendChild $propstat
	    # the format for 200 or 404 propstat is slightly different
	    switch -- $code {
		200 {
		    foreach {i j} $props {
			# create element for each property 
			set name [lindex $i 1]
			set ns [lindex $i 0]
			# we need to check is the namespace is for
			# DAV required properties 
			if {![string equal "DAV" $ns] \
				&& ![string equal "DAV:" $ns]} {
			
			    if {![string equal "" $ns]} {
				set pnode [$d createElementNS $ns $name]
			    } else {
				set pnode [$d createElement $name]
			    }
			} else {
			    # use namespace prefix for all DAV element
			    # to workaround MS Redirector bug
			    if {[string equal "DAV:" $ns]} {
				set pnode [$d createElement D:${name}]
			    }
			}
			# some properties have unique formatting
			switch -- "${ns}${name}" {
			    DAV:creationdate {
			    # special date formats for some MS clients				
				$pnode setAttribute "b:dt" "dateTime.tz"
				$pnode appendChild [$d createTextNode $j]				
			    }
			    DAV:getlastmodified {
			    # special date formats for some MS clients
				$pnode setAttribute "b:dt" "dateTime.rfc1123"
				$pnode appendChild [$d createTextNode $j]

			    }
			    DAV:resourcetype {

				if {[string equal "DAV:collection" $j]} {
				    set j "D:collection"
				    $pnode appendChild [$d createElement $j]
				}
			    }
			    DAV:supportedlock {
			    # type of locks supported on this resource
				# if j is empty no locks are supported
				foreach {type scope} $j {
				    set lockentry \
					[$d createElement D:lockentry]
				    
				    set lockscope \
					[$d createElement D:lockscope]
				    $lockscope appendChild \
					[$d createElement D:${scope}]
				    set locktype \
					[$d createElement D:locktype]
				    $locktype appendChild \
					[$d createElement D:${type}]
				    $lockentry appendChild $lockscope
				    $lockentry appendChild $locktype
				    $pnode appendChild $lockentry
				}
			    }
			    DAV:lockdiscovery {
			    # existing locks or empty
				# if j is empty there aren't any locks
				set lockcmd [tdav::share::lockcmd \
						 [tdav::conn share]]
				set lockinfo \
				    [eval [list $lockcmd get $href]]
				
				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]

				    $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

				    $activelock appendChild $locktype
				    $activelock appendChild $lockscope
				    $activelock appendChild $depth
				    $activelock appendChild $timeout
				    $activelock appendChild $owner
				    $activelock appendChild $locktoken

				    $pnode appendChild $activelock

				    
				}
			    }
			    default {

				$pnode appendChild [$d createTextNode $j]

			    }
			    
			}
			$prop appendChild $pnode

		    }

		    $propstat appendChild $prop	

		    set status [$d createElement D:status]
		    set status_text [$d createTextNode "HTTP/1.1 200 OK"]

		    $status appendChild $status_text
		    $propstat appendChild $status

		}
		404 {
		    # count up the 404 properties
		    # if there are none, don't include a 404 status element
		    set count_404 0
		    foreach {i} $props {
			if {[llength $i] > 0} {
			    set ns [lindex $i 0]
			    set name [lindex $i 1]
			    set pnode [$d createElement ${name}]
			    if {![string equal "" ${ns}]} {
				$pnode setAttribute "xmlns" ${ns}
			    }
			    $prop appendChild $pnode
			    incr count_404
			}
		    }
		    if {$count_404 > 0} {
			$propstat appendChild $prop
		        set status [$d createElement D:status]
			set status_text [$d createTextNode "HTTP/1.1 404 Not Found"]
			$status appendChild $status_text
			$propstat appendChild $status
		    }
		}
	    }
	}
    }
    
    # indent none is required for XP WebDAV miniredirctor which does
    # not allow any space in the resourcetype/collection tag combination
    set body [$d asXML -indent none -escapeNonASCII]
    $d delete
    # tDOM doesn't put the xml header at the top so we do it here
    set body "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n${body}"
    set response [list $body {text/xml; charset="utf-8"}]
    return $response
    
}

# tdav::conn
#     global per-request data structure to hold commonly used values
#
# Arguments:
#     element name of element to return. If an element does not exist
#     in the tdav_conn array, fall back to ns_conn
#     -set element sets element in the tdav_conn array
# Results:
#     returns value of element specified

proc tdav::conn {args} {
    global tdav_conn
    set flag [lindex $args 0]
    if { ![string match "-*" $flag]} {
        set var $flag
        set flag "-get"
    } else {
        set var [lindex $args 1]
    }
    switch -- $flag {
	-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 [ns_conn $var]
	    }		    
	}
    }
}

# tdav::apply_filters
#     setup registered filters for each share
# Arguments:
#     uri uri to assign filter to
#     options what WebDAV methods are allowed for this share
# Results:
#     filters are registered on uri

proc tdav::apply_filters {{uri "/*"} {options "OPTIONS GET HEAD POST DELETE TRACE PROPFIND PROPPATCH COPY MOVE MKCOL LOCK UNLOCK"} {share ""} } {

    # Verify that the options are valid options. Webdav requires
    # support for a minimum set of options. And offers support for a
    # limited set of options. (See RFC 2518)
    if {[string equal "" $share]} {
	ns_log error "Share not specified to apply_filters"
	return
    }
    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} {
	    ns_log error "Required option $required_option missing from tDAV options for URI '${uri}'.
Required web dav options are: '$required_options'."
	    return
	}
    }
    set allowed_options [list OPTIONS COPY DELETE GET HEAD MKCOL MOVE LOCK POST PROPFIND PROPPATCH PUT TRACE UNLOCK]
    foreach option $options {
	if {[lsearch -exact $allowed_options [string toupper $option]] < 0} {
	    ns_log error "Option $option is not an allowed tDAV option for URI '${uri}'.
Allowed web dav options are: '$allowed_options'."
	    return
	}
    }    

    # Register filters for selected tDAV options. Do not register a
    # filter for POST. OPTIONS need to be registered on the pageroot
    # to support various MS clients

    # change /example/* to /example* to accomodate the
    # url matching for registered filters
    set filter_uri "[string trimright "${uri}" /*]*"
    foreach option $options {
	if {[lsearch -exact [list POST OPTIONS] $option] < 0} {

	    ns_register_filter postauth [string toupper $option] "${filter_uri}" tdav::filter_webdav_[string tolower $option] "${share}"
        }
    }
    ns_register_filter postauth OPTIONS "/*" tdav::filter_webdav_options "${share}"        
    ns_log notice "tDAV: Registered filters on $filter_uri"
    
    nsv_set tdav_options "${uri}" $options
}

# on server startup install filters for WebDAV methods
if {![nsv_exists tdav_filters_installed filters_installed]} {
    nsv_set tdav_filters_installed filters_installed 1

    # DEPRECATED use authentication API
    # Uncomment the default user and password for testing.  The
    # application of permissions will be application specific.  To use
    # ns_perm your application will need to fill the ns_perm data
    # every time the server is loaded and when anything changes in a
    # running server. SkipLocks must be set to On in the AOLserver
    # config file and ns_perm module must be loaded.

    # The alternative is to define preauth filters on the WebDAV
    # methods and write your own code to handle authentication. This
    # is how the OpenACS implementation that uses tDAV works.
    
    # ns_perm adduser tdav [ns_crypt tdav salt] userfield
    # ns_perm adduser tdav1 [ns_crypt tdav1 salt] userfield    
    # ns_perm addgroup tdav tdav tdav1


    # setup shares from config file
    set tdav_shares [ns_configsection "ns/server/[ns_info server]/tdav/shares"]
    if { ![string equal "" $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]"] 

            nsv_set tdav_lockcmd [ns_set key $tdav_shares $i] [ns_set get $tdav_share lockcommand]
            nsv_set tdav_authcmd [ns_set key $tdav_shares $i] [ns_set get $tdav_share authcommand]
            nsv_set tdav_propcmd [ns_set key $tdav_shares $i] [ns_set get $tdav_share propcommand]
            nsv_set tdav_beforecmd [ns_set key $tdav_shares $i] [ns_set get $tdav_share beforecommand]
            nsv_set tdav_aftercmd [ns_set key $tdav_shares $i] [ns_set get $tdav_share aftercommand]            

            tdav::apply_filters [ns_set get $tdav_share uri] [ns_set get $tdav_share options] [ns_set key $tdav_shares $i]

        }
    }
}

# share specific settings
namespace eval tdav::share {}

# tdav::share
#    Implementes subcommands for share specific data
# Arguments:
#    cmd propcmd lockmd authcmd beforecmd aftercmd
#    share name of share from config file
# Results:
#    returns command name specified in the config file for share
proc tdav::share { cmd  share } {
    return [tdav::share::${cmd} "${share}"]
}

proc tdav::share::authcmd { share } {
    return [nsv_get tdav_authcmd $share]            
}

proc tdav::share::propcmd { share } {
    return [nsv_get tdav_propcmd $share]            
}

proc tdav::share::lockcmd { share } {
    return [nsv_get tdav_lockcmd $share]
}

proc tdav::share::beforecmd { share } {
    return [nsv_get tdav_beforecmd $share]    
}

proc tdav::share::aftercmd { share } {
        return [nsv_get tdav_aftercmd $share]    
}

# These actually peform the callbacks for the beginning and end of
# each request
proc tdav::before_callback { share } {
    set beforecmd [tdav::share::beforecmd $share]
    if {![string equal "" $beforecmd]} {
	eval [list $beforecmd]
    }
}

proc tdav::after_callback { share } {
    set aftercmd [tdav::share::aftercmd $share]
    if {![string equal "" $aftercmd]} {
	eval [list $aftercmd]
    }
}

namespace eval tdav::lock {}

#
# tdav::lock::generate_token
#
#    Generate a reasonably unique lock token formatted as a
#    string of - seperate hex values
#    Basic idea borrowed from
#    http://aspn.activestate.com/ASPN/Cookbook/Python/Recipe/163604
#
# Arguments:
#    none
#
# Return:
#    - seperated hex values
#

proc tdav::lock::generate_token {} {
    # genearte a reasonably unique lock token
    # using current time
    #       ip address
    #       random number from ns_rand
    # basic concept from
    # 
    set token_parts ""
    append token_parts [clock clicks -milliseconds]
    append token_parts [ns_conn peeraddr]
    append token_parts [ns_rand 2147483647]
    set token ""
    binary scan $token_parts i* token_parts_list
    set j 1
    set l [llength $token_parts_list]
    foreach i $token_parts_list {
	append token [format %x $i]
	if {$j < $l} {
	    append token "-"
	}
	incr j
    }
    return $token
}

namespace eval tdav::prop {}

# tdav::prop::generate_etag
#   Generates an etag based on file properties
# Arguments:
#   ino inode from file stat
#    size size from file stat
#    mtime mtime from file stat
# Results:
#    Formatted string for use as an etag
#
# Properties API implementations can use this procedure
# to implement the properties get_etag subcommand
# if they don't need their own etag generation code
proc tdav::prop::generate_etag { ino size mtime } {
    return [format %x $ino]-[format %x $size]-[format %x $mtime]

}
# ---------------------------------------------------------
# local filesystem implementation for tdav
# ---------------------------------------------------------

namespace eval tdav::prop::local {}

proc tdav::prop::local { cmd uri args } {
    return [eval [list tdav::prop::local::${cmd} "${uri}"] $args]
}

proc tdav::prop::local::update_user_props {uri prop_req} {
    set status [list]

    array set props [tdav::dbm_read_list "${uri}"]

    foreach {action i} $prop_req {
	# don't allow setting or removal of DAV: required properties
	set k [lindex $i 0]
	if {![string equal "DAV:" $k]} {
	    set value [lindex $i 1]
	    switch -- $action {
		set {
		    if {[catch {set props($k) $value} err]} {
			lappend prop_status(409) $k
		    } else {
			lappend prop_status(200) $k
		    }
		    
		}
		remove {
		    #according to WebDAV spec removing a nonexistent
		    # property is not an error, if it's there
		    # remove it, otherwise, continue.
		    if {[info exists props($k)]} {
			unset props($k)
		    }
		    lappend prop_status(200) $k
		}
	    }
	}
    }
    tdav::dbm_write_list "${uri}" [array get props]    
    return [array get prop_status]
}


proc tdav::prop::local::get { uri prop_req depth } {
    set props [list]
    set uri_file [ns_url2file "${uri}"]
    set entries [list "${uri}"]
    if {$depth > 0 && [file isdirectory "${uri_file}"]} {
	set entries [concat $entries [glob -nocomplain -tails -directory "${uri_file}" *]]
    }
    foreach entry $entries {
	set entry_props [list]
        regsub {^~} $entry {./~} entry
	set file [ns_url2file [file join "${uri}" $entry]]
	set filename [file tail $file]
	#    set href $entry
	set href [file join "${uri}" "${entry}"]
	file stat $file file_stat
	set collection_p [file isdirectory $file]
	if {[llength $prop_req] > 0} {
	    set prop_req_exists 1
	} else {
	    set prop_req_exists 0
	}
	set prop_req_404 $prop_req

	# do this here
	if {$collection_p} {
	    # file join leaves off trailing slash on directories
	    set href "${href}/"
	    # use httpd/unix-directory content type (mod_dav)
	    lappend entry_props {DAV: getcontenttype} "httpd/unix-directory" \
                {DAV: resourcetype} "DAV:collection"
	    # don't append getcontentlength for collections (mod_dav)
	} else {
	    lappend entry_props {DAV: getcontenttype} [ns_guesstype $filename] \
                {DAV: resourcetype} "" \
                {DAV: getcontentlength} $file_stat(size)	    
	}
	
	lappend entry_props {DAV: creationdate} \
	    [clock format \
		 $file_stat(mtime) -format "%Y-%m-%dT%H:%M:%SZ" -gmt 1] \
	    {DAV: getlastmodified} \
	    [clock format \
		 $file_stat(mtime) -format "%a, %d %b %Y %H:%M:%S %Z" -gmt 1] \
            {DAV: getetag} \
	    [tdav::prop::generate_etag $file_stat(ino) $file_stat(size) $file_stat(mtime)]
	# mod_dav doesn't set displayname
	#	lappend entry_props [list DAV: displayname] $filename

	# DO LOCK STUFF HERE
	set lockcmd [tdav::share::lockcmd [tdav::conn share]]
	set supportedlock [eval [list $lockcmd supportedlock $uri]]
	set lockinfo [eval [list $lockcmd get $uri]]
	lappend entry_props {DAV: supportedlock} $supportedlock \
            {DAV: lockdiscovery} $lockinfo

	
	set user_props [tdav::prop::local::get_user_props "${uri}"] 
	foreach {i j} $user_props {
	    set prop_req_index [lsearch $prop_req $i]
	    if {!$prop_req_exists || $prop_req_index > -1 } {
		lappend entry_props [list [lindex $i 0] [lindex $i 1]] $j
		if {$prop_req_exists && $prop_req_index > -1 } {

		    set prop_req_404 [lreplace $prop_req_404 $prop_req_index $prop_req_index {}]
		}
	    }
	}
	# don't ever return 404 on a DAV property
	# per RFC 2518
	set i 0
	foreach prop $prop_req {
	    if {[string equal "DAV:" [lindex $prop 0]]} {
		set prop_req_404 [lreplace $prop_req_404 $i $i {}]
	    }
	    incr i
	}
	
	set propstat [list 200 $entry_props 404 $prop_req_404]
	lappend props [list $href $collection_p $propstat]

	
    }
    return $props
  
}

proc tdav::prop::local::update { uri prop_req } {
    if {![string equal "" $prop_req]} {
	# don't update if there isn't anything to update
	return [tdav::prop::local::update_user_props "${uri}" $prop_req]
    }
}

# tdav::prop::local::get_etag
#    generate an etag
#
# Arguments:
#    uri
# Results:
#    unique etag based on file properties

proc tdav::prop::local::get_etag { uri } {
    file stat [ns_url2file $uri] file_stat
    return [tdav::prop::generate_etag $file_stat(ino) $file_stat(size) $file_stat(mtime)]
}

# tdav::get_user_props
#
#     Retreive user properties from tDAV filesystem storage
#
# Arguments:
#     uri URI of the request
#     depth valid for collections (directories) can be 0 1 or infinity
#           0 is the directory only
#           1 is the directory and direct descendants
#           infinity is all decendants, this is the default if depth
#           is not specified
#     prop_req should contain a list of name/value pairs of properties
#           to return. Right now it is unsupported and all properties
#           are always returned
#
# Results:
#     returns a list of name/value pairs 


# LEG27032005: changed two "luri" ocurrencies to "uri"

proc tdav::prop::local::get_user_props { uri } {
    regsub {^/} "${uri}" {} uri

    set p [tdav::dbm_read_list $uri]
    return $p
}

# filesystem specific utilities


# tdav::dbm_write_list
#
#      helper fxns for dbm-like props
#      Writes a list to a properties file
#
# Arguments:
#     uri URI of the request being handled
#     list properties formatted in a Tcl list as
#     propertyname value 
#
# Results:
#     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
}

# tdav::get_prop_file
#
#     Get the filename that contains user properties.
#
# Arguments:
#     uri URI to get properties filename for
#
# Results:
#     Returns the filename containing user properties. 

proc tdav::get_prop_file {uri} {
    # just in case.  I hate that 'file join' fails on this
    regsub {^/} "${uri}" {} 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}"]
    } else {
	set name [file join $name "${uri}"]
    }

    # catch uncreated parent dirs here:
    if {![file exists [file dirname $name]]} {
	# no parent dir, create it:
	file mkdir [file dirname $name]
	# safe for public consumption?
    }
    return "${name}.prop"
}

# tdav::delete_props
#
#     Delete the properties file for a URI
#
# Arguments:
#    uri URI of properties file to delete
#
# Results:
#     File containing user properties for URI is deleted

proc tdav::prop::local::remove {uri args} {
    set entry [tdav::get_prop_file "${uri}"]
    catch {[file delete -force $entry]} err
    return err
}

# tdav::move_props
#
#     Move the properties file for a URI
#
# Arguments:
#     uri Original URI
#     newuri New URI after move
#
# Results:
#     Properties file is moved under the properties directory
#     to the relative location for newuri

proc tdav::prop::local::move { uri newuri } {
    set entry [tdav::get_prop_file "${uri}"]
    set dest [tdav::get_prop_file "${newuri}"]
    catch {[file copy -force $entry "${dest}"]}
}

# tdav::copy_props
#
#     Copy properties file for a URI to another URI
#
# Arguments:
#     uri source URI to copy
#     newuri destination URI of copy
#
# Results:
#     Contents of properties file for URI is copied
#     under the properties directory to the relative
#     location corresponding to newuri.

proc tdav::prop::local::copy { uri newuri } {
    set entry [tdav::get_prop_file "${uri}"]
    set dest [tdav::get_prop_file "${newuri}"]
    catch {[file copy -force $entry "${dest}"]}
}

proc tdav::dbm_read_list {uri} {
    set file [tdav::get_prop_file "${uri}"]
    set f [open $file {CREAT RDONLY}]
    fconfigure $f -encoding utf-8
    set s [read $f]
    return $s
}


# local filesystem lock implementation

namespace eval tdav::lock::local {}

proc tdav::lock::local { cmd uri args } {
    return [eval [list tdav::lock::local::${cmd} "${uri}"] $args]
}


# tdav::get_lock_file
#
#     Get the filename of the lock file
#
# Arguments:
#     uri URI to get the lock filename for
#
# Results:
#     Returns the filename containing the lock information for URI

proc tdav::lock::local::get_lock_file {uri} {
    # just in case.  I hate that 'file join' fails on this
    regsub {^/} "${uri}" {} uri

# LEG27032005 / resource did not work, because it comes as // so we do
# the regsup again.  This gives as a lockfile named after the lockdir
# con .lock extension...  Not nice, but it works for me, for now.
# How about faked or failing input /// collections...
    regsub {^/} "${uri}" {} 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}"]
    } else {
	set name [file join $name "${uri}"]
    }
    if {![file exists [file dirname $name]]} {
	# no parent dir, create it:
	file mkdir [file dirname $name]
	# safe for public consumption?
    }

    return "${name}.lock"
}

# tdav::read_lock
#
#     Read lock file for a URI
#
# Arguments:
#     uri URI to retrieve lock
#
# Results:
#     Returns the contents of the lock file. Contents will
#     be evaluated before being returned.

proc tdav::lock::local::get {uri args} {
    set lock_file [tdav::lock::local::get_lock_file $uri]
    if {![file exists $lock_file]} {
	return ""
    }
    set f [open $lock_file {CREAT RDONLY}]
    set s [read $f]
    set e "list ${s}"
    set l [eval $e]
    close $f

    return $l
}


proc tdav::lock::local::update {uri depth type scope owner {timeout ""} {locktime ""}} {
    if {[string equal "" $timeout]} {
	set timeout [ns_config "ns/server/[ns_info server]/tdav" "defaultlocktimeout" "300"]
    }
    if {[string equal "" $locktime]} {
	set locktime [clock format [clock seconds]]
    }
    set token "opaquelocktoken:[tdav::lock::generate_token]"
    set lock [list $type $scope $owner $token $timeout $depth $locktime]
    tdav::lock::local::write_lock "${uri}" $lock
    return $token

}

proc tdav::lock::local::write_lock  {uri list} {
    set f [open [tdav::lock::local::get_lock_file "${uri}"] w]
    puts $f $list
    close $f
}

# tdav::lock::local::remove
#
#     Delete lock file, effectively also removing the lock
#
# Arguments:
#      uri URI to remove lock from
#
# Results:
#      Lock file for URI is deleted

proc tdav::lock::local::remove {uri args} {
    # in addition I'd like to support shared locks, and make sure we
    # delete the correct lock
    ns_unlink -nocomplain [tdav::lock::local::get_lock_file "${uri}"]
}

# tdav::lock_timeout_left
#
# timeout
#    total length of timeout set in seconds
#
# locktime
#    time lock was created in any format clock scan can accept
#

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]]
    if {$timeout_left < 0} {
	set timeout_left 0
    }
    return $timeout_left
}

# tdav::lock::local::supportedlock
#     local filesystem implementation (for demostration)
#     or supportedlock subcommand
# Arguments:
#     uri
#
# Results:
#     list of type,scope pairs of support
#     This is just hard coded for every resource. This shows what
#     locks that are supported, not necessarily that the requesting
#     user has permission to use.
#     At the current time this implementation only supports
#     write exclusive locks.
#

proc tdav::lock::local::supportedlock { uri args } {
    return [list write exclusive write shared]
}

# tdav::check_lock
#
#     Compare existing lock to lock token provided
#     by the client
#
# Arguments:
#     uri URI of request
#
# Results:
#     If the lock token in the Lock-Token header matches
#     an existing lock return "unlocked". Processing of
#     transction from the caller should continure. If
#     the lock doesn't match return "filter_return". Generally
#     this means either no Lock-Token header was provided or
#     the Lock-Token header does not match the existing lock
#     on URI. In this case the caller should return an HTTP
#     status of 423 or otherwise treat the file as locked.

proc tdav::check_lock {uri args} {
    # TODO Deprecated - Use lock API to be developed
    regsub {^/} "${uri}" {} uri
    # if lock exists, work.  if not, just return.
    set lockcmd [tdav::share::lockcmd [tdav::conn share]]
    set lockinfo [eval [list $lockcmd get $uri]]
    if {![string equal "" $lockinfo]} {

	# check if lock is expired
	if {[tdav::lock_timeout_left [lindex $lockinfo 4] [lindex $lockinfo 6]] == 0 } {
	    tdav::lock::local::remove "${uri}"
	    return "unlocked"
	}
	set hdr [ns_set iget [ns_conn headers] If]
	
	# the If header exists, work, otherwise 423
	
	if {[info exists hdr] && [string length $hdr]} {
	    set token ""
	    # add ? in the token re in case there is a conditional () 
	    # in the header
	    regexp {(<https?://[^/]+([^>]+)>\s+)?\(<([^>]+)>\)} $hdr nil maybe hdr_uri token
	    
	    set ftk [lindex $lockinfo 3]
	    if {![info exists token] || ![string equal $token $ftk]} {
                ns_log Debug "tdav::check_lock: token mismatch $ftk expected hdr: $hdr token: $token"
		ns_return 423 {text/plain} {}
		return filter_return
	    }
	} else {
            ns_log Debug "tdav::check_lock: no \"If\" header found for request of ${uri}"
	    ns_return 423 {text/plain} {}
	    return filter_return
	}
	# also check for uri == hdr_uri
    }
    return unlocked
}

# tdav::check_lock_for_unlock
#
#     Compare existing lock with client provided lock token.
#
# Arguments:
#     uri URI of the request
#
# Results:
#     If the client provided lock token matches the existing lock the
#     lock is removed and "unlocked" is returned. Otherwise no action
#     is taken on the lock and "filter_return" is returned.

proc tdav::check_lock_for_unlock {uri args} {
    # TODO Deprecated - Use lock API to be developed
    regsub {^/} "${uri}" {} uri
    # if lock exists, work.  if not, just return.
    set lock_info [tdav::lock::local::get "${uri}"]
    if {![string equal "" $lock_info]} {
	set hdr [ns_set iget [ns_conn headers] {Lock-Token}]
	# the If header exists, work, otherwise 423
	if {[info exists hdr] && [string length $hdr]} {
	    regexp {<([^>]+)>} $hdr nil token
	    set ftk [lindex $lock_info 3]
	    if {[info exists token] && [string equal $token $ftk]} {
		# it's good, the tokens match.  carry on.
	    } else {
		return filter_return
	    }
	} else {
	    return filter_return
	}
	# also check for uri == hdr_uri
    }
    return unlocked
}

# tdav::authenticate
#
# Handles authentication. Extracts authentication information from
# HTTP headers and calls authentication plug-in
#
# Arguments: none
#
# Side Effects: if not authenticated returns 401 Unauthorized HTTP response
#               to the client

proc tdav::authenticate { share } {

    # should be something like "Basic 29234k3j49a"
    set a [ns_set get [ns_conn headers] Authorization]
    # 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 l [split [ns_uudecode $up] ":"]
    set user [lindex $l 0]
    set password [lindex $l 1]
    # get all the information the authentication plug-in might need
    set overwrite [tdav::conn -set overwrite [ns_set iget [ns_conn headers] Overwrite]]
    set destination [ns_urldecode [ns_set iget [ns_conn headers] Destination]]
    # TODO fix to accomodate https also!
    regsub {https?://[^/]+/} "${destination}" {/} dest
    tdav::conn -set destination "${dest}"
    set depth [tdav::conn -set depth [ns_set iget [ns_conn headers] Depth]]

    set method [tdav::conn method]
    set uri [ns_conn url]
    
    set authcmd [tdav::share::authcmd $share]

    set auth_p [eval [list $authcmd $uri $method $user $password \
			  $dest $depth $overwrite]]
    if {!$auth_p} {
	tdav::return_unauthorized
    }
    # if we got this far, the user is authorized to perform the request
    return
    
}

namespace eval tdav::auth {}

proc tdav::auth::local { uri method user password dest depth overwrite } {
    if {![string equal "ns_perm" [info commands "ns_perm"]]} {
        # if ns_perm is not loaded deny everything
        ns_log warning "Local authentication is active but nsperm module is not loaded."
        return 0
    }
    # local authentication requires ns_perm
    # since ns_perm already checked the authorization we only need to
    # check on COPY or MOVE operations where we need to check against
    # the destination
    switch -- [string toupper $method] {
        COPY {
            # on COPY check PUT on destination
            return [string equal OK [ns_requestauthorize PUT $dest $user $password]]
            # FIXME check depth
        }
        MOVE {
            # on MOVE check DELETE on source and PUT on destination
            return [expr {[string equal OK [ns_requestauthorize DELETE $uri $user $password]] \
                              && [string equal OK [ns_requestauthorize PUT $dest $user $password]]}]
                # FIXME check depth
        }
        default {
            return 1
        }
    } 
}



#
# NOTE this only works if you have Skiplocks TRUE in the AOLserver
# config file 
# LEG27032005: Allow acces to every user/group in every share.
#
proc init_tDAV { } {

    set tdav_shares [ns_configsection "ns/server/[ns_info server]/tdav/shares"]
    if { ![string equal "" $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]"] 

	    # Check if we use the nsperm module for auth.
	    
	    if {[ns_set get $tdav_share authcommand] == "tdav::auth::local"} {
		# just DENY everything to the world
		set uri [ns_set get $tdav_share uri]
		ns_perm denyuser GET $uri ""
		ns_perm denyuser PUT $uri ""
		ns_perm denyuser HEAD $uri ""
		ns_perm denyuser OPTIONS $uri ""
		ns_perm denyuser MKCOL $uri ""
		ns_perm denyuser MOVE $uri ""
		ns_perm denyuser DELETE $uri ""
		ns_perm denyuser COPY $uri ""
		ns_perm denyuser POST $uri ""
		ns_perm denyuser PROPFIND $uri ""
		ns_perm denyuser PROPPATCH $uri ""
		ns_perm denyuser LOCK $uri ""
		ns_perm denyuser UNLOCK $uri ""
		
		
		# now allow all methods to all users/groups in the configfile
		set options [ns_set get $tdav_share options]
		set users   [ns_set get $tdav_share users]
		set groups  [ns_set get $tdav_share groups]

		foreach user $users {
		    foreach option $options {
			ns_perm allowuser $option $uri $user
			ns_log debug "tDAV: ns_perm allowser $option $uri $user" 
		    }
		}
		foreach group $groups {
		    foreach option $options {
			ns_perm allowgroup $option $uri $group
		    }
		}
		ns_log notice "tDAV: permissions initialized"
	    }
	}
    }
}

init_tDAV
