Class ::caldav::CalDAV (public)

 ::xotcl::Class ::caldav::CalDAV

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::caldav {}
::nsf::object::alloc ::xotcl::Class ::caldav::CalDAV {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::caldav::CalDAV instproc item_update {-calendar_id:integer -item:object} {
        #
        # This method inserts or updates a caldav calendar
        # item. If there is already a cal_item for this uid, we
        # perform an update on the original calendar. If it does
        # not exists, we perform an insert in the specified
        # calendar (calendar_id).
        #
        # The caller is responsible to acertain that the calendar
        # is writable.
        #
        # @param calendar_id place where new calendar items are added to

        set summary [$item get summary]
        if {$summary eq ""} {
            :log "CalDAV: summary is empty, skip this item"
            return
        }
        set uid [$item cget -uid]

        # TODO: is the following comment useful?
        #
        # We need to check if the item exists in one of the other
        # calendars of the user.  If an item with this uid already
        # exists, return an error

        set cal_item_id [lindex [::caldav::calendars get_cal_item_from_uid -calendar_ids $calendar_id $uid] 0]

        set dtend   [$item get dtend]
        set dtstart [$item get dtstart]
        #
        # TODO: as_ical_event checks as well for is_day_item
        #
        if { [clock scan $dtend] - [clock scan $dtstart] == 86400
             && [clock format [clock scan $dtstart] -format %H%M] eq "0000"
             && [clock format [clock scan $dtend]   -format %H%M] eq "0000"
         } {
            #ns_log notice "this is an all day event! ${:dtstart} ${:dtend}"
            #we set end to start as this is the way openacs calendar marks all day events
            set :dtend $dtstart
            $item is_day_item set true
        }
        set description [$item get description]
        set location    [$item get location]
        set ical_vars   [$item get ical_vars]

        if {$cal_item_id eq ""} {
            #
            # Create a new item
            #
            :debug "create a new item"
            set cal_item_id [calendar::item::new  -start_date ${dtstart}  -end_date ${dtend}  -name ${summary}  -description $description  -calendar_id $calendar_id  -location $location  -cal_uid $uid  -ical_vars $ical_vars]

            $item add_recurrence -cal_item_id $cal_item_id

        } else {
            #
            # Update an existing item
            #
            :debug "update/edit cal_item_id $cal_item_id uid <$uid> ical_vars $ical_vars"

            calendar::item::edit  -cal_item_id $cal_item_id  -start_date ${dtstart}  -end_date ${dtend}  -name ${summary}  -description ${description}  -location ${location}  -calendar_id $calendar_id  -edit_all_p 1  -ical_vars ${ical_vars}  -cal_uid ${uid}

            set recurrence_id [::xo::dc get_value -prepare integer get_recurrence {
                select recurrence_id from acs_events where event_id = :cal_item_id
            }]

            $item edit_recurrence  -cal_item_id $cal_item_id  -recurrence_id $recurrence_id
        }
    }
::caldav::CalDAV instproc DELETE {} {
        set content [:getcontent {If-Match ""}]
        set url [ns_conn url]
        set user_id ${:user_id}
        # GN TODO: use ${:uri}, use in code ${:user_id}
        ns_log notice "DELETE TODO <${:uri}> vs. <$url>"

        set uid [:get_uid_from_href $url]
        set headers [ns_conn headers]
        #read if-match header which denotes the etag
        set if_match [ns_set get $headers If-Match]
        set calendar_id [::xo::dc get_value private_cal "
    select calendar_id from calendars where private_p = 't' and owner_id = :user_id limit 1" 0]

        :log "UID: $uid, calendar_id: $calendar_id: if_match $if_match"

        set item_exists [calendars get_cal_item_from_uid -calendar_ids $calendar_id $uid]
        ns_log notice "item_exists $item_exists"
        if {[llength $item_exists] > 0} {
            #todo: verify if deletion has finished
            foreach cal_item $item_exists {
                catch {::calendar::item::delete -cal_item_id $cal_item} err
                ns_log notice "calendar item delete: cal_item: $cal_item - err: $err"
            }
            set code 204
            set mimetype "text/plain"
            set response ""
        } else {
            set response [subst {
                <?xml version="1.0" encoding="utf-8" ?>
                <d:multistatus xmlns:d="DAV:">
                <d:response>
                <d:href>$url</d:href>
                <d:status>HTTP/1.1 404 Not Found</d:status>
                </d:response>
                </d:multistatus>}]
            set code 207
            set mimetype "text/xml"
        }
        :response $code $mimetype $response
    }
::caldav::CalDAV instproc property=c-calendar-home-set {res node} {
        return <d:href>${:url}calendar</d:href>
    }
::caldav::CalDAV instproc property=c-calendar-user-address-set {res node} {
        #
        # Identify the calendar addresses of the associated principal resource.
        # return <d:href>${:url}</d:href>
        return ""
    }
::caldav::CalDAV instproc property=d-principal-collection-set {res node} {
        return [subst {<d:href>${:url}principal</d:href>}]
    }
::caldav::CalDAV instproc property=d-current-user-privilege-set {res node} {
        return {
            <d:privilege><d:all /></d:privilege>
            <d:privilege><d:read /></d:privilege>
            <d:privilege><d:write /></d:privilege>
            <d:privilege><d:write-properties /></d:privilege>
            <d:privilege><d:write-content /></d:privilege>
        }
    }
::caldav::CalDAV instproc debug msg {
        ns_log Debug(caldav) "[uplevel self proc]: $msg"
    }
::caldav::CalDAV instproc get_uid_from_href href {
        set uid ""
        regexp {/([^/]+)[.]ics$} $href . uid
        return $uid
    }
::caldav::CalDAV instproc unknown args {
        ns_log notice "CalDAV ${:method} unknown <$args>"
        return ""
    }
::caldav::CalDAV instproc REPORT {} {

        set content [:getcontent]
        set doc [:parseRequest $content]

        if {$doc eq ""} {
            return [:request_error "empty reports are not allowed"]
        }

        #
        # Currently, three reports are supported
        #
        # - calendar-multiget
        # - calendar-query
        # - sync-collection
        #
        $doc documentElement root
        set responses_xml ""

        # TODO: we assume, we are working on the aggregated calendar
        :calendar_ids ""

        if {[$root selectNodes -namespaces {c urn:ietf:params:xml:ns:caldav} "//c:calendar-multiget"] ne ""} {
            set ics_set [:calendar-multiget [$root firstChild]]

        } elseif {[$root selectNodes -namespaces {c urn:ietf:params:xml:ns:caldav} "//c:calendar-query"] ne ""} {
            set ics_set [:calendar-query $root]

        } elseif {[$root selectNodes -namespaces {d DAV:} "//d:sync-collection"] ne ""} {
            set ics_set [:sync-collection $root responses_xml]

        } else {
            #unknown type requested, aborting
            $doc delete
            return [:request_error "request type unknown [$root localName]"]
        }

        set props [$root selectNodes -namespaces {d DAV:} "d:prop"]
        foreach ics $ics_set {
            append responses_xml [:generateResponse -queryType resource -cal_item $ics $props]
        }

        append xml  {<?xml version="1.0" encoding="utf-8"?>} \n {<d:multistatus xmlns:d="DAV:" xmlns:c="urn:ietf:params:xml:ns:caldav" xmlns:cs="http://calendarserver.org/ns">} \n $responses_xml \n </d:multistatus>

        :response 207 text/xml $xml
        $doc delete
    }
::caldav::CalDAV instproc property=c-calendar-timezone {res node} {
        #return [calendars timezone]
        return ""
    }
::caldav::CalDAV instproc property=d-getetag {res node} {
        # An etag is the entity-id of the resource
        if {${:queryType} eq "resource"} {
            # cal_items have already etags precalculated
            return [$res cget -etag]
        }
        # Other resource types (calendars, principal, user) do not have etags
        return ""
    }
::caldav::CalDAV instproc property=d-resourcetype {res node} {
        # Specifies the nature of the resource.
        # todo:resourcetype for single item
        switch ${:queryType} {
            "resource" {
                # single items do not have a resourcetype
                return ""
            }
            "calendar" {
                return <d:collection/><c:calendar/>
            }
            "principal" -
            "default" {
                return <d:collection/>
            }
        }
    }
::caldav::CalDAV instproc calcSyncToken user_id {
        # sync-token is the last modified value for the calendar items
        # needs to be in a format that can be converted back to the original value
        lappend clauses  {*}[calendars communityCalendarClause $user_id]  {*}[calendars alwaysQueriedClause $user_id]

        return [::xo::dc get_value lastmod [subst {
            select date_part('epoch', max(last_modified))::numeric::integer from cal_items ci
            join acs_objects ao on (ao.object_id = ci.cal_item_id) where ci.on_which_calendar in
            ([join $clauses " union "])
        }]]
    }
::caldav::CalDAV instproc property=c-calendar-description {res node} {
        return [ns_quotehtml [:aggregatedCalendarName]]
    }
::caldav::CalDAV instproc aggregatedCalendarName {} {
        set d [site_node::get_from_object_id -object_id [ad_conn subsite_id]]
        set instance_name [lang::util::localize [dict get $d instance_name]]
        set user_name [::xo::get_user_name ${:user_id}]
        return [_ caldav.aggregated_calendar_name  [list instance_name $instance_name user_name $user_name]]
    }
::caldav::CalDAV instproc getcontent {{headers {}}} {
        lappend headers Content-Type ""  User-Agent ""
        foreach {tag default} $headers {
            lappend reportHeaders [list $tag [ns_set iget [ns_conn headers] $tag $default]]
        }
        set content [ns_getcontent -as_file false -binary false]
        set msg "[ns_conn method] ${:uri} ([join $reportHeaders {, }])"
        if {$content ne ""} {
            append msg ":\n$content"
        }
        ns_log Debug(caldav-request) $msg
        return $content
    }
::caldav::CalDAV instproc property=ical-calendar-order {res node} {
        return 1
    }
::caldav::CalDAV instproc property=d-owner {res node} {
        # This  property identifies a particular principal as being the "owner"
        # of the resource.
        #return "<d:href>${:url}</d:href>"
        return ""
    }
::caldav::CalDAV instproc calendar_ids value {
        #
        # When calendar_ids is "", we work on on aggregated
        # (dotlrn-style calendar), when nonempty (single or multiple
        # calendars) we work on concrete calendars
        #
        set :calendar_ids $value
    }
::caldav::CalDAV instproc PROPPATCH {} {

        set content [:getcontent]
        set doc [:parseRequest $content]

        # TODO: we assume, we are working on the aggregated calendar
        :calendar_ids ""

        if {$doc eq ""} {
            return [:request_error "request document invalid:\n$content"]
        }
        set reply ""
        set innerresponse ""

        set root [$doc documentElement]
        set props [$root selectNodes -namespaces ${:namespaces} /d:propertyupdate/d:set/d:prop]
        if {[llength $props] == 0} {
            ns_log Warning "PROPPATCH: invalid request: no property /d:propertyupdate/d:set/d:prop in\n$content"
            set statusCode 400
        } else {
            #
            # Return a multistatus with all properties forbidden.
            #
            foreach n [$props childNodes] {
                append innerresponse [subst {<d:propstat>
                    <d:prop><Z:[$n localName] xmlns:Z="[$n name]"/></d:prop>
                    <d:status>HTTP/1.1 403 Forbidden</d:status>
                    </d:propstat>}]
            }
            set resp [subst {<?xml version="1.0" encoding="utf-8" ?>
                <d:multistatus xmlns:d="DAV:">
                <d:response>
                <d:href>[string trimright [ns_conn url] "/"]</d:href>
                $innerresponse
                </d:response>
                </d:multistatus>}]
            set statusCode 207
        }
        :response $statusCode text/xml $resp
        $doc delete
    }
::caldav::CalDAV instproc PUT {} {
        set content [:getcontent {If-Match ""}]
        set ifmatch [ns_set iget [ns_conn headers] If-Match "*"]

        #
        # The request URI has to end with UID.ics, but we get the
        # actual UID from the ical UID field of the parsed content.
        #
        if {![string match *.ics ${:uri}]} {
            return [:request_error "Trying to PUT on a calendar that does not end with *.ics: ${:uri}"]
        }

        try {
            set sync_calendar_id [::caldav::get_sync_calendar -user_id ${:user_id}]
        } on error {errorMsg} {
            return [:request_error "no private calendar found for ${:user_id}"]
        }

        set items [calendars parse $content]
        :debug "caldav parser returned items <$items>"

        foreach item $items {
            set uid [$item cget -uid]
            :debug [$item serialize]

            if {$ifmatch eq "*"} {
                #
                # Create new entry
                #
                :debug "add a new entry"
                set calendar_id $sync_calendar_id
                #
                # We should probably check, whether we can really
                # write on the calendar in the general case, but here,
                # we know, the sync calendar is always writable for the
                # current user.
                #
                # - GN TODO: not sure, when mutating the UID is necessary, and
                #   whether adding a suffix with the user_id is the best solution.
                #   So we deactivate this code for now....
                #
                if {0} {
                    set user_id ${:user_id}
                    if {[::xo::dc get_value -prepare varchar,integer uid_exists {
                        select 1 from cal_uids u
                        join acs_objects o on (o.object_id = u.on_which_activity)
                        where cal_uid = :uid
                        and o.creation_user != :user_id
                    } 0]} {
                        ad_log warning "uid already exists for another user, suffixing ${uid}-${:user_id}"
                        $item set uid "${uid}-${:user_id}"
                    }
                }
            } else {
                #
                # Update an existing entry
                #
                :debug "update existing entry..."

                lappend clauses  {*}[calendars communityCalendarClause ${:user_id}]  {*}[calendars alwaysQueriedClause ${:user_id}]

                set all_calendar_ids [::xo::dc list read_only_cals [subst {
                    select calendar_id from ([join $clauses " union "]) as cals
                }]]

                set cal_infos [calendars get_calendar_and_cal_item_from_uid -calendar_ids $all_calendar_ids $uid]
                :debug "cal_infos for calendar_ids $all_calendar_ids uid $uid -> <$cal_infos>"

                if {$cal_infos ne ""} {
                    set cal_info [lindex $cal_infos 0]
                    lassign $cal_info calendar_id cal_item_id

                    :debug "write check needed? [expr {$calendar_id ne $sync_calendar_id}]"

                    if {$calendar_id != $sync_calendar_id} {
                        set can_write_p [permission::permission_p -object_id $cal_item_id -privilege write]
                        :debug "write check: $can_write_p (calendar_id $calendar_id, sync_calendar_id $sync_calendar_id)"

                        if {!$can_write_p} {
                            ns_log warning "CalDAV: user tried to perform a PUT on a read only item item: $cal_item_id user ${:user_id}"
                            if {[string match "*CalDavSynchronizer*" ${:user_agent}]} {
                                #
                                # Outlook synchronizer will continue
                                # hammering if 403 is returned,
                                # therefore try a different status
                                # code.
                                #
                                # GN TODO: please check, what happens
                                # with status code 412 on Outlook,
                                # since 202 probably silently swallows
                                # the update, which never happens.
                                #
                                :debug "CalDav: outlook client encountered"
                                set statusCode 202
                            } else {
                                set statusCode 412
                            }
                            return [:response $statusCode text/plain {}]
                        }
                    }
                }
            }
            #
            # save the item
            #
            :debug "updating item [$item cget -uid] in calendar $sync_calendar_id"
            :item_update -calendar_id $sync_calendar_id -item $item

            #ns_log notice "CalDAV PUT: [$item serialize]"
            ns_set put [ns_conn outputheaders] ETag [subst {"[:getETagByUID [$item cget -uid]]"}]
            $item destroy
            :response 201 text/plain {}
            return
        }
        # TODO what happens here
    }
::caldav::CalDAV instproc property=d-displayname {res node} {
        #
        # The displayname property should be defined on all DAV
        # compliant resources. If present, it provides a name for the
        # resource that is suitable for presentation to a user.
        #
        # https://tools.ietf.org/html/rfc2518#section-13.2
        #
        switch ${:queryType} {
            "calendar"  { return [ns_quotehtml [:aggregatedCalendarName]] }
            "resource"  { return [ns_quotehtml [$res cget -summary]] }
            "principal" { return [ns_quotehtml [::xo::get_user_name ${:user_id}]]}
        }
        return ""
    }
::caldav::CalDAV instproc property=d-supported-report-set {res node} {
        return {
            <d:supported-report><d:report><c:calendar-multiget/></d:report></d:supported-report>
            <d:supported-report><d:report><c:calendar-query/></d:report></d:supported-report>
        }
    }
::caldav::CalDAV instproc property=c-calendar-data {res node} {
        #
        # RFC 4791: Given that XML parsers normalize the two character
        # sequence CRLF (US-ASCII decimal 13 and US-ASCII decimal 10)
        # to a single LF character (US-ASCII decimal 10), the CR
        # character (US-ASCII decimal 13) MAY be omitted in calendar
        # object resources specified in the CALDAV:calendar-data XML
        # element.  Therefore, we do not have to do special encoding
        # on the CR.
        #
        # https://tools.ietf.org/html/rfc4791#page-79
        #
        # That being said, the content lines of iCalendar objects specified in
        # the request body of a PUT or in the response body of a GET will still
        # be required to be delimited by a CRLF sequence (US-ASCII decimal 13,
        # followed by US-ASCII decimal 10).
        #
        # https://www.ietf.org/mail-archive/web/caldav/current/msg00551.html

        if {${:queryType} eq "resource"} {
            return [ns_quotehtml [$res as_ical_calendar]]
        } else {
            ns_log warning "CalDav can't return c-calendar-data for ${:queryType}"
        }
    }
::caldav::CalDAV instproc parseRequest content {
        try {
            #dom setResultEncoding utf-8
            set document [dom parse -- $content]
        } on error {errorMsg} {
            ns_log error "CalDAV: parsing of request lead to error: $errorMsg!\n$content"
            throw {DOM PARSE {dom parse triggered exception}} $errorMsg
        }
        return $document
    }
::caldav::CalDAV instproc property=d-sync-token {res node} {
        # set result [:calcSyncToken ${:user_id}]
        return ""
    }
::caldav::CalDAV instproc property=ical-calendar-color {res node} {
        if {${:queryType} eq "calendar"} {
            # GN TODO:do not hard-code colors
            return "#2C5885"
        }
        return ""
    }
::caldav::CalDAV instproc response {code mimetype response} {
        ns_log Debug(caldav-request) "Response ([ns_conn partialtimes]) for ${:method} $code ${:uri}\n$response"
        ns_return $code $mimetype $response
    }
::caldav::CalDAV instproc property=d-getcontenttype {res node} {
        #
        # Contains the Content-Type header returned by a GET without
        # accept headers.
        #
        return "text/calendar; charset=utf-8"
    }
::caldav::CalDAV instproc property=d-principal-address {res node} {
        return <d:href>${:url}principal</d:href>
    }
::caldav::CalDAV instproc property=c-supported-calendar-component-set {res node} {
        #
        # Specifies the calendar component types (e.g., VEVENT,VTODO,
        # VJOURNAL etc.)  that calendar object resources can contain
        # in the calendar collection.  c:comp name="VTODO" />
        #
        return "<c:comp name='VEVENT'/>"
    }
::caldav::CalDAV instproc PROPFIND {} {

        #https://github.com/seiyanuta/busybook/blob/master/Documentation/caldav-request-examples.md
        # Do a PROPFIND on the url the user supplied, requesting {DAV:}current-user-principal.
        # Using this url, you do a PROPFIND to find out more information about the user.
        # Here, you should typically request for the calendar-home-set property in the caldav namespace.
        # Then, using the calendar-home-set, do a PROPFIND (depth: 1) to find the calendars.


        # A client MUST submit a Depth header with a value of "0", "1",
        # or "infinity" with a PROPFIND request.  Servers MUST support
        # "0" and "1" depth requests on WebDAV-compliant resources and
        # SHOULD support "infinity" requests.  Servers SHOULD treat a
        # request without a Depth header as if a "Depth: infinity"
        # header was included.
        #

        set depth [ns_set iget [ns_conn headers] Depth "infinity"]
        #ns_log notice "caldav: depth = $depth"

        set content [:getcontent {Depth "infinity"}]
        set doc [:parseRequest $content]
        ns_log notice "after parseRequest <$content>"
        if {$doc eq ""} {
            return [:request_error "could not parse request. Probably invalid XML"]
        }

        set root [$doc documentElement]
        #
        # Element name of root node must be "propfind"
        #
        if {[$root localName] ne "propfind"} {
            $doc delete
            return [:request_error "invalid request, no <propfind> element"]
        }

        set prop [$root firstChild]
        #
        # child of root must be prop or allprop
        #
        set elementName [$prop localName]
        if {$elementName ni {prop allprop}} {
            $doc delete
            return [:request_error "invalid request, no <prop> or <allprop> element, but '$elementName' provided"]
        }

        #
        # Special case allprop: return all properties
        #
        if {$elementName eq "allprop"} {
            dom parse -- {
                <A:prop xmlns:A="DAV:">
                <A:getcontenttype/>
                <A:getetag/>
                <A:sync-token/>
                <A:supported-report-set/>
                <c:getctag xmlns:c="http://calendarserver.org/ns/"/>
                <A:resourcetype/>
                <B:supported-calendar-component-set xmlns:B="urn:ietf:params:xml:ns:caldav"/>
                <B:calendar-home-set xmlns:B="urn:ietf:params:xml:ns:caldav"/>
                <A:displayname/>
                <A:current-user-principal/>
                </A:prop>
            } propTree
            set prop [$propTree firstChild]
        }

        set response ""

        # The incoming request URI should fall into the following categories
        #
        # - TOPLEVEL:      /caldav
        # - PRINCIPAL:     /caldav/principal
        # - FULL CALENDAR: /caldav/calendar
        #

        # GN TODO: remove the following test when we are sure it is ok.
        #ns_log notice "PROPFIND <${:uri}>, tail <[file tail ${:uri}]> urlv: <${:urlv}>"
        if {[file tail ${:uri}] ne [lindex ${:urlv} end]} {
            ns_log notice "========================== <[file tail ${:uri}]> ne <[lindex ${:urlv} end]>"
            error
        }

        switch [lindex ${:urlv} end] {
            "" {
                ns_log notice "=== CalDAV /caldav/ depth $depth"
                append response [:generateResponse -queryType top -user_id ${:user_id} $prop]
                if {$depth ne "0"} {
                    #
                    # Not sure, what should be sent in such cases. we
                    # could send "principal" or "calendar" replies.

                    ns_log notice "CalDAV /caldav/ query <${:uri}> with depth $depth"
                    #append response [:generateResponse -queryType principal $prop]
                }
            }
            "principal" {
                # A principal is a network resource that represents a distinct human or
                # computational actor that initiates access to network resources.
                # https://tools.ietf.org/html/rfc3744
                append response [:generateResponse -queryType principal $prop]
                #
                # here we ignore depth for the time being
                #
            }
            "calendar" {
                # TODO: we assume, we are working on the aggregated calendar
                :calendar_ids ""

                #set calendar_id [::caldav::get_sync_calendar -user_id ${:user_id}]
                #append response [:generateResponse -queryType calendar -calendar_id $calendar_id $prop]
                append response [:generateResponse -queryType calendar -calendar_id "" $prop]
                #ns_log notice "=== CALENDAR depth $depth FIND getetag=[$prop selectNodes -namespaces {d DAV:} //d:getetag] PROP [$prop asXML] "

                if {$depth ne "0"} {
                    #
                    # Search in depth 1 to deeper. Since all our
                    # calendar data is at depth 1, there is no need to
                    # differentiate.
                    #
                    # GN TODO: In general, PROPFIND on calendars is
                    # needed also without etags, not sure, where the
                    # restriction concerning "etag"comes from.
                    #
                    if {[$prop selectNodes -namespaces {d DAV:} //d:getetag] ne ""} {
                        #
                        # Query attributes containing also etags for
                        # this users' resources
                        #
                        foreach item [calendars get_calitems -user_id ${:user_id}] {
                            append response [:generateResponse -queryType resource -cal_item $item $prop]
                        }
                    } else {
                        ns_log notice "CalDAV: ===== calendar query on components with depth $depth on [$prop asXML]"
                    }
                }
            }
            default {
                $doc delete
                ad_log warning "caldav: PROFIND called for unknown resource: '${:uri}'"
                :response 404 text/plain "no such resource: '${:uri}'"
                return
                #return [:request_error "invalid URI '${:uri}'"]
            }
        }
        # create response
        append resp  {<?xml version="1.0" encoding="utf-8" ?>} \n {<d:multistatus }  {xmlns:d="DAV:" }  {xmlns:cs="http://calendarserver.org/ns/" }  {xmlns:c="urn:ietf:params:xml:ns:caldav" }  {xmlns:ical="http://apple.com/ns/ical/">}  $response  </d:multistatus>

        :response 207 text/xml $resp
        $doc delete
    }
::caldav::CalDAV instproc request_error msg {
        ad_log warning "CalDAV: $msg"
        :response 500 text/plain ""
    }
::caldav::CalDAV instproc calendar-multiget prop {
        #ns_log notice "==== calendar-multiget {$prop}"
        set cal_uids {}
        set act_ids {}

        foreach node [$prop selectNodes -namespaces {d DAV:} //d:href/text()] {
            set href [$node asText]
            set id [:get_uid_from_href $href]
            if {$id eq ""} {
                ns_log notice "CalDAV calendar-multiget: ignore href '$href'"
                continue
            }
            if {[string is integer -strict $id]
                && [::xo::dc get_value -prepare integer is_activity_id {
                    select 1 from acs_activities where activity_id = :id
                } 0] != 0
            } {
                lappend act_ids $id
            } else {
                lappend cal_uids [ns_urldecode $id]
            }
        }

        #
        # GN TODO: it is probably better to use a UNION instead of the
        # construct of "coalesce()" and "OR" below. We need to
        # test/benchmark with a full database with real-world data for
        # this.
        #
        set uid_clauses {}
        if {[llength $cal_uids] > 0} {
            lappend uid_clauses "u.cal_uid in ([ns_dbquotelist $cal_uids])"
        }
        if {[llength $act_ids] > 0} {
            lappend uid_clauses "e.activity_id in ([ns_dbquotelist $act_ids])"
        }
        ns_log notice uid_clauses=$uid_clauses

        set recurrences {}
        set ics_set {}

        #
        # TODO: why not [calendar get_calitems] ?
        #

        foreach row [::xo::dc list_of_lists get_calitems [subst {
            select
            md5(last_modified::text) as etag,
            coalesce(cal_uid, e.activity_id::varchar),
            ical_vars,
            on_which_calendar,
            c.item_type_id,
            to_char(start_date, 'YYYY-MM-DD HH24:MI:SS'),
            to_char(end_date, 'YYYY-MM-DD HH24:MI:SS'),
            coalesce(e.name, a.name),
            coalesce(e.description, a.description),
            c.cal_item_id,
            recurrence_id,
            creation_date,
            last_modified
            from
            acs_objects ao,
            acs_events e
            left outer join cal_uids u on u.on_which_activity = e.activity_id,
            acs_activities a,
            timespans s,
            time_intervals t,
            cal_items c
            where e.event_id = ao.object_id
            and a.activity_id = e.activity_id
            and c.cal_item_id = e.event_id
            and e.timespan_id = s.timespan_id
            and s.interval_id = t.interval_id
            and ( [join $uid_clauses " or "])
            order by start_date asc
        }]] {
            lassign $row etag cal_uid ical_vars calendar_id item_type  start_date end_date name description  cal_item_id recurrence_id creation_date last_modified

            if {$recurrence_id ne "" && $recurrence_id in $recurrences} {
                continue
            }
            # set item [::caldav::calitem new   #               -id $cal_item_id  #               -uid $cal_uid  #               -ical_vars $ical_vars  #               -etag $etag  #               -calendar $calendar_id  #               -creation_date $creation_date  #               -last_modified $last_modified  #               -dtstart $start_date  #               -is_day_item [dt_no_time_p -start_time $start_date -end_time $end_date]  #               -formatted_recurrences [calendars format_recurrence -recurrence_id $recurrence_id]  #               -dtend $end_date  #               -summary $name  #               -description $description  #               -item_type $item_type]
            set item [::caldav::calitem new   -uid $cal_uid  -ical_vars $ical_vars  -etag $etag  -creation_date $creation_date  -last_modified $last_modified  -dtstart $start_date  -is_day_item [dt_no_time_p -start_time $start_date -end_time $end_date]  -formatted_recurrences [calendars format_recurrence -recurrence_id $recurrence_id]  -dtend $end_date  -summary $name  -description $description  ]
            $item destroy_on_cleanup
            lappend ics_set $item
            lappend recurrences $recurrence_id
        }
        return $ics_set
    }
::caldav::CalDAV instproc property=d-principal-URL {res node} {
        #
        # A principal may have many URLs, but there must be one
        # "principal URL" that clients can use to uniquely identify a
        # principal.  This protected property contains the URL that
        # MUST be used to identify this principal in an ACL request.
        #
        return <d:href>${:url}principal</d:href>
    }
::caldav::CalDAV instproc calendar-query root {
        set start ""
        set end ""
        #
        # determine filters
        #
        set time_range [$root selectNodes -namespaces {c urn:ietf:params:xml:ns:caldav} "//c:time-range"]
        #ns_log notice "time-range : $time_range"

        if {$time_range ne ""} {
            if {[$time_range hasAttribute start]} {
                set start [$time_range getAttribute start]
                set start [::xo::ical clock_to_oacstime [::xo::ical utc_to_clock $start]]
            }
            if {[$time_range hasAttribute end]} {
                set end [$time_range getAttribute end]
                set end [::xo::ical clock_to_oacstime [::xo::ical utc_to_clock $end]]
            }
        }
        ns_log notice "calendar-query: start time $start end time $end"

        #
        # components
        #
        set time_range [$root selectNodes -namespaces {c urn:ietf:params:xml:ns:caldav} "//c:comp-filter"]
        set fetch_vtodos 0
        set fetch_vevents 0
        foreach x $time_range {
            if {[$x getAttribute name] eq "VEVENT"} {set fetch_vevents 1}
            if {[$x getAttribute name] eq "VTODO"} {set fetch_vtodos 1}
        }
        set ics_set ""
        if {$fetch_vevents} {
            set ics_set [calendars get_calitems -user_id ${:user_id} -start_date $start -end_date $end]
        }
        return $ics_set
    }
::caldav::CalDAV instproc sync-collection {root extraXMLvar} {
        upvar $extraXMLvar extraXML

        set props [$root selectNodes -namespaces {d DAV:} "//d:prop"]
        #set sync_level_node [$root selectNodes -namespaces {d DAV:} "//d:sync-level"]
        set sync_token_node [$root selectNodes -namespaces {d DAV:} "//d:sync-token"]
        if {$sync_token_node ne ""} {
            set sync_token [$sync_token_node text]
        } else {
            set sync_token ""
        }
        :debug "received sync-token <$sync_token>"

        #
        # Calculate a new sync token and return this as extraXML
        #
        set new_sync_token [:calcSyncToken ${:user_id}]
        set extraXML <d:sync-token>$new_sync_token</d:sync-token>

        if {$sync_token eq ""} {
            #
            # return all cal_items
            #
            set ics_set [calendars get_calitems -user_id ${:user_id}]

        } elseif {$sync_token ne $new_sync_token} {
            #
            # return cal_items since last sync_token
            #
            set ics_set [calendars get_calitems  -user_id ${:user_id}  -start_date [ns_fmttime $sync_token "%Y-%m-%d 00:00"]  -end_date [ns_fmttime $new_sync_token "%Y-%m-%d 00:00"]]
        } else {
            #
            # return cal_items since the day of the sync_token
            #
            set ics_set [calendars get_calitems  -user_id ${:user_id}  -start_date [ns_fmttime $sync_token "%Y-%m-%d 00:00"]]
        }
        return $ics_set
    }
::caldav::CalDAV instproc getETagByUID uid {
        #note: last_modified is updated for the acs_event/cal_item object_id, not the acs_activity
        #when has this collection item been modified the last time?
        # TODO: do we need "max()"? 2 times
        set c_uid [::xo::dc get_value -prepare varchar select_last_modified_uid {
            select max(md5(last_modified::text))
            from cal_uids c, acs_objects ao, acs_events e
            where c.on_which_activity = e.activity_id
            and e.event_id = ao.object_id
            and cal_uid = :uid
        }]
        # fallback for events without an uid
        if {$c_uid eq "" && [string is integer -strict $uid]} {
            set c_uid [::xo::dc get_value -prepare integer select_last_modified_uid {
                select max(md5(last_modified::text))
                from  acs_objects ao, acs_events e
                where e.event_id = ao.object_id
                and e.activity_id = :uid
            }]
        }
        return $c_uid
    }
::caldav::CalDAV instproc property=d-current-user-principal {res node} {
        #
        # Indicates a URL for the currently authenticated user's
        # principal resource on the server.
        #
        return <d:href>${:url}principal</d:href>
    }
::caldav::CalDAV instproc calendarName {} {
        :debug "calendarName has :calendar_ids <${:calendar_ids}>"
        if {${:calendar_ids} eq ""} {
            set calendar_name [:aggregatedCalendarName]
        } else {
            calendar::get -calendar_id [lindex ${:calendar_ids} 0] -array calinfo
            #:debug "calinfo of [lindex ${:calendar_ids} 0]: [array get calinfo]"
            set calendar_name $calinfo(calendar_name)
        }
        return $calendar_name
    }
::caldav::CalDAV instproc returnXMLelement {resource node} {
        #
        #
        set property [$node localName]
        set ns       [$node name]
        :debug "<$property> <$ns> resource $resource queryType <${:queryType}>"

        if {[info exists :xmlns($ns)]} {
            set outputNs [set :xmlns($ns)]
            set methodName property=$outputNs-$property
            #:debug "call method $methodName"
            try {
                set value [:$methodName $resource $node]
                :debug "<$property> <$ns> resource $resource queryType <${:queryType}> -> '$value'"
            } on error {errorMsg} {
                ns_log warning "CalDAV returnXMLelement: call method $methodName raised exception: $errorMsg"
                set value ""
            }
            if {$value eq ""} {
                set result [list 1 <${outputNs}:$property/>]
                #:debug "${:method} query $methodName returns empty (probably not found)"
            } else {
                set result [list 0 <${outputNs}:$property>$value</${outputNs}:$property>]
            }
        } else {
            ns_log warning "CalDAV: client requested a element with unknown namespace $ns known ([array names :xmlns])"
            set result [list 1 [subst {<[$node nodeName] xmlns:[$node prefix]="[$node namespaceURI]"/>}]]
        }
        return $result
    }
::caldav::CalDAV instproc property=cs-getctag {res node} {
        # Specifies a "synchronization" token used to indicate when
        # the contents of a calendar or scheduling Inbox or Outbox
        # collection have changed.
        if {${:queryType} eq "calendar"} {
            return [:calcCtag ${:user_id}]
        } else {
            return ""
        }
    }
::caldav::CalDAV instproc OPTIONS {} {
        # A minimal definition for OPTIONS. Extend if necessary.
        set content [:getcontent]
        ns_set put [ns_conn outputheaders] DAV "1,2,access-control,calendar-access"
        ns_set put [ns_conn outputheaders] Allow "OPTIONS,GET,DELETE,PROPFIND,PUT,REPORT"
        ns_set put [ns_conn outputheaders] Cache-Control "no-cache"
        # return the response
        :response 200 "text/plain" {}
    }
::caldav::CalDAV instproc GET {} {
        # the following getcontent call is just for consistent logging
        :getcontent
        #
        #
        set tail [lindex ${:urlv} end]
        set mimetype "text/calendar"
        set code 404
        set resp ""
        :debug ":urlv [list ${:urlv}]"

        if {[file extension $tail] eq ".ics"} {
            #
            # Retrieve a single item identified by an UID
            #
            set uid [:get_uid_from_href ${:uri}]
            :debug "return single calendar item for uid $uid"

            #
            # We need the calendar_ids for consistent naming of
            # calendars (aggregated, etc.)....
            #
            if {[string is integer -strict [lindex ${:urlv} end-1]]} {
                set calendar_ids [lindex ${:urlv} end-1]
            } else {
                set calendar_ids ""
            }
            :calendar_ids $calendar_ids

            #
            # GN TODO: running two queries is not optimal but having
            # these separate eases type mismatch.
            #
            #    cal_uids(cal_uid, on_which_activity references acs_activities(activity_id), ical_vars)
            #    cal_items(cal_item_id references acs_events(event_id), on_which_calendar, ...)
            #    acs_events(event_id, ..., activity_id references acs_activities(activity_id), ...)
            #
            set cal_items [::xo::dc list_of_lists -prepare varchar get_calitem {
                select e.event_id as cal_item_id, u.ical_vars, a.creation_date, a.last_modified
                from   cal_uids u, acs_events e, acs_objects a
                where  u.cal_uid = :uid
                and    e.activity_id = u.on_which_activity
                and    a.object_id = e.event_id
                limit 1
            }]
            :debug "cal_items 1 (join on <$uid>): <$cal_items>"
            if {[llength $cal_items] == 0 && [string is integer -strict $uid]} {
                set cal_items [::xo::dc list_of_lists -prepare integer get_calitem {
                    select e.event_id as cal_item_id, '' as ical_vars, a.creation_date, a.last_modified
                    from   acs_events e, acs_objects a
                    where  e.activity_id = :uid
                    and    a.object_id = e.event_id
                    limit 1
                }]
            }

            #:debug "cal_items 2: <$cal_items>"
            if {[llength $cal_items] == 1} {
                lassign [lindex $cal_items 0] cal_item_id ical_vars creation_date last_modified
                calendar::item::get -cal_item_id $cal_item_id -array c
                :debug "calendar::item::get -cal_item_id $cal_item_id->\n[array get c]"
                set vevent [calitem new   -uid $uid  -creation_date $creation_date  -last_modified $last_modified  -dtstart $c(start_date_ansi)  -is_day_item [dt_no_time_p -start_time $c(start_date_ansi) -end_time $c(end_date_ansi)]  -formatted_recurrences [calendars format_recurrence -recurrence_id $c(recurrence_id)]  -dtend $c(end_date_ansi)  -ical_vars $ical_vars  -location $c(location)  -summary $c(name)  -description $c(description)]
                unset -nocomplain c
                append resp [$vevent as_ical_calendar -calendar_name [:calendarName]]
                $vevent destroy

                # GN TODO: do we need always the database to get an etag ?
                ns_set put [ns_conn outputheaders] ETag [subst {"[:getETagByUID $uid]"}]
                set code 200
            } else {
                #
                # Nothing found or a weird result (multiple items). If
                # nothing is found, we have the error status code from
                # above. On too many results, raise an exception.
                #
                if {[llength $cal_items] > 1} {
                    error "cal_item query based on cal_uid $uid lead to multiple results [llength $cal_items]"
                }
            }
        } else {
            #
            # Retrieve a calendar.
            #
            # This query is run currently without a time constraints.
            #
            # GN TODO: not sure, returning always the full calendar is
            # a good idea, my personal calendar has more than 10 years
            # of data ... but maybe this is not often executed.
            #
            # The query parameter "calendar_ids" is used e.g. for
            # regression testing.
            #
            # GN TODO:
            #
            if {[llength ${:urlv}] > 1} {
                set calendar_ids [lindex ${:urlv} 1]
            } else {
                set calendar_ids [ns_queryget calendar_ids ""]
            }
            :calendar_ids $calendar_ids

            if {$calendar_ids ne ""} {
                #
                # For specified calendars, return the calendar name of
                # the first calendar_id
                #
                set calendar_query "-calendar_ids $calendar_ids"
            } else {
                set calendar_query ""
            }
            set resp [calendars header -calendar_name [:calendarName]]
            foreach item [calendars get_calitems -user_id ${:user_id} {*}$calendar_query] {
                append resp [$item as_ical_event]
            }
            append resp [calendars footer]
            set code 200
        }
        :response $code $mimetype $resp

    }
::caldav::CalDAV instproc generateResponse {-queryType:required -user_id -calendar_id -cal_item node} {
        # @prop: requested properties as tdom nodes
        # generate xml for this resource

        #ns_log notice "generateResponse $queryType"
        set :queryType $queryType
        switch $queryType {
            "resource" {
                set href "${:url}calendar/[ns_urlencode [$cal_item cget -uid]].ics"
                set resource $cal_item
            }
            "calendar" {
                set href "${:url}calendar/"
                set resource $calendar_id
            }
            "top" {
                set href ${:url}
                set resource $user_id
            }
            "principal" {
                set href "${:url}principal"
                set resource "none"
            }
            "default" {
                error "invalid input"
            }
        }
        ns_log notice "generateResponse href=$href, resource=$resource child nodes [llength [$node childNodes]]"
        set not_found_props ""
        set found_props ""
        foreach childNode [$node childNodes] {
            lassign [:returnXMLelement $resource $childNode] returncode val
            if {$returncode} {
                append not_found_props $val \n
            } else {
                append found_props $val \n
            }
        }
        :debug "found_props $found_props, not_found_props $not_found_props"
        append result  <d:response> \n  <d:href>$href</d:href> \n

        if {$found_props ne ""} {
            #
            # return 200 for properties that were found
            #
            append result  <d:propstat> \n  <d:prop>$found_props</d:prop> \n  "<d:status>HTTP/1.1 200 OK</d:status>" \n  </d:propstat>
        }

        if {$not_found_props ne ""} {
            #
            # return 404 for properties that were not found
            #
            append result \n <d:propstat> \n <d:prop>$not_found_props</d:prop> \n "<d:status>HTTP/1.1 404 Not Found</d:status>" \n </d:propstat>
        }
        append result \n </d:response>
        return $result
    }
::caldav::CalDAV instproc calcCtag user_id {
        lappend clauses  {*}[calendars communityCalendarClause $user_id]  {*}[calendars alwaysQueriedClause $user_id]
        #ns_log notice "calendar_clause [join $clauses { union }]"
        return [::xo::dc get_value lastmod [subst {
            select md5(sum(cal_item_id)::text || max(last_modified)::text)
            from   cal_items ci
            join   acs_objects ao on (ao.object_id = ci.cal_item_id)
            where  ci.on_which_calendar in
            ([join $clauses " union "])
        }]]
    }
::caldav::CalDAV instparametercmd url
::nsf::relation::set ::caldav::CalDAV superclass ::xo::ProtocolHandler

::nx::slotObj -container slot ::caldav::CalDAV
::caldav::CalDAV::slot eval {set :__parameter {
        {url /caldav/}
    }}

::nsf::object::alloc ::xotcl::Attribute ::caldav::CalDAV::slot::url {set :accessor public
   set :configurable true
   set :convert false
   set :default /caldav/
   set :defaultmethods {}
   set :disposition alias
   set :domain ::caldav::CalDAV
   set :incremental 0
   set :manager ::caldav::CalDAV::slot::url
   set :methodname url
   set :multiplicity 1..1
   set :name url
   set :parameterSpec {-url:substdefault /caldav/}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

XQL Not present:

Generic, PostgreSQL, Oracle