blob: f2aab8d4436b63f8cf0f665fc1b0307224e18c07 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
(define-module (calp webdav propfind)
:use-module (calp webdav property)
:use-module (calp webdav resource)
:use-module ((calp webdav resource base) :select (resource?))
:use-module (calp namespaces)
:use-module (srfi srfi-1)
:use-module (sxml namespaced)
:use-module (sxml namespaced util)
:use-module ((hnh util) :select (->))
:use-module ((hnh util table) :select (table))
:use-module (hnh util type)
:export (propfind-selected-properties
propfind-all-live-properties
propfind-most-live-properties
propfind-all-dead-properties
parse-propfind
))
;;; Commentary:
;;; Procedures for the WebDav PROPFIND method
;;; Code:
;; Properties should be a list of xml-tag-elements
;; return a list of propstat elements
;; work for both dead and alive objects
(define (propfind-selected-properties resource properties)
(typecheck resource resource?)
(typecheck properties (list-of xml-element?))
(map (lambda (el) (get-property resource el))
properties))
;; (define-method (supported-properties (self <resource>))
;; (map (lambda (v) (cons webdav v))
;; `()))
;; Returns a list of <propstat> objects.
(define (propfind-all-live-properties resource)
(typecheck resource resource?)
(map (lambda (p) ((property-getter (cdr p)) resource))
(live-properties resource)))
;; Returns a list of <propstat> objects.
;; The list being the live properties defined by [WEBDAV]
(define (propfind-most-live-properties resource)
(typecheck resource resource?)
(map (lambda (p) ((property-getter (cdr p)) resource))
webdav-properties))
;; Returns a list of <propstat> objects.
;; All "dead" properties on resource.
(define (propfind-all-dead-properties resource)
(typecheck resource resource?)
(map (lambda (v) (propstat 200 (list v)))
(dead-properties resource)))
;; Takes a propfind xml element (tree), and a webdav resource object.
;; Returns a list of <propstat> objects.
(define (parse-propfind sxml resource)
(typecheck sxml xml-element?)
(typecheck resource resource?)
(let ((propname (find-child ((xml webdav 'propname)) (xml-element-children sxml)))
(allprop (find-child ((xml webdav 'allprop)) (xml-element-children sxml)))
(include (find-child ((xml webdav 'include)) (xml-element-children sxml)))
(prop (find-child ((xml webdav 'prop)) (xml-element-children sxml))))
(merge-propstats
(cond ((and allprop include)
;; Return "all" properties + those noted by <include/>
(append (propfind-most-live-properties resource)
(propfind-all-dead-properties resource)
(propfind-selected-properties
resource
(xml-element-children include))))
(allprop
;; Return "all" properties
(append (propfind-most-live-properties resource)
(propfind-all-dead-properties resource)))
(propname
;; Return the list of available properties
;; each entry is an xml element, with no content
(list (propstat
200
(append
(map (lambda (el) (-> el (children '()) (properties (table))))
(dead-properties resource))
(map car (live-properties resource))))))
(prop
;; Return the properties listed
(propfind-selected-properties
resource
(xml-element-children prop)))
(else
(scm-error 'bad-request "parse-propfind"
"Invalid search query ~s" (list sxml) (list sxml)))))))
|
