web: Add parse-form-submission.

1 files changed, 23 insertions, 1 deletions

diff --git a/mumi/web/render.scm b/mumi/web/render.scm
index 146a001..61ccde6 100644
--- a/mumi/web/render.scm
+++ b/mumi/web/render.scm
@@ -20,12 +20,17 @@
 
 (define-module (mumi web render)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 binary-ports)
+  #:use-module ((ice-9 textual-ports)
+                #:select (get-string-all))
+  #:use-module (ice-9 match)
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (web uri)
+  #:use-module (webutils multipart)
   #:use-module (json)
   #:use-module (mumi config)
   #:use-module (mumi web sxml)
@@ -36,7 +41,8 @@
             not-found
             unprocessable-entity
             created
-            redirect))
+            redirect
+            parse-form-submission))
 
 (define file-mime-types
   '(("css" . (text/css))
@@ -125,3 +131,19 @@
                                (location . ,uri))
                              headers))
           (format #f "Redirect to ~a" (uri->string uri)))))
+
+(define (parse-form-submission request body)
+  "Return an alist with keys to values for the submitted form."
+  (let ((parts (parse-request-body request body)))
+    (map (lambda (part)
+           (let ((binary? (match (assoc-ref (part-headers part) 'content-type)
+                            (('application/octet-stream . _) #t)
+                            (_ #f))))
+             (and-let*
+                 ((content (assoc-ref (part-headers part) 'content-disposition))
+                  (form-data (and=> (memq 'form-data content) cadr))
+                  (name (and=> (memq 'name form-data) cdr)))
+               (cons (string->symbol name)
+                     ((if binary? get-bytevector-all get-string-all)
+                      (part-body part))))))
+         parts)))