Check client conditional request

2 files changed, 78 insertions, 2 deletions

diff --git a/src/scm/webid-oidc/server/Makefile.am b/src/scm/webid-oidc/server/Makefile.am
index 2f14df5..f6627e5 100644
--- a/src/scm/webid-oidc/server/Makefile.am
+++ b/src/scm/webid-oidc/server/Makefile.am
@@ -1,9 +1,11 @@
 dist_serverwebidoidcmod_DATA += \
   %reldir%/create.scm \
-  %reldir%/read.scm
+  %reldir%/read.scm \
+  %reldir%/precondition.scm
 
 serverwebidoidcgo_DATA += \
   %reldir%/create.go \
-  %reldir%/read.go
+  %reldir%/read.go \
+  %reldir%/precondition.go
 
 include %reldir%/resource/Makefile.am
diff --git a/src/scm/webid-oidc/server/precondition.scm b/src/scm/webid-oidc/server/precondition.scm
new file mode 100644
index 0000000..94c6ae1
--- /dev/null
+++ b/src/scm/webid-oidc/server/precondition.scm
@@ -0,0 +1,74 @@
+(define-module (webid-oidc server precondition)
+  #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc server resource path)
+  #:use-module (webid-oidc server resource content)
+  #:use-module (webid-oidc cache)
+  #:use-module (webid-oidc fetch)
+  #:use-module (webid-oidc http-link)
+  #:use-module (webid-oidc server resource wac)
+  #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module (webid-oidc rdf-index)
+  #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
+  #:use-module (web uri)
+  #:use-module (web client)
+  #:use-module (web response)
+  #:use-module (rdf rdf)
+  #:use-module (turtle tordf)
+  #:use-module (turtle fromrdf)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 threads)
+  #:use-module (rnrs bytevectors)
+  #:use-module (oop goops)
+  #:export
+  (
+
+   check-precondition
+
+   ))
+
+(define (the-etag object)
+  ;; Sometimes the user passes a pair as an etag (just like what
+  ;; request-if-match may return).
+  (if (pair? object)
+      (car object)
+      object))
+
+(define (check-if-match if-match real-etag)
+  ;; if-match is #f if no filter is used
+  (or (not if-match)
+      (eq? if-match '*)
+      (let check-rest ((precondition if-match))
+        (and (not (null? precondition))
+             (let ((first (the-etag (car precondition)))
+                   (rest (cdr precondition)))
+               (or (equal? first real-etag)
+                   (check-rest rest)))))))
+
+(define (check-if-none-match if-none-match real-etag)
+  ;; if-none-match is #f if there is no filter
+  (or (not if-none-match)
+      (if (eq? if-none-match '*)
+          (not real-etag)
+          ;; if-none-match is a list
+          (let check-rest ((forbidden if-none-match))
+            (or (null? forbidden)
+                (let ((first (the-etag (car forbidden)))
+                      (rest (cdr forbidden)))
+                  (and (not (equal? first real-etag))
+                       (check-rest rest))))))))
+
+(define (check-precondition path if-match if-none-match real-etag)
+  (unless (and (check-if-match if-match real-etag)
+               (check-if-none-match if-none-match real-etag))
+    (let ((error
+           (make-precondition-failed path if-match if-none-match real-etag)))
+      (unless real-etag
+        (set! error
+              (make-exception error (make-path-not-found path))))
+      (raise-exception error))))