blob: e6becafd490f5b25f5f39ff8b3cd1dd841c0e00f (
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
|
(define-module (calp webdav propfind)
:use-module (calp webdav property)
:use-module (calp webdav resource)
:use-module (sxml match)
:use-module (sxml namespaced)
: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)
(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)
(map (lambda (p) ((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)
(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)
(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 namespaces resource)
(merge-propstats
;; TODO Allow *TOP* and *PI*?
(sxml-match sxml
((d:propfind (d:propname))
;; Return the list of available properties
(list (propstat
200
;; car to get tagname, list to construct a valid xml element
(map (compose list car)
(append
(dead-properties resource)
(live-properties resource))))))
((d:propfind (d:allprop))
;; Return "all" properties
(append
(propfind-most-live-properties resource)
(propfind-all-dead-properties resource)))
((d:propfind (d:allprop) (d:include ,properties ...))
;; Return "all" properties + those noted by <include/>
(append
(propfind-most-live-properties resource)
(propfind-all-dead-properties resource)
(propfind-selected-properties
resource
(map (lambda (prop) (car (sxml->namespaced-sxml prop namespaces)))
properties))))
((d:propfind (d:prop ,properties ...))
;; Return the properties listed
(propfind-selected-properties
resource
(map (lambda (prop) (car (sxml->namespaced-sxml prop namespaces)))
properties)))
(,default (scm-error 'bad-request "parse-propfind"
"Invalid search query ~s" (list default) (list default)))
)))
|
