blob: b563fdac70d2401238c10d015c1e3f37446ddc2c (
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
|
(define-module (ldp resource unsafe update)
#:use-module (ldp resource)
#:use-module (ldp resource unsafe save)
#:use-module (ldp resource load)
#:use-module (ldp etag)
#:use-module (ldp path)
#:use-module (ldp precondition)
#:use-module (turtle tordf)
#:use-module (rdf rdf)
#:use-module (rnrs bytevectors)
#:use-module (web uri))
(define (check-triple triple)
(not (equal? (rdf-triple-predicate triple)
"http://www.w3.org/ns/ldp#contains")))
(define (check-graph graph)
(or (null? graph)
(and (check-triple (car graph))
(check-graph (cdr graph)))))
(define (check-container-content path content)
(when (bytevector? content)
(set! content (utf8->string content)))
(let ((graph (turtle->rdf (string-append "# This is not a file name."
content)
(uri->string (path->uri path)))))
(unless (check-graph graph)
(throw 'conflict))))
(define-public (initialize-root)
(catch 'not-found
(lambda ()
(load "")
#t)
(lambda error
(save (make-resource (string->path "")
(generate-etag)
'text/turtle
'())
"")
(initialize-root))))
(define-public (change-contained path precondition added removed)
(call-with-values (lambda () (load path))
(lambda (resource _port _triples)
(unless (container? resource)
(throw 'cannot-add-resources-in-non-container))
(unless (precondition-valid? precondition (resource-etag resource))
(throw 'precondition-failed))
(let ((updated (update-children resource added removed)))
(save-manifest updated)))))
(define-public (change-representation path precondition content-type content)
(call-with-values (lambda () (load path))
(lambda (resource _port _triples)
(unless (precondition-valid? precondition (resource-etag resource))
(throw 'precondition-failed))
(let ((updated (make-resource path
(generate-etag)
content-type
(resource-contained resource))))
(when (container? updated)
(check-container-content path content))
(save updated content)))))
(define-public (delete path precondition)
(call-with-values (lambda () (load path))
(lambda (resource _port _triples)
(unless (precondition-valid? precondition (resource-etag resource))
(throw 'precondition-failed))
(unless (or (not (resource-contained resource))
(null? (resource-contained resource)))
(throw 'non-empty-container))
(unless (not (is-root? path))
(throw 'cannot-delete-the-root))
(change-contained (path-parent path)
(make-precondition #f #f)
'()
(list path)))))
(define-public (mkcont-recursive path)
(catch 'not-found
(lambda ()
(call-with-values (lambda () (load path))
(lambda (_resource _port _triples)
#t)))
(lambda error
(unless (is-root? path)
(mkcont-recursive (path-parent path)))
(save (make-resource path
(generate-etag)
'text/turtle
'())
""))))
|
