Allow raw string data instead of file for multipart content (#1838)

This allows one to pass in a filename for the data.

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))))