blob: 83725825216c3230908bcbec3c578447d07c0918 (
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
|
(define-module (calp webdav propfind)
:use-module (calp webdav property)
:use-module (calp webdav resource)
:use-module (calp namespaces)
:use-module (srfi srfi-1)
:use-module (sxml namespaced)
:use-module (sxml namespaced util)
: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)))
(define (find-element target list)
(define target* (xml-element-hash-key target))
(find (lambda (x) (and (list? x)
(not (null? x))
(xml-element? (car x))
(equal? target* (xml-element-hash-key (car x)))))
list))
;; Takes a propfind xml element (tree), and a webdav resource object.
;; Returns a list of <propstat> objects.
(define (parse-propfind sxml resource)
;; (assert (list? sxml))
;; (assert (not (null? sxml)))
;; (assert eq? 'd:propfid (car sxml))
(let ((propname (find-element (xml webdav 'propname) (cdr sxml)))
(allprop (find-element (xml webdav 'allprop) (cdr sxml)))
(include (find-element (xml webdav 'include) (cdr sxml)))
(prop (find-element (xml webdav 'prop) (cdr 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
(map car (cdr include)))))
(allprop
;; Return "all" properties
(append (propfind-most-live-properties resource)
(propfind-all-dead-properties resource)))
(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))))))
(prop
;; Return the properties listed
(propfind-selected-properties
resource
(map car (cdr prop))))
(else
(scm-error 'bad-request "parse-propfind"
"Invalid search query ~s" (list sxml) (list sxml)))))))
|
