Add `parse-cookies' procedure.

1 files changed, 32 insertions, 0 deletions

diff --git a/src/guile/cantius.scm b/src/guile/cantius.scm
index 76cc5fa..8afb276 100644
--- a/src/guile/cantius.scm
+++ b/src/guile/cantius.scm
@@ -246,6 +246,38 @@
 
 
 
+;;;
+;;; Cookie parser
+;;;
+
+(define %cookie-regex
+  (make-regexp (string-append
+                "^\\s*"
+                "([^[:space:];=]([^;=]*[^[:space:];=])?)" ;; name
+                "\\s*=\\s*"
+                "(([^[:space:];]([^;]*[^[:space:];])?)?)" ;; value
+                "\\s*(;|$)")))
+
+(define-public (parse-cookies cookies)
+  (let loop ((idx 0)
+             (cookies-alist '()))
+    (match (regexp-exec %cookie-regex cookies idx)
+
+      (#f
+       (when (string-index cookies char-set:graphic idx)
+         (raise (s35:condition
+                 (&bad-request)
+                 (s35:&message
+                  (message "Unparseable cookie")))))
+       (reverse cookies-alist))
+
+      ((and (= (cut match:substring <> 1) name)
+            (= (cut match:substring <> 3) value)
+            (= match:end idx*))
+       (loop idx* `((,name . ,value) . ,cookies-alist))))))
+
+
+
 (define-public %current-path
   (make-parameter #f))