diff options
| -rw-r--r-- | http-client.scm | 12 | ||||
| -rw-r--r-- | tests/run.scm | 91 |
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)))) |