aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-09 10:17:29 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-09 10:17:29 +0200
commitfb04413bfce4f910509ba0cce60dea124b0f1a16 (patch)
treeabf2ef0850692d1d9657adbd2bf64a20a736e97d
parentDynamicaly created popups now work. (diff)
downloadcalp-fb04413bfce4f910509ba0cce60dea124b0f1a16.tar.gz
calp-fb04413bfce4f910509ba0cce60dea124b0f1a16.tar.xz
Can create events with åäö again.
-rw-r--r--module/entry-points/server.scm3
-rw-r--r--module/server/macro.scm11
-rw-r--r--module/server/util.scm6
3 files changed, 14 insertions, 6 deletions
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 054c8cbd..7a753b8b 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -61,6 +61,9 @@
(cdr (scandir dir))))))
+;; TODO ensure encoding on all fields which take user provided data.
+;; Possibly a fallback which strips everything unknown, and treats
+;; the bytevector as ascii.
(define (make-make-routes)
(make-routes
diff --git a/module/server/macro.scm b/module/server/macro.scm
index ba70a484..99272a75 100644
--- a/module/server/macro.scm
+++ b/module/server/macro.scm
@@ -87,8 +87,13 @@
(append
(parse-query r:query)
- (when (memv 'application/x-www-form-urlencoded
- (or (assoc-ref r:headers 'content-type) '()))
- (parse-query (uri-decode (bytevector->string body "UTF-8")))))))))
+ (let ((content-type (assoc-ref r:headers 'content-type)))
+ (when content-type
+ (let ((type (car content-type))
+ (args (cdr content-type)))
+ (when (eq? type 'application/x-www-form-urlencoded)
+ (let ((encoding (or (assoc-ref args 'encoding) "UTF-8")))
+ (parse-query (bytevector->string body encoding)
+ encoding)))))))))))
(lambda* (a b #:optional new-state)
(values a b (or new-state state))))))))
diff --git a/module/server/util.scm b/module/server/util.scm
index ada4f266..58a11ec3 100644
--- a/module/server/util.scm
+++ b/module/server/util.scm
@@ -4,14 +4,14 @@
:use-module (web uri))
-(define-public (parse-query query-string)
+(define*-public (parse-query query-string optional: (encoding "UTF-8"))
(unless (or (not query-string) (string-null? query-string))
(fold (lambda (str list)
;; only split on the first equal.
;; Does HTTP allow multiple equal signs in a data field?
;; NOTE that this fails if str lacks an equal sign.
(define idx (string-index str #\=))
- (define key (uri-decode (substring str 0 idx)))
- (define val (uri-decode (substring str (1+ idx))))
+ (define key (uri-decode (substring str 0 idx) encoding: encoding))
+ (define val (uri-decode (substring str (1+ idx)) encoding: encoding))
(cons* (-> key string->symbol symbol->keyword) val list))
'() (string-split query-string #\&))))