allow multipart form data in ezcurl lib

OCamlPro · Apr 19, 2024 · e39341b · e39341b
1 parent 4e7f3c0
commit e39341b
Show file tree

Hide file tree

Showing 3 changed files with 39 additions and 20 deletions.
diff --git a/src/request/unix/curl/ezCurl.ml b/src/request/unix/curl/ezCurl.ml
@@ -8,12 +8,12 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let make ?meth ?headers ?content ?content_type ?msg url f =
+let make ?meth ?headers ?msg ~url l f =
   EzCurl_common.log ?meth url msg;
-  if !Verbose.v land 2 <> 0 then Format.printf "[ez_api] sent:\n%s@." (Option.value ~default:"" content);
+  if !Verbose.v land 2 <> 0 then Format.printf "[ez_api] sent:\n%s@." (EzCurl_common.payload_to_string l);
   let rc, data =
     try
-      let r, c = EzCurl_common.init ?meth ?headers ?content ?content_type url in
+      let r, c = EzCurl_common.init ?meth ?headers ~url l in
       Curl.perform c;
       let rc = Curl.get_responsecode c in
       Curl.cleanup c;
@@ -29,11 +29,11 @@ let make ?meth ?headers ?content ?content_type ?msg url f =
 module Interface = struct
 
   let get ?(meth="GET") ?headers ?msg url f =
-    make ~meth ?headers ?msg url f
+    make ~meth ?headers ?msg ~url [] f
 
   let post ?(meth="POST") ?(content_type="application/json") ?(content="{}")
       ?headers ?msg url  f =
-    make ~meth ?headers ?msg ~content_type ~content url f
+    make ~meth ?headers ?msg ~url [ "", `content content, Some content_type ] f
 end
 
 include EzRequest.Make(Interface)
diff --git a/src/request/unix/curl/ezCurl_common.ml b/src/request/unix/curl/ezCurl_common.ml
@@ -19,10 +19,10 @@ let writer_callback a d =
   Buffer.add_string a d;
   String.length d
 
-let init ?(meth="GET") ?content ?content_type ?(headers=[]) url =
-  let headers = match content_type with
-    | None -> headers
-    | Some ct -> ("content-type", ct) :: headers in
+let init ?(meth="GET") ?(headers=[]) ~url l =
+  let headers = match l with
+    | [ _, `content _, Some ct ] -> ("content-type", ct) :: headers
+    | _ -> headers in
   let r = Buffer.create 16384
   and c = Curl.init () in
   (match !timeout with None -> () | Some t -> Curl.set_timeout c t);
@@ -35,9 +35,28 @@ let init ?(meth="GET") ?content ?content_type ?(headers=[]) url =
   Curl.set_url c url;
   Curl.set_httpheader c (
     List.map (fun (name, value) -> Format.sprintf "%s: %s" name value) headers);
-  (match content with
-   | Some content ->
-     Curl.set_postfields c content;
-     Curl.set_postfieldsize c (String.length content)
-   | _ -> ());
+  begin match l with
+  | [ _, `content s, _ ] ->
+    Curl.set_postfields c s;
+    Curl.set_postfieldsize c (String.length s)
+  | _ ->
+    let l = List.map (fun (name, content, ct) ->
+        let ct = match ct with None -> Curl.DEFAULT | Some s -> Curl.CONTENTTYPE s in
+        match content with
+        | `file s -> Curl.CURLFORM_FILE (name, s, ct)
+        | `filecontent s -> Curl.CURLFORM_FILECONTENT (name, s, ct)
+        | `content s -> Curl.CURLFORM_CONTENT (name, s, ct)) l in
+    Curl.setopt c (Curl.CURLOPT_HTTPPOST l)
+  end;
   r,c
+
+let payload_to_string l =
+  match l with
+  | [ _, `content s, _ ] -> s
+  | _ ->
+    let content_to_string = function
+      | `content s -> s
+      | `filecontent s -> "filecontent:" ^ s
+      | `file s -> "file:" ^ s in
+    String.concat "\n" @@ List.map (fun (name, content, _) ->
+      Format.sprintf "%s=%s" name (content_to_string content)) l
diff --git a/src/request/unix/curl/multi/ezCurl_multi.ml b/src/request/unix/curl/multi/ezCurl_multi.ml
@@ -8,17 +8,17 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let make ?msg ?meth ?content ?content_type ?headers url =
+let make ?msg ?meth ?headers ~url l =
   EzCurl_common.log ?meth url msg;
-  if !Verbose.v land 2 <> 0 then Format.printf "sent:\n%s@." (Option.value ~default:"" content);
+  if !Verbose.v land 2 <> 0 then Format.printf "[ez_api] sent:\n%s@." (EzCurl_common.payload_to_string l);
   let r () =
-    let r, c = EzCurl_common.init ?meth ?content ?content_type ?headers url in
+    let r, c = EzCurl_common.init ?meth ?headers ~url l in
     Lwt.map (fun _code ->
         let rc = Curl.get_responsecode c in
         Curl.cleanup c;
         let data = Buffer.contents r in
         EzCurl_common.log ~meth:("RECV " ^ string_of_int rc) url msg;
-        if !Verbose.v land 1 <> 0 then Format.printf "received:\n%s@." data;
+        if !Verbose.v land 1 <> 0 then Format.printf "[ez_api] received:\n%s@." data;
         if rc >= 200 && rc < 300 then Ok data
         else Error (rc, Some data))
       (Curl_lwt.perform c) in
@@ -28,11 +28,11 @@ let make ?msg ?meth ?content ?content_type ?headers url =
 
 module Interface = struct
   let get ?(meth="GET") ?headers ?msg url =
-    make ?msg ~meth ?headers url
+    make ?msg ~meth ?headers ~url []
 
   let post ?(meth="POST") ?(content_type="application/json") ?(content="{}") ?headers
       ?msg url =
-    make ?msg ~meth ?headers ~content ~content_type url
+    make ?msg ~meth ?headers ~url [ "", `content content, Some content_type ]
 end
 
 include EzRequest_lwt.Make(Interface)