blob: 220b84d3158d449f4d92e3ffd51b21f41de378ee (
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
(define-module (test webdav-propfind)
:use-module ((hnh util) :select (sort*))
:use-module ((calp namespaces) :select (webdav))
:use-module (hnh util type)
:use-module (hnh util lens)
:use-module (calp webdav property)
:use-module (calp webdav propfind)
:use-module (calp webdav resource virtual)
:use-module (datetime)
:use-module (oop goops)
:use-module (srfi srfi-64)
:use-module (srfi srfi-88)
:use-module (sxml namespaced)
)
(define (sort-symbols symbs)
(sort* symbs string<=? symbol->string))
;;; Propstats are unsorted, we just sort them here for easier
;;; equivalence checks in the tests.
(define (sort-propstats propstats)
(map
(lambda (pr)
(typecheck pr propstat?)
(modify pr propstat-property*
(lambda (it)
(sort* it
string< (compose symbol->string xml-element-tagname)))))
(sort* propstats < propstat-status-code)))
(define dt #2010-11-12T13:14:15)
(define resource (make <virtual-resource>
;; local-path: '("")
name: "*root"
content: #vu8(1 2 3 4)
creation-time: dt))
(define ns1 (string->symbol "http://example.com/namespace"))
(test-group "\"All\" live properties"
(let ((most (propfind-most-live-properties resource)))
(test-equal "Correct amount of keys" 10 (length most))
(for-each (lambda (propstat)
(test-assert "Propstat is propstat" (propstat? propstat))
(test-equal (format #f "Propstat well formed: ~a" (propstat-property propstat))
1 (length (propstat-property propstat)))
(test-assert "Propstat child is xml"
(xml-element? (car (propstat-property propstat)))))
most)
(test-equal "Correct keys"
'(creationdate displayname getcontentlanguage getcontentlength
getcontenttype getetag getlastmodified
lockdiscovery resourcetype supportedlock)
(sort-symbols (map (compose xml-element-tagname car propstat-property)
most)))))
(test-equal "propfind-selected-properties"
(list (propstat 404 (list ((xml webdav 'displayname)))))
(propfind-selected-properties resource (list ((xml webdav 'displayname)))))
(test-group "parse-propfind"
(test-group "propname"
(let ((props (parse-propfind ((xml webdav 'propfind)
((xml webdav 'propname)))
resource)))
(test-group "Propfind should NEVER fail for an existing resource"
(test-equal 1 (length props))
(test-equal 200 (propstat-status-code (car props))))
(test-assert "Propstat objects are returned" (propstat? (car props)))
(for-each (lambda (el)
(test-assert "Each entry is an xml element" (xml-element*? el))
(test-eqv "The enrties lack children" 0 (length (xml-element-children el))))
(propstat-property (car props)))
#;
(test-equal "Correct property keys"
(sort-symbols (cons* 'test 'is-virtual webdav-keys))
(sort-symbols (map (compose xml-element-tagname car)
(propstat-property (car props)))))
))
(test-group "direct property list"
(let ((props (parse-propfind ((xml webdav 'propfind)
((xml webdav 'prop)
((xml webdav 'displayname))))
resource)))
(test-equal "Simple lookup"
(list (propstat 404 (list ((xml webdav 'displayname)))))
props)))
;; TODO test that calendar properties are reported by propname
;; TODO test that non-native caldav propreties aren't reported by allprop
(test-group "allprop"
(let ((props (parse-propfind ((xml webdav 'propfind)
((xml webdav 'allprop)))
resource)))
(test-equal "Propfind result"
(list
(propstat 200
(list ((xml webdav 'creationdate)
(datetime->string dt "~Y-~m-~dT~H:~M:~SZ"))
((xml webdav 'getcontentlength)
"4")
((xml webdav 'getcontenttype)
"application/binary")
((xml webdav 'getlastmodified)
"Thu, 01 Jan 1970 00:00:00 GMT")
((xml webdav 'lockdiscovery))
((xml webdav 'resourcetype)
; (list (xml webdav 'collection))
)
((xml webdav 'supportedlock))
;; (list (xml ns1 'test) "Content")
))
(propstat 404 (list ((xml webdav 'displayname))
((xml webdav 'getcontentlanguage))))
(propstat 501
(list ((xml webdav 'getetag)))))
(sort-propstats props))))
(test-group "allprop with include"
(let ((props (parse-propfind ((xml webdav 'propfind)
((xml webdav 'allprop))
((xml webdav 'include)))
resource)))
(test-equal "Include NOTHING"
(list
(propstat 200
(list ((xml webdav 'creationdate)
(datetime->string dt "~Y-~m-~dT~H:~M:~SZ"))
((xml webdav 'getcontentlength)
"4")
((xml webdav 'getcontenttype)
"application/binary")
((xml webdav 'getlastmodified)
"Thu, 01 Jan 1970 00:00:00 GMT")
((xml webdav 'lockdiscovery))
((xml webdav 'resourcetype)
; (list (xml webdav 'collection))
)
((xml webdav 'supportedlock))
;; (list (xml ns1 'test) "Content")
))
(propstat 404 (list ((xml webdav 'displayname))
((xml webdav 'getcontentlanguage))))
(propstat 501
(list ((xml webdav 'getetag))
)))
(sort-propstats props)))
(let ((props (parse-propfind ((xml webdav 'propfind)
((xml webdav 'allprop))
((xml webdav 'include)
((xml virtual-ns 'isvirtual))))
resource)))
(test-equal "Include isvirtual"
(list
(propstat 200
(list ((xml webdav 'creationdate) (datetime->string dt "~Y-~m-~dT~H:~M:~SZ"))
((xml webdav 'getcontentlength) "4")
((xml webdav 'getcontenttype) "application/binary")
((xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT")
((xml virtual-ns 'isvirtual) "true")
((xml webdav 'lockdiscovery))
((xml webdav 'resourcetype))
((xml webdav 'supportedlock))
;; (list (xml ns1 'test) "Content")
))
(propstat 404 (list ((xml webdav 'displayname))
((xml webdav 'getcontentlanguage))))
(propstat 501 (list ((xml webdav 'getetag)))))
(sort-propstats props)))))
(test-equal
(list (propstat 200
(list ((xml webdav 'getcontentlength) "4")
((xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT")
((xml webdav 'resourcetype))))
(propstat 404
(list ((xml webdav 'checked-in))
((xml webdav 'checked-out))
((xml (string->symbol "http://apache.org/dav/props/") 'executable)))))
(let ((request (xml->namespaced-sxml
"<?xml version=\"1.0\" encoding=\"utf-8\"?>
<propfind xmlns=\"DAV:\">
<prop>
<getcontentlength/>
<getlastmodified/>
<executable xmlns=\"http://apache.org/dav/props/\"/>
<resourcetype/>
<checked-in/>
<checked-out/>
</prop>
</propfind>")))
(sort-propstats (parse-propfind (xml-document-root request) resource))))
(test-equal "All dead properties"
(list #;
(propstat 200 (list (list (xml ns1 'test) "Content") ;
)))
(propfind-all-dead-properties resource))
'((calp webdav propfind))
|
