aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorW. Kosior <koszko@koszko.org>2025-03-27 13:09:29 +0100
committerW. Kosior <koszko@koszko.org>2025-03-27 13:09:29 +0100
commitb2410f512f2adc475e5c7476b39cf195cb752fbf (patch)
tree6da354f1a5eaf6dc47ea97733f85be5fe3951eba
parentcbc9d31f3eb2d1cf16bfd95598961af0740ef266 (diff)
downloadcantius-b2410f512f2adc475e5c7476b39cf195cb752fbf.tar.gz
cantius-b2410f512f2adc475e5c7476b39cf195cb752fbf.zip
For other content types return nil from `multipart/form-data' proc.
-rw-r--r--src/guile/cantius.scm11
-rw-r--r--tests/guile/cantius-test.scm13
2 files changed, 19 insertions, 5 deletions
diff --git a/src/guile/cantius.scm b/src/guile/cantius.scm
index d7413fe..ada2747 100644
--- a/src/guile/cantius.scm
+++ b/src/guile/cantius.scm
@@ -232,11 +232,14 @@
(export multipart/form-data)
($ define (multipart/form-data)
- (match-let ((('multipart/form-data
- . (= (cut assq-ref <> 'boundary) (? identity boundary)))
- (req:request-content-type cant$request)))
+ (match (req:request-content-type cant$request)
- (parse-multipart/form-data boundary cant$body)))
+ (('multipart/form-data
+ . (= (cut assq-ref <> 'boundary) (? identity boundary)))
+ (parse-multipart/form-data boundary cant$body))
+
+ (_
+ '())))
(define (parts->alist parts)
;; This shouldn't be strongly relevant but we make later parts appear
diff --git a/tests/guile/cantius-test.scm b/tests/guile/cantius-test.scm
index 4d9a6d6..4d2447d 100644
--- a/tests/guile/cantius-test.scm
+++ b/tests/guile/cantius-test.scm
@@ -78,7 +78,7 @@ value
(data-bytevector (string->utf8 form-data))
(data-length (bytevector-length data-bytevector))
(request-text (format #f "\
-GET /dummy HTTP/1.0
+POST /dummy HTTP/1.0
Host: example.com
Content-Type: multipart/form-data; boundary=~a
Content-Length: ~d
@@ -130,6 +130,17 @@ Content-Length: ~d
(map cant:form-data-part-data (force parsed)))))
(list %form-boundary %form-boundary-with-backslash))
+ (tu:test-equal '()
+ (cant:$ let*-values ((() (apply values cant:$-args)))
+ (let ((request (call-with-input-string "\
+GET /dummy HTTP/1.0
+Host: example.com
+
+"
+ req:read-request)))
+ (cant:$ cant:multipart/form-data*
+ ((cant$request request))))))
+
(tu:test-error (cut condition-has-type? <> cant:&bad-request)
(cant:parse-multipart/form-data
%form-boundary