summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--http-client.scm12
-rw-r--r--tests/run.scm91
2 files changed, 99 insertions, 4 deletions
diff --git a/http-client.scm b/http-client.scm
index e9c181b..0dd9dff 100644
--- a/http-client.scm
+++ b/http-client.scm
@@ -1,7 +1,7 @@
;;;
;;; Convenient HTTP client library
;;;
-;; Copyright (c) 2008-2022, Peter Bex
+;; Copyright (c) 2008-2024, Peter Bex
;; Parts copyright (c) 2000-2004, Felix L. Winkelmann
;; All rights reserved.
;;
@@ -716,9 +716,11 @@
'()
(let* ((keys (cdr entry))
(file (kv-ref keys file:))
+ (data (kv-ref keys data:))
(filename (or (kv-ref keys filename:)
- (and (port? file) (port-name file))
- (and (string? file) file)))
+ (and file
+ (and (port? file) (port-name file))
+ (and (string? file) file))))
(h (headers `((content-disposition
#(form-data ((name . ,(car entry))
(filename . ,filename))))
@@ -733,6 +735,7 @@
(list "--" boundary "\r\n" hs "\r\n"
(cond ((string? file) (cons 'file file))
((port? file) (cons 'port file))
+ ((string? data) data)
((eq? keys #t) "")
(else (->string keys)))
;; The next boundary must always start on a new line
@@ -809,7 +812,8 @@
((and (list? writer)
(any (lambda (x)
(and (pair? x) (pair? (cdr x))
- (eq? (cadr x) file:)))
+ (or (kv-ref (cdr x) file:)
+ (kv-ref (cdr x) data:))))
writer))
(let ((bd (conc "----------------Multipart-=_"
(gensym 'boundary) "=_=" (current-process-id)
diff --git a/tests/run.scm b/tests/run.scm
index fbc3e6c..7d0653b 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -192,6 +192,50 @@
(test "Body contains the file and other data, delimited by the boundary"
expected-data (log-body log))))
+ (test-group "alist form data body with string data"
+ (let* ((log (with-server-response
+ (lambda ()
+ (with-input-from-request
+ "http://example.com"
+ `((lala . "testing")
+ (the-data data: "the data's contents"
+ filename: "str")
+ ("more" . stuff))
+ read-string))
+ "HTTP/1.0 200 OK\r\n\r\n"))
+ (req (log-request log))
+ (h (request-headers req))
+ (boundary (header-param 'boundary 'content-type h))
+ (expected-data
+ (conc
+ "--" boundary "\r\n"
+ "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
+ "testing\r\n"
+ "--" boundary "\r\n"
+ "Content-Disposition: form-data; name=\"the-data\"; "
+ "filename=\"str\"\r\n"
+ "Content-Type: application/octet-stream\r\n\r\n"
+ "the data's contents\r\n"
+ "--" boundary "\r\n"
+ "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
+ "stuff\r\n"
+ "--" boundary "--\r\n")))
+
+ (test "Request method" 'POST (request-method req))
+ (test "Content type is multipart"
+ 'multipart/form-data
+ (header-value 'content-type h))
+ (test "Content-length was set"
+ (string-length expected-data) (header-value 'content-length h))
+ (test "Version is the default HTTP version of 1.1"
+ '(1 . 1)
+ (cons (request-major req) (request-minor req)))
+ (test "Transfer encoding is not set"
+ #f
+ (header-value 'transfer-encoding (request-headers req)))
+ (test "Body contains the file and other data, delimited by the boundary"
+ expected-data (log-body log))))
+
(test-group "alist form data body with string port using HTTP/1.0"
(let* ((string-port (open-input-string "the file's contents"))
(uri (uri-reference "http://example.com"))
@@ -240,6 +284,53 @@
(test "Body contains the file and other data, delimited by the boundary"
expected-data (log-body log))))
+ (test-group "alist form data body with string data using HTTP/1.0"
+ (let* ((uri (uri-reference "http://example.com"))
+ (req (make-request uri: uri method: 'POST
+ major: 1 minor: 0))
+ (log (with-server-response
+ (lambda ()
+ (with-input-from-request
+ req
+ `((lala . "testing")
+ (the-data data: "the data's contents"
+ filename: "str")
+ ("more" . stuff))
+ read-string))
+ "HTTP/1.0 200 OK\r\n\r\n"))
+ (req (log-request log))
+ (h (request-headers req))
+ (boundary (header-param 'boundary 'content-type h))
+ (expected-data
+ (conc
+ "--" boundary "\r\n"
+ "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
+ "testing\r\n"
+ "--" boundary "\r\n"
+ "Content-Disposition: form-data; name=\"the-data\"; "
+ "filename=\"str\"\r\n"
+ "Content-Type: application/octet-stream\r\n\r\n"
+ "the data's contents\r\n"
+ "--" boundary "\r\n"
+ "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
+ "stuff\r\n"
+ "--" boundary "--\r\n")))
+
+ (test "Request method" 'POST (request-method req))
+ (test "Content type is multipart"
+ 'multipart/form-data
+ (header-value 'content-type h))
+ (test "Content-length was set"
+ (string-length expected-data) (header-value 'content-length h))
+ (test "Version is correct"
+ '(1 . 0)
+ (cons (request-major req) (request-minor req)))
+ (test "Transfer encoding is not set"
+ #f
+ (header-value 'transfer-encoding (request-headers req)))
+ (test "Body contains the file and other data, delimited by the boundary"
+ expected-data (log-body log))))
+
(test-group "alist form data body with custom port"
(let* ((string-port (open-input-string "the file's contents"))
(custom-port (make-input-port (lambda () (read-char string-port)) (constantly #t) (lambda () (close-input-port string-port))))