From fb04413bfce4f910509ba0cce60dea124b0f1a16 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 9 Aug 2020 10:17:29 +0200
Subject: =?UTF-8?q?Can=20create=20events=20with=20=C3=A5=C3=A4=C3=B6=20aga?=
 =?UTF-8?q?in.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 module/entry-points/server.scm |  3 +++
 module/server/macro.scm        | 11 ++++++++---
 module/server/util.scm         |  6 +++---
 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 #\&))))
-- 
cgit v1.2.3