From 2ae1169eb32b8eb6abb366df86a0f8ef1074aaf2 Mon Sep 17 00:00:00 2001 From: eXenon Date: Fri, 26 Apr 2019 11:03:25 +0200 Subject: [PATCH 1/9] Add multipart writer Move the reader into a separate module --- lib/dune | 1 + lib/{multipart_form_data.ml => reader.ml} | 69 +++--- lib/{multipart_form_data.mli => reader.mli} | 0 lib/writer.ml | 223 ++++++++++++++++++++ lib/writer.mli | 18 ++ 5 files changed, 281 insertions(+), 30 deletions(-) rename lib/{multipart_form_data.ml => reader.ml} (86%) rename lib/{multipart_form_data.mli => reader.mli} (100%) create mode 100644 lib/writer.ml create mode 100644 lib/writer.mli diff --git a/lib/dune b/lib/dune index eabaa31..f2f179d 100644 --- a/lib/dune +++ b/lib/dune @@ -3,6 +3,7 @@ (public_name multipart-form-data) (libraries lwt + lwt.unix stringext ) (preprocess diff --git a/lib/multipart_form_data.ml b/lib/reader.ml similarity index 86% rename from lib/multipart_form_data.ml rename to lib/reader.ml index cc37673..009bb1c 100644 --- a/lib/multipart_form_data.ml +++ b/lib/reader.ml @@ -86,14 +86,14 @@ let split s boundary = | None -> c0 in let string_to_process = match find_common_idx c boundary with - | None -> c - | Some idx -> - begin - let prefix = String.sub c 0 idx in - let suffix = String.sub c idx (String.length c - idx) in - push suffix; - prefix - end + | None -> c + | Some idx -> + begin + let prefix = String.sub c 0 idx in + let suffix = String.sub c idx (String.length c - idx) in + push suffix; + prefix + end in Lwt.return @@ split_and_process_string ~boundary string_to_process in @@ -136,7 +136,7 @@ let parse_name s = let parse_header s = match Stringext.cut ~on:": " s with | Some (key, value) -> (key, value) - | None -> invalid_arg "parse_header" + | None -> invalid_arg ("Could not parse header :" ^ s) let non_empty st = let%lwt r = Lwt_stream.to_list @@ Lwt_stream.clone st in @@ -144,11 +144,12 @@ let non_empty st = let get_headers : string Lwt_stream.t Lwt_stream.t -> header list Lwt.t = fun lines -> - let%lwt header_lines = Lwt_stream.get_while_s non_empty lines in - Lwt_list.map_s (fun header_line_stream -> - let%lwt parts = Lwt_stream.to_list header_line_stream in - Lwt.return @@ parse_header @@ String.concat "" parts - ) header_lines + let%lwt header_lines = Lwt_stream.get_while_s non_empty lines in + Lwt_list.map_s (fun header_line_stream -> + let%lwt parts = Lwt_stream.to_list header_line_stream in + Lwt.return @@ parse_header @@ String.concat "" parts + ) + header_lines type stream_part = { headers : header list @@ -208,7 +209,7 @@ let file_content_type {headers; _} = let as_part part = match s_part_filename part with | Some _filename -> - Lwt.return (`File part) + Lwt.return (`File part) | None -> let%lwt chunks = Lwt_stream.to_list part.body in let body = String.concat "" chunks in @@ -293,9 +294,22 @@ module Reader = struct end end +let read_inital_comments boundary reader = + let rec go comments = + let%lwt line = Reader.read_line reader in + print_endline ("Comment line : " ^ line); + if line = boundary ^ "\r\n" then + Lwt.return comments + else + go (comments ^ line) + in + go "" + + let read_headers reader = let rec go headers = let%lwt line = Reader.read_line reader in + print_endline ("Header line : " ^ line); if line = "\r\n" then Lwt.return headers else @@ -309,20 +323,20 @@ let rec compute_case reader boundary = | None -> Lwt.return `Empty | Some line -> begin - match Stringext.cut line ~on:(boundary ^ "\r\n") with + match Stringext.cut line ~on:("\r\n" ^ boundary ^ "\r\n") with | Some (pre, post) -> Lwt.return @@ `Boundary (pre, post) | None -> begin - match Stringext.cut line ~on:(boundary ^ "--\r\n") with + match Stringext.cut line ~on:("\r\n" ^ boundary ^ "--\r\n") with | Some (pre, post) -> Lwt.return @@ `Boundary (pre, post) | None -> begin - match find_common_idx line boundary with + match find_common_idx line ("\r\n" ^ boundary) with | Some 0 -> begin - Reader.unread reader line; - let%lwt () = Reader.read_next reader in - compute_case reader boundary + Reader.unread reader line; + let%lwt () = Reader.read_next reader in + compute_case reader boundary end | Some amb_idx -> let unambiguous = String.sub line 0 amb_idx in @@ -359,17 +373,11 @@ let iter_part reader boundary callback = let read_file_part reader boundary callback = iter_part reader boundary callback -let strip_crlf s = - if ends_with ~suffix:"\r\n" ~suffix_length:2 s then - String.sub s 0 (String.length s - 2) - else - s - let read_string_part reader boundary = let value = Buffer.create 0 in let append_to_value line = Lwt.return (Buffer.add_string value line) in let%lwt () = iter_part reader boundary append_to_value in - Lwt.return @@ strip_crlf (Buffer.contents value) + Lwt.return (Buffer.contents value) let read_part reader boundary callback fields = let%lwt headers = read_headers reader in @@ -389,7 +397,8 @@ let read_part reader boundary callback fields = let handle_multipart reader boundary callback = let fields = (ref [] : (string * string) list ref) in let%lwt () = - let%lwt _dummyline = Reader.read_line reader in + let%lwt _comments = read_inital_comments boundary reader in + print_endline ("Comments : " ^ _comments); let fin = ref false in while%lwt not !fin do if%lwt Reader.empty reader then @@ -405,6 +414,6 @@ let parse ~stream ~content_type ~callback = let boundary = match extract_boundary content_type with | Some s -> "--" ^ s - | None -> invalid_arg "iter_multipart" + | None -> invalid_arg ("Could not extract boundary from Content-Type : " ^ content_type) in handle_multipart reader boundary callback diff --git a/lib/multipart_form_data.mli b/lib/reader.mli similarity index 100% rename from lib/multipart_form_data.mli rename to lib/reader.mli diff --git a/lib/writer.ml b/lib/writer.ml new file mode 100644 index 0000000..a107c4f --- /dev/null +++ b/lib/writer.ml @@ -0,0 +1,223 @@ +module MultipartRequest = struct + + type form_element = + { key : string + ; value : string + } + + type file_element = + { path : string + ; name : string + } + + type stream_element = + { name : string + ; content : string Lwt_stream.t + ; length : int + } + + type element = + | Form of form_element + | File of file_element + | Stream of stream_element + + type t = + { elements : element list + ; separator : string + } + +end + +let init () = + Random.self_init(); + (* It does not matter if the random numbers are not safe here *) + { MultipartRequest.elements = [] + ; separator = "-----------------" ^ (string_of_int (Random.int 536870912)) + } + +let init_with_separator separator = + { MultipartRequest.elements = [] + ; separator = separator + } + +let add_form_element ~name ~value mp = + let open MultipartRequest in + { mp with elements = Form { key=name; value=value } :: mp.elements} + +let add_file_from_disk ~name ~path mp = + let open MultipartRequest in + { mp with + elements = + File { path=path + ; name=name + } + :: mp.elements + } + +let add_file_from_string ~name ~content mp = + let open MultipartRequest in + { mp with + elements = + Stream { content = Lwt_stream.of_list [ content ] + ; name=name + ; length=String.length content + } + :: mp.elements + } + +let add_file_from_stream ~name ~content ~content_length mp = + let open MultipartRequest in + { mp with + elements = + Stream { content = content + ; name=name + ; length=content_length + } + :: mp.elements + } + +let open_file path = + (* This function returns a buffered IO read of a file *) + let open Lwt.Infix in + let read_while_not_empty channel () = + (Lwt_io.read ~count:4096 channel) + >|= (fun chunck -> + match chunck with + | "" -> None + | _ -> Some chunck + ) + in + path + |> Lwt_io.open_file ~mode:Lwt_io.Input + >|= read_while_not_empty + >|= Lwt_stream.from + |> Lwt_result.ok + +let safe_open_file path = + try%lwt open_file path with + | Unix.Unix_error(Unix.ENOENT, _, _) -> Lwt_result.fail ("File " ^ path ^ " not found") + | Unix.Unix_error(Unix.EACCES, _, _) -> Lwt_result.fail ("Permission denied on " ^ path) + | Unix.Unix_error(Unix.EBUSY, _, _) -> Lwt_result.fail ("File " ^ path ^ " was busy") + | Unix.Unix_error(Unix.EISDIR, _, _) -> Lwt_result.fail ("File " ^ path ^ " is a directory") + | _ -> Lwt_result.fail ("Unknown error while reading file " ^ path) + +let file_size path = + path + |> Lwt_io.file_length + |> Lwt.map Int64.to_int + |> Lwt_result.ok + +let safe_file_size path = + try%lwt file_size path with + | Unix.Unix_error(Unix.ENOENT, _, _) -> Lwt_result.fail ("File " ^ path ^ " not found") + | Unix.Unix_error(Unix.EACCES, _, _) -> Lwt_result.fail ("Permission denied on " ^ path) + | Unix.Unix_error(Unix.EBUSY, _, _) -> Lwt_result.fail ("File " ^ path ^ " was busy") + | Unix.Unix_error(Unix.EISDIR, _, _) -> Lwt_result.fail ("File " ^ path ^ " is a directory") + | _ -> Lwt_result.fail ("Unknown error while reading file " ^ path) + +let element_header separator element = + match element with + | MultipartRequest.Form f + -> + "\r\n--" + ^ separator + ^ "\r\nContent-Disposition: form-data; name=\"" + ^ f.key + ^ "\"\r\n\r\n" + | File f + -> + "\r\n--" + ^ separator + ^ "\r\nContent-Disposition: form-data; name=\"file\"; filename=\"" + ^ f.name + ^ "\"\r\nContent-Type: application/octet-stream\r\n\r\n" + | Stream s + -> + "\r\n--" + ^ separator + ^ "\r\nContent-Disposition: form-data; name=\"file\"; filename=\"" + ^ s.name + ^ "\"\r\nContent-Type: application/octet-stream\r\n\r\n" + +let closing_line separator = + "\r\n--" ^ separator ^ "--\r\n" + +let closing_line_size separator = + String.length (closing_line separator) + + +let element_to_string separator element = + match element with + | MultipartRequest.Form f + -> + Lwt_result.return ( + Lwt_stream.of_list + [ (element_header separator element) + ; f.value + ] + ) + | File f + -> + let open Lwt_result.Infix in + let file_header = element_header separator element in + let file_header_stream = Lwt_stream.of_list [file_header] in + safe_open_file f.path + >|= fun (file_stream) -> Lwt_stream.append file_header_stream file_stream + | Stream s + -> + let file_header = element_header separator element in + let file_header_stream = Lwt_stream.of_list [file_header] in + Lwt_result.return ( + Lwt_stream.append file_header_stream s.content + ) + + +let element_size separator element = + match element with + | MultipartRequest.Form _ + -> + Lwt_result.return ( + String.length (element_header separator element) + ) + | File f + -> + let open Lwt_result.Infix in + let file_header = (element_header separator element) in + let file_header_size = String.length file_header in + safe_file_size f.path + >|= fun (file_size) -> file_header_size + file_size + | Stream s + -> + let file_header = (element_header separator element) in + Lwt_result.return ( + (String.length file_header) + s.length + ) + + +let rec mfoldl f acc l = + match l with + | h::t + -> + Lwt_result.bind + h + (fun value -> mfoldl f (f value acc) t) + | [] + -> + Lwt_result.return acc + + +let r_body mp = + let {MultipartRequest.elements; separator} = mp in + elements + |> List.map (element_to_string separator) + |> mfoldl Lwt_stream.append (Lwt_stream.of_list [closing_line separator]) + +let r_headers mp = + let {MultipartRequest.elements; separator} = mp in + let open Lwt_result.Infix in + elements + |> List.map (element_size separator) + |> mfoldl (+) (closing_line_size separator) + >|= (fun (total_size) -> + [ ("Content-Type", "multipart/form-data; boundary=" ^ separator) + ; ("Content-Length", string_of_int total_size)]) diff --git a/lib/writer.mli b/lib/writer.mli new file mode 100644 index 0000000..5b88a5c --- /dev/null +++ b/lib/writer.mli @@ -0,0 +1,18 @@ +module MultipartRequest : sig + type t +end + +val init : unit -> MultipartRequest.t +val init_with_separator : string -> MultipartRequest.t +val add_form_element : name:string -> value:string -> MultipartRequest.t -> MultipartRequest.t +val add_file_from_disk : name:string -> path:string -> MultipartRequest.t -> MultipartRequest.t +val add_file_from_string : name:string -> content:string -> MultipartRequest.t -> MultipartRequest.t +val add_file_from_stream : + name:string -> + content:(string Lwt_stream.t) -> + content_length:int -> + MultipartRequest.t -> + MultipartRequest.t + +val r_body : MultipartRequest.t -> (string Lwt_stream.t, string) Lwt_result.t +val r_headers : MultipartRequest.t -> ((string * string) list, string) Lwt_result.t From d4242175018a39dcaf648268ec7cae24957ac865 Mon Sep 17 00:00:00 2001 From: eXenon Date: Fri, 26 Apr 2019 11:03:47 +0200 Subject: [PATCH 2/9] Major refactoring of tests --- test/test_read_write.ml | 69 ++++++++++++++++ test/test_reader.ml | 158 ++++++++++++++++++++++++++++++++++++ test/test_writer.ml | 158 ++++++++++++++++++++++++++++++++++++ test/tests.ml | 174 ++++------------------------------------ 4 files changed, 400 insertions(+), 159 deletions(-) create mode 100644 test/test_read_write.ml create mode 100644 test/test_reader.ml create mode 100644 test/test_writer.ml diff --git a/test/test_read_write.ml b/test/test_read_write.ml new file mode 100644 index 0000000..e34d135 --- /dev/null +++ b/test/test_read_write.ml @@ -0,0 +1,69 @@ +(* A series of tests confirming that the reader and writer + * modules are reversible. +*) + + +let string2_list = Alcotest.(list (pair string string)) + +let string3_list = Alcotest.(list (pair (pair string string) string)) + +let test ~name ~input ~expected_parts ~expected_calls = + ( name + , `Quick + , fun () -> + let (headers, body) = + input + |> List.fold_left + Test_writer.add_test_element + (Multipart_form_data.Writer.init_with_separator Test_writer.separator) + |> Test_writer.multipart_request_to_string + in + let content_type = + headers + |> List.fold_left + (fun acc (h, v) -> + match h with + | "Content-Type" -> v + | _ -> acc + ) + "" + in + let stream = Lwt_stream.of_list [ body ] in + let calls = ref [] in + let callback ~name ~filename line = + calls := !calls @ [((name, filename), line)]; + Lwt.return_unit + in + let parts = + Multipart_form_data.Reader.parse ~stream ~content_type ~callback + |> Lwt_main.run + in + Alcotest.(check string "header" ("multipart/form-data; boundary=" ^ Test_writer.separator) content_type); + Alcotest.check string2_list "parts" expected_parts parts; + Alcotest.check + string3_list + "calls" + (List.map (fun (x, y, z) -> ((x, y), z)) expected_calls) + !calls; + ) + +let read_write_tests = + [ test + ~name:"Simple form" + ~input:[Form ("key", "value")] + ~expected_parts:[("key", "value")] + ~expected_calls:[] + ; test + ~name:"Simple file" + ~input:[String ("filename", "file\r\ncontent\r\n")] + ~expected_parts:[] + ~expected_calls:[("file", "filename", "file\r\ncontent\r\n")] + ; test + ~name:"File and form" + ~input: + [ String ("filename", "file\r\ncontent\r\n") + ; Form ("key", "value\r\n") + ] + ~expected_parts:[("key", "value\r\n")] + ~expected_calls:[("file", "filename", "file\r\ncontent\r\n")] + ] diff --git a/test/test_reader.ml b/test/test_reader.ml new file mode 100644 index 0000000..dca2526 --- /dev/null +++ b/test/test_reader.ml @@ -0,0 +1,158 @@ +let get_file name parts = + match Multipart_form_data.Reader.StringMap.find name parts with + | `File file -> file + | `String _ -> failwith "expected a file" + +module String_or_file = struct + type t = [`String of string | `File of Multipart_form_data.Reader.file] + + let equal = (=) + + let pp fmt (part : t) = + let s = match part with + | `File _ -> "File _" + | `String s -> s + in + Format.pp_print_string fmt s +end + +let string_or_file = (module String_or_file : Alcotest.TESTABLE with type t = String_or_file.t) + +let test_parse () = + let body = + String.concat "\r\n" + [ {|--------------------------1605451f456c9a1a|} + ; {|Content-Disposition: form-data; name="a"|} + ; {||} + ; {|b|} + ; {|--------------------------1605451f456c9a1a|} + ; {|Content-Disposition: form-data; name="c"|} + ; {||} + ; {|d|} + ; {|--------------------------1605451f456c9a1a|} + ; {|Content-Disposition: form-data; name="upload"; filename="testfile"|} + ; {|Content-Type: application/octet-stream|} + ; {||} + ; {|testfilecontent|} + ; {||} + ; {|--------------------------1605451f456c9a1a--|} + ] + in + let content_type = "multipart/form-data; boundary=------------------------1605451f456c9a1a" in + let stream = Lwt_stream.of_list [body] in + let thread = + let%lwt parts_stream = Multipart_form_data.Reader.parse_stream ~stream ~content_type in + let%lwt parts = Multipart_form_data.Reader.get_parts parts_stream in + Alcotest.check string_or_file "'a' value" (`String "b") (Multipart_form_data.Reader.StringMap.find "a" parts); + Alcotest.check string_or_file "'c' value" (`String "d") (Multipart_form_data.Reader.StringMap.find "c" parts); + let file = get_file "upload" parts in + Alcotest.check Alcotest.string "filename" "upload" (Multipart_form_data.Reader.file_name file); + Alcotest.check Alcotest.string "content_type" "application/octet-stream" (Multipart_form_data.Reader.file_content_type file); + let%lwt file_chunks = Lwt_stream.to_list (Multipart_form_data.Reader.file_stream file) in + Alcotest.check Alcotest.string "contents" "testfilecontent" (String.concat "" file_chunks); + Lwt.return_unit + in + Lwt_main.run thread + +let tc content_type chunks expected_parts expected_calls = + let stream = Lwt_stream.of_list chunks in + let calls = ref [] in + let callback ~name ~filename line = + calls := !calls @ [((name, filename), line)]; + Lwt.return_unit + in + let%lwt parts = Multipart_form_data.Reader.parse ~stream ~content_type ~callback in + let string2_list = Alcotest.(list (pair string string)) in + let string3_list = Alcotest.(list (pair (pair string string) string)) in + Alcotest.check string2_list "parts" expected_parts parts; + Alcotest.check string3_list "calls" + (List.map (fun (x, y, z) -> ((x, y), z)) expected_calls) + !calls; + Lwt.return_unit + +let test_parse_request_complex () = + let cr = "\r" in + let lf = "\n" in + let crlf = cr ^ lf in + let thread = + tc "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" + ( List.map (String.concat lf) @@ + [ [ {|--9219489391874b51bb29b52a10e8baac|} ^ cr + ; {|Content-Disposition: form-data; name="foo"|} ^ cr + ; {||} ^ cr + ; {|toto|} ^ cr + ; {|--9219489391874b51bb29b52a10e8baac|} ^ cr + ; {|Content-Disposition: form-data; name="bar"; filename="filename.data"|} ^ cr + ; {|Content-Type: application/octet-stream|} ^ cr + ; {||} ^ cr + ; {|line1|} ^ crlf + ; {|line2|} + ; {||} + ] + ; [ {|line3|} + ; {|line4|} + ; {||} + ] + ; [ {|line5|} + ; {|line6|} ^ crlf ^ cr + ; {|--9219489391874b51bb29b52a10e8baac--|} ^ cr + ; {||} + ] + ] + ) + [ ("foo", "toto") ] + [ ("bar", "filename.data", "line1\r\n\nline2\n") + ; ("bar", "filename.data", "line3\nline4\n") + ; ("bar", "filename.data", "line5\nline6\r\n") + ] + in + Lwt_main.run thread + +let test_parse_request_easy () = + let cr = "\r" in + let lf = "\n" in + let crlf = cr ^ lf in + let thread = + tc + "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" + ( + [ {|--9219489391874b51bb29b52a10e8baac|} ^ crlf + ; {|Content-Disposition: form-data; name="foo"|} ^ crlf + ; crlf + ; {|toto|} ^ crlf + ; {|--9219489391874b51bb29b52a10e8baac--|} ^ crlf + ] + ) + [ ("foo", "toto") ] + [] + in + Lwt_main.run thread + +let test_split () = + let in_stream = + Lwt_stream.of_list + [ "ABCD" + ; "EFap" + ; "ple" + ; "ABCDEFor" + ; "angeABC" + ; "HHpl" + ; "umABCDEFkiwi" + ; "ABCDEF" + ] + in + let expected = + [ ["ap" ; "ple"] + ; ["or"; "ange"; "ABCHHpl"; "um"] + ; ["kiwi"] + ; [] + ] + in + let stream = Multipart_form_data.Reader.align in_stream "ABCDEF" in + Lwt_main.run ( + let%lwt streams = Lwt_stream.to_list stream in + let%lwt result = Lwt_list.map_s Lwt_stream.to_list streams in + Alcotest.check Alcotest.(list (list string)) "contents" expected result; + Lwt.return_unit + ) + diff --git a/test/test_writer.ml b/test/test_writer.ml new file mode 100644 index 0000000..c6df301 --- /dev/null +++ b/test/test_writer.ml @@ -0,0 +1,158 @@ +let get_file name parts = + match Multipart_form_data.Reader.StringMap.find name parts with + | `File file -> file + | `String _ -> failwith "expected a file" + +module String_or_file = struct + type t = [`String of string | `File of Multipart_form_data.Reader.file] + + let equal = (=) + + let pp fmt (part : t) = + let s = match part with + | `File _ -> "File _" + | `String s -> s + in + Format.pp_print_string fmt s +end + +let string_or_file = (module String_or_file : Alcotest.TESTABLE with type t = String_or_file.t) + +module TestInput = struct + type t = + | Form of (string * string) + | File of (string * string) + | Stream of (string * string) + | String of (string * string) +end + +let multipart_request_to_string mp = + let body_result = + mp + |> Multipart_form_data.Writer.r_body + |> Lwt_main.run in + let header_result = + mp + |> Multipart_form_data.Writer.r_headers + |> Lwt_main.run in + match (header_result, body_result) with + | (Ok headers, Ok stream) + -> + ( headers + , stream + |> Lwt_stream.get_available + |> String.concat "" + ) + | (_, Error err) + | (Error err, _) + -> + ([], err) + +let separator = "---------------16456c9a1a" + +let add_test_element mp element = + match element with + | TestInput.Form (name, value) -> Multipart_form_data.Writer.add_form_element ~name ~value mp + | File (name, path) -> Multipart_form_data.Writer.add_file_from_disk ~name ~path mp + | Stream (name, content) -> + Multipart_form_data.Writer.add_file_from_stream + ~name + ~content:(Lwt_stream.of_list [ content ]) + ~content_length:(String.length content) + mp + | String (name, content) -> + Multipart_form_data.Writer.add_file_from_string + ~name + ~content + mp + + +let test ~name ~input ~expected_headers ~expected_body = + ( name + , `Quick + , fun () -> + let (headers, body) = + input + |> List.fold_left + add_test_element + (Multipart_form_data.Writer.init_with_separator separator) + |> multipart_request_to_string + in + Alcotest.(check (list (pair string string))) (name ^ "_headers") expected_headers headers; + Alcotest.(check string) (name ^ "_body") expected_body body + ) + +let test_fail ~name ~input ~expected_error = + ( name + , `Quick + , fun () -> + let (_, error) = + input + |> List.fold_left + add_test_element + (Multipart_form_data.Writer.init_with_separator separator) + |> multipart_request_to_string + in + Alcotest.(check string) name expected_error error + ) + +let writer_tests = + [ test + ~name:"Empty" + ~input:[] + ~expected_headers: + [ ("Content-Type", "multipart/form-data; boundary=" ^ separator) + ; ("Content-Length", "33") + ] + ~expected_body:("\r\n--" ^ separator ^ "--\r\n") + ; test + ~name:"Simple form" + ~input:[Form ("key", "value")] + ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); + ("Content-Length", "110")] + ~expected_body:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"key\"" + ^ "\r\n" ^ "\r\n" + ^ "value" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ; test_fail + ~name:"Missing file" + ~input:[File ("missing_file", "/this/file/does/not/exist")] + ~expected_error:"File /this/file/does/not/exist not found" + ; test + ~name:"File from string" + ~input:[String ("filename", "this is the content of our file\r\n")] + ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); + ("Content-Length", "205")] + ~expected_body:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"file\"; filename=\"filename\"" + ^ "\r\n" + ^ "Content-Type: application/octet-stream" + ^ "\r\n" ^ "\r\n" + ^ "this is the content of our file\r\n" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ; test + ~name:"File from stream" + ~input:[Stream ("filename", "this is the content of our file\r\n")] + ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); + ("Content-Length", "205")] + ~expected_body:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"file\"; filename=\"filename\"" + ^ "\r\n" + ^ "Content-Type: application/octet-stream" + ^ "\r\n" ^ "\r\n" + ^ "this is the content of our file\r\n" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ] diff --git a/test/tests.ml b/test/tests.ml index 818b0c7..9b67420 100644 --- a/test/tests.ml +++ b/test/tests.ml @@ -1,160 +1,16 @@ -let get_file name parts = - match Multipart_form_data.StringMap.find name parts with - | `File file -> file - | `String _ -> failwith "expected a file" - -module String_or_file = struct - type t = [`String of string | `File of Multipart_form_data.file] - - let equal = (=) - - let pp fmt (part : t) = - let s = match part with - | `File _ -> "File _" - | `String s -> s - in - Format.pp_print_string fmt s -end - -let string_or_file = (module String_or_file : Alcotest.TESTABLE with type t = String_or_file.t) - -let test_parse () = - let body = - String.concat "\r\n" - [ {|--------------------------1605451f456c9a1a|} - ; {|Content-Disposition: form-data; name="a"|} - ; {||} - ; {|b|} - ; {|--------------------------1605451f456c9a1a|} - ; {|Content-Disposition: form-data; name="c"|} - ; {||} - ; {|d|} - ; {|--------------------------1605451f456c9a1a|} - ; {|Content-Disposition: form-data; name="upload"; filename="testfile"|} - ; {|Content-Type: application/octet-stream|} - ; {||} - ; {|testfilecontent|} - ; {||} - ; {|--------------------------1605451f456c9a1a--|} - ] - in - let content_type = "multipart/form-data; boundary=------------------------1605451f456c9a1a" in - let stream = Lwt_stream.of_list [body] in - let thread = - let%lwt parts_stream = Multipart_form_data.parse_stream ~stream ~content_type in - let%lwt parts = Multipart_form_data.get_parts parts_stream in - Alcotest.check string_or_file "'a' value" (`String "b") (Multipart_form_data.StringMap.find "a" parts); - Alcotest.check string_or_file "'c' value" (`String "d") (Multipart_form_data.StringMap.find "c" parts); - let file = get_file "upload" parts in - Alcotest.check Alcotest.string "filename" "upload" (Multipart_form_data.file_name file); - Alcotest.check Alcotest.string "content_type" "application/octet-stream" (Multipart_form_data.file_content_type file); - let%lwt file_chunks = Lwt_stream.to_list (Multipart_form_data.file_stream file) in - Alcotest.check Alcotest.string "contents" "testfilecontent" (String.concat "" file_chunks); - Lwt.return_unit - in - Lwt_main.run thread - -let tc content_type chunks expected_parts expected_calls = - let stream = Lwt_stream.of_list chunks in - let calls = ref [] in - let callback ~name ~filename line = - calls := !calls @ [((name, filename), line)]; - Lwt.return_unit - in - let%lwt parts = Multipart_form_data.parse ~stream ~content_type ~callback in - let string2_list = Alcotest.(list (pair string string)) in - let string3_list = Alcotest.(list (pair (pair string string) string)) in - Alcotest.check string2_list "parts" expected_parts parts; - Alcotest.check string3_list "calls" - (List.map (fun (x, y, z) -> ((x, y), z)) expected_calls) - !calls; - Lwt.return_unit - -let test_parse_request () = - let cr = "\r" in - let lf = "\n" in - let crlf = cr ^ lf in - let thread = - let%lwt () = - tc "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" - ( List.map (String.concat "\n") @@ - [ [ {|--9219489391874b51bb29b52a10e8baac|} ^ cr - ; {|Content-Disposition: form-data; name="foo"|} ^ cr - ; {||} ^ cr - ; {|toto|} ^ cr - ; {|--9219489391874b51bb29b52a10e8baac|} ^ cr - ; {|Content-Disposition: form-data; name="bar"; filename="filename.data"|} ^ cr - ; {|Content-Type: application/octet-stream|} ^ cr - ; {||} ^ cr - ; {|line1|} - ; {|line2|} - ; {||} - ] - ; [ {|line3|} - ; {|line4|} - ; {||} - ] - ; [ {|line5|} - ; {|line6|} - ; {|--9219489391874b51bb29b52a10e8baac--|} ^ cr - ; {||} - ] - ] - ) - [ ("foo", "toto") ] - [ ("bar", "filename.data", "line1\nline2\n") - ; ("bar", "filename.data", "line3\nline4\n") - ; ("bar", "filename.data", "line5\nline6\n") - ] - in - tc - "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" - ( - [ {|--9219489391874b51bb29b52a10e8baac|} ^ crlf - ; {|Content-Disposition: form-data; name="foo"|} ^ crlf - ; crlf - ; {|toto|} ^ crlf - ; {|--9219489391874b|} - ; {|51bb29b52a10e8baac--|} ^ crlf - ] - ) - [ ("foo", "toto") ] - [] - in - Lwt_main.run thread - -let test_split () = - let in_stream = - Lwt_stream.of_list - [ "ABCD" - ; "EFap" - ; "ple" - ; "ABCDEFor" - ; "angeABC" - ; "HHpl" - ; "umABCDEFkiwi" - ; "ABCDEF" - ] - in - let expected = - [ ["ap" ; "ple"] - ; ["or"; "ange"; "ABCHHpl"; "um"] - ; ["kiwi"] - ; [] - ] - in - let stream = Multipart_form_data.align in_stream "ABCDEF" in - Lwt_main.run ( - let%lwt streams = Lwt_stream.to_list stream in - let%lwt result = Lwt_list.map_s Lwt_stream.to_list streams in - Alcotest.check Alcotest.(list (list string)) "contents" expected result; - Lwt.return_unit - ) - let () = - Alcotest.run "multipart-form-data" [ ("Multipart_form_data", - [ "parse", `Quick, test_parse - ; "parse_request", `Quick, test_parse_request - ; "split", `Quick, test_split - ] - )] + Alcotest.run "multipart-form-data" [ + ("Multipart_form_data.Reader", + [ "parse", `Quick, Test_reader.test_parse + ; "parse_easy_request", `Quick, Test_reader.test_parse_request_easy + ; "parse_complex_request", `Quick, Test_reader.test_parse_request_complex + ; "split", `Quick, Test_reader.test_split + ] + ) + ; ("Multipart_form_data.Writer", + Test_writer.writer_tests + ) + ; ("Multipart_form_data.Reader & Writer", + Test_read_write.read_write_tests + ) + ] From add1f651f12453e573a33530b842d3a501718104 Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Mon, 3 Jun 2019 10:25:32 +0200 Subject: [PATCH 3/9] Add unittests --- lib/dune | 1 + lib/multipart_form_data.ml | 94 +++++++++++ lib/multipart_form_data.mli | 33 ++++ lib/reader.ml | 89 +++++++--- lib/reader.mli | 30 ---- lib/reader.mli.old | 30 ++++ lib/writer.ml | 114 +++++-------- lib/{writer.mli => writer.mli.old} | 0 multipart-form-data.opam | 1 + test/test_read_write.ml | 69 -------- test/test_reader.ml | 255 ++++++++++++----------------- test/test_reader_writer.ml | 104 ++++++++++++ test/test_writer.ml | 150 ++++++----------- test/tests.ml | 14 +- test/utils.ml | 29 ++++ 15 files changed, 553 insertions(+), 460 deletions(-) create mode 100644 lib/multipart_form_data.ml create mode 100644 lib/multipart_form_data.mli delete mode 100644 lib/reader.mli create mode 100644 lib/reader.mli.old rename lib/{writer.mli => writer.mli.old} (100%) delete mode 100644 test/test_read_write.ml create mode 100644 test/test_reader_writer.ml create mode 100644 test/utils.ml diff --git a/lib/dune b/lib/dune index f2f179d..75f8a29 100644 --- a/lib/dune +++ b/lib/dune @@ -2,6 +2,7 @@ (name multipart_form_data) (public_name multipart-form-data) (libraries + containers lwt lwt.unix stringext diff --git a/lib/multipart_form_data.ml b/lib/multipart_form_data.ml new file mode 100644 index 0000000..27bf503 --- /dev/null +++ b/lib/multipart_form_data.ml @@ -0,0 +1,94 @@ +module Request = struct + type t = + { headers : (string * string) list + ; body : string Lwt_stream.t + } +end + +module Part = struct + module Value = struct + type t = + | Variable of string + | File of {filename : string; content : string Lwt_stream.t; length : int64 option} + end + + type t = + { name: string + ; value: Value.t + } +end + +(** + * Read multipart streams + **) + +let variable_callback_factory ~callback ~name ~value = + callback {Part.name = name; value = Variable value} + +let file_callback_factory ~callback = + let cache = (ref []: (string list) ref) in + let finished = (ref false) in + let generator () = + match (!cache, !finished) with + | ([], true) -> None + | ([], false) -> Some "" + | (h::t, _) -> cache := t; Some h + in + let stream = Lwt_stream.from_direct generator in + let file_callback ~name ~filename line is_finished = + cache := line::!cache; + finished := is_finished; + callback + { Part.name = name + ; value = File {filename = filename; content = stream; length = None} + } + in + file_callback + +let part_parser callback headers body = + let file_callback = file_callback_factory ~callback in + let variable_callback = variable_callback_factory ~callback in + let content_type = List.assoc "Content-Type" headers in + Reader.parse ~stream:body ~content_type ~variable_callback ~file_callback + +let read ~request ~handle_part = + let {Request.headers; body} = request in + part_parser handle_part headers body + +(** + * Write multipart requests + **) + +let add_part_to_multipart_request multipart_request part = + match part with + | {Part.name=name; value=Variable value} + -> + Writer.add_form_element ~name ~value multipart_request + | {name=name; value=(File {filename=filename; content=content; length=Some content_length})} + -> + Writer.add_file_from_stream ~name ~filename ~content ~content_length multipart_request + | {name=_; value=File {filename=_; content=_; length=None}} + -> + failwith "File length is required when writing a multipart request body" + + +let write_with_separator ~separator ~request = + let open CCResult.Infix in + let multipart_request = + Seq.fold_left + add_part_to_multipart_request + (Writer.init separator) + request + in + Writer.r_headers multipart_request + >>= fun headers -> Writer.r_body multipart_request + >|= fun body -> + { Request.headers = headers + ; body = body + } + +let write ~request = + Random.self_init (); + (* It does not matter if the random numbers are not safe here *) + let separator = "-----------------" ^ (string_of_int (Random.int 536870912)) in + write_with_separator ~separator ~request diff --git a/lib/multipart_form_data.mli b/lib/multipart_form_data.mli new file mode 100644 index 0000000..9770f5a --- /dev/null +++ b/lib/multipart_form_data.mli @@ -0,0 +1,33 @@ +module Request : sig + type t = + { headers : (string * string) list + ; body : string Lwt_stream.t + } +end + +module Part : sig + module Value : sig + type t = + | Variable of string + | File of {filename : string; content : string Lwt_stream.t; length : int64 option} + end + + type t = + { name: string + ; value: Value.t + } +end + +val read : + request:Request.t + -> handle_part:(Part.t -> unit Lwt.t) + -> (unit, string) result + +val write_with_separator : + separator:string + -> request:Part.t Seq.t + -> (Request.t, string) result + +val write : + request:Part.t Seq.t + -> (Request.t, string) result diff --git a/lib/reader.ml b/lib/reader.ml index 009bb1c..db22f19 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -295,7 +295,7 @@ module Reader = struct end let read_inital_comments boundary reader = - let rec go comments = + let rec go comments = let%lwt line = Reader.read_line reader in print_endline ("Comment line : " ^ line); if line = boundary ^ "\r\n" then @@ -347,6 +347,11 @@ let rec compute_case reader boundary = end end +(** + * Read file part + * We construct a progressive stream that + * gets passed to the callback. + **) let iter_part reader boundary callback = let fin = ref false in let last () = @@ -354,7 +359,7 @@ let iter_part reader boundary callback = Lwt.return_unit in let handle ~send ~unread ~finish = - let%lwt () = callback send in + let%lwt () = callback send finish in Reader.unread reader unread; if finish then last () @@ -364,22 +369,66 @@ let iter_part reader boundary callback = while%lwt not !fin do let%lwt res = compute_case reader boundary in match res with - | `Empty -> last () - | `Boundary (pre, post) -> handle ~send:pre ~unread:post ~finish:true - | `May_end_with_boundary (unambiguous, ambiguous) -> handle ~send:unambiguous ~unread:ambiguous ~finish:false - | `App_data line -> callback line + | `Empty + -> + last () + | `Boundary (pre, post) + -> + handle ~send:pre ~unread:post ~finish:true + | `May_end_with_boundary (unambiguous, ambiguous) + -> + handle ~send:unambiguous ~unread:ambiguous ~finish:false + | `App_data line + -> + callback line false done let read_file_part reader boundary callback = iter_part reader boundary callback +(** + * Read string part + * We construct a buffer that will contain the entirety of + * the value before being passed to the callback. + **) +let iter_string_part reader boundary callback = + let fin = ref false in + let last () = + fin := true; + Lwt.return_unit + in + let handle ~send ~unread ~finish = + let%lwt () = callback send in + Reader.unread reader unread; + if finish then + last () + else + Lwt.return_unit + in + while%lwt not !fin do + let%lwt res = compute_case reader boundary in + match res with + | `Empty + -> + last () + | `Boundary (pre, post) + -> + handle ~send:pre ~unread:post ~finish:true + | `May_end_with_boundary (unambiguous, ambiguous) + -> + handle ~send:unambiguous ~unread:ambiguous ~finish:false + | `App_data line + -> + callback line + done + let read_string_part reader boundary = let value = Buffer.create 0 in let append_to_value line = Lwt.return (Buffer.add_string value line) in - let%lwt () = iter_part reader boundary append_to_value in + let%lwt () = iter_string_part reader boundary append_to_value in Lwt.return (Buffer.contents value) -let read_part reader boundary callback fields = +let read_part reader boundary variable_callback file_callback = let%lwt headers = read_headers reader in let content_disposition = List.assoc "Content-Disposition" headers in let name = @@ -388,32 +437,34 @@ let read_part reader boundary callback fields = | None -> invalid_arg "handle_multipart" in match parse_filename content_disposition with - | Some filename -> read_file_part reader boundary (callback ~name ~filename) + | Some filename -> read_file_part reader boundary (file_callback ~name ~filename) | None -> let%lwt value = read_string_part reader boundary in - fields := (name, value)::!fields; - Lwt.return_unit + variable_callback ~name ~value -let handle_multipart reader boundary callback = - let fields = (ref [] : (string * string) list ref) in - let%lwt () = +let handle_multipart reader boundary variable_callback file_callback = + let%lwt read_multipart = let%lwt _comments = read_inital_comments boundary reader in - print_endline ("Comments : " ^ _comments); let fin = ref false in while%lwt not !fin do if%lwt Reader.empty reader then Lwt.return (fin := true) else - read_part reader boundary callback fields + read_part reader boundary variable_callback file_callback done in - Lwt.return (!fields) + Lwt.return read_multipart -let parse ~stream ~content_type ~callback = +let parse ~stream ~content_type ~variable_callback ~file_callback = let reader = Reader.make stream in let boundary = match extract_boundary content_type with | Some s -> "--" ^ s | None -> invalid_arg ("Could not extract boundary from Content-Type : " ^ content_type) in - handle_multipart reader boundary callback + try + handle_multipart reader boundary variable_callback file_callback + |> Lwt_main.run + |> fun _ -> Ok () + with + | Invalid_argument e -> Error e diff --git a/lib/reader.mli b/lib/reader.mli deleted file mode 100644 index 4a96c2c..0000000 --- a/lib/reader.mli +++ /dev/null @@ -1,30 +0,0 @@ -(** - Align a stream on a particular sequence and remove these boundaries. - *) -val align : string Lwt_stream.t -> string -> string Lwt_stream.t Lwt_stream.t - -type stream_part - -val s_part_name : stream_part -> string - -val s_part_body : stream_part -> string Lwt_stream.t - -val s_part_filename : stream_part -> string option - -val parse_stream : stream:string Lwt_stream.t -> content_type:string -> stream_part Lwt_stream.t Lwt.t - -type file - -val file_name : file -> string -val file_content_type : file -> string -val file_stream : file -> string Lwt_stream.t - -module StringMap : Map.S with type key = string - -val get_parts : stream_part Lwt_stream.t -> [`String of string | `File of file] StringMap.t Lwt.t - -val parse : - stream:string Lwt_stream.t - -> content_type:string - -> callback:(name:string -> filename:string -> string -> unit Lwt.t) - -> (string * string) list Lwt.t diff --git a/lib/reader.mli.old b/lib/reader.mli.old new file mode 100644 index 0000000..3afa051 --- /dev/null +++ b/lib/reader.mli.old @@ -0,0 +1,30 @@ +module Request : sig + type t = + { headers : (string * string) list + ; body : string Lwt_stream.t + } +end + +module Part : sig + + module Value : sig + type t = + | Variable of string + | File of {filename : string; content : string Lwt_stream.t; length : int64 option} + end + + type t = + { name: string + ; value: Value.t + } +end + +val read : + request:Request.t + -> handle_part:(Part.t -> unit Lwt.t) + -> (unit, string) result + + +val write : + request:Part.t Seq.t + -> (Request.t, string) result diff --git a/lib/writer.ml b/lib/writer.ml index a107c4f..2acf0d4 100644 --- a/lib/writer.ml +++ b/lib/writer.ml @@ -5,20 +5,15 @@ module MultipartRequest = struct ; value : string } - type file_element = - { path : string - ; name : string - } - type stream_element = { name : string + ; filename : string ; content : string Lwt_stream.t - ; length : int + ; length : int64 } type element = | Form of form_element - | File of file_element | Stream of stream_element type t = @@ -28,14 +23,7 @@ module MultipartRequest = struct end -let init () = - Random.self_init(); - (* It does not matter if the random numbers are not safe here *) - { MultipartRequest.elements = [] - ; separator = "-----------------" ^ (string_of_int (Random.int 536870912)) - } - -let init_with_separator separator = +let init separator = { MultipartRequest.elements = [] ; separator = separator } @@ -44,33 +32,25 @@ let add_form_element ~name ~value mp = let open MultipartRequest in { mp with elements = Form { key=name; value=value } :: mp.elements} -let add_file_from_disk ~name ~path mp = - let open MultipartRequest in - { mp with - elements = - File { path=path - ; name=name - } - :: mp.elements - } - -let add_file_from_string ~name ~content mp = +let add_file_from_string ~name ~filename ~content mp = let open MultipartRequest in { mp with elements = Stream { content = Lwt_stream.of_list [ content ] ; name=name - ; length=String.length content + ; filename=filename + ; length=Int64.of_int(String.length content) } :: mp.elements } -let add_file_from_stream ~name ~content ~content_length mp = +let add_file_from_stream ~name ~filename ~content ~content_length mp = let open MultipartRequest in { mp with elements = Stream { content = content ; name=name + ; filename=filename ; length=content_length } :: mp.elements @@ -91,29 +71,28 @@ let open_file path = |> Lwt_io.open_file ~mode:Lwt_io.Input >|= read_while_not_empty >|= Lwt_stream.from - |> Lwt_result.ok + |> CCResult.pure let safe_open_file path = - try%lwt open_file path with - | Unix.Unix_error(Unix.ENOENT, _, _) -> Lwt_result.fail ("File " ^ path ^ " not found") - | Unix.Unix_error(Unix.EACCES, _, _) -> Lwt_result.fail ("Permission denied on " ^ path) - | Unix.Unix_error(Unix.EBUSY, _, _) -> Lwt_result.fail ("File " ^ path ^ " was busy") - | Unix.Unix_error(Unix.EISDIR, _, _) -> Lwt_result.fail ("File " ^ path ^ " is a directory") - | _ -> Lwt_result.fail ("Unknown error while reading file " ^ path) + try open_file path with + | Unix.Unix_error(Unix.ENOENT, _, _) -> CCResult.fail ("File " ^ path ^ " not found") + | Unix.Unix_error(Unix.EACCES, _, _) -> CCResult.fail ("Permission denied on " ^ path) + | Unix.Unix_error(Unix.EBUSY, _, _) -> CCResult.fail ("File " ^ path ^ " was busy") + | Unix.Unix_error(Unix.EISDIR, _, _) -> CCResult.fail ("File " ^ path ^ " is a directory") + | _ -> CCResult.fail ("Unknown error while reading file " ^ path) let file_size path = path |> Lwt_io.file_length - |> Lwt.map Int64.to_int - |> Lwt_result.ok + |> CCResult.pure let safe_file_size path = - try%lwt file_size path with - | Unix.Unix_error(Unix.ENOENT, _, _) -> Lwt_result.fail ("File " ^ path ^ " not found") - | Unix.Unix_error(Unix.EACCES, _, _) -> Lwt_result.fail ("Permission denied on " ^ path) - | Unix.Unix_error(Unix.EBUSY, _, _) -> Lwt_result.fail ("File " ^ path ^ " was busy") - | Unix.Unix_error(Unix.EISDIR, _, _) -> Lwt_result.fail ("File " ^ path ^ " is a directory") - | _ -> Lwt_result.fail ("Unknown error while reading file " ^ path) + try file_size path with + | Unix.Unix_error(Unix.ENOENT, _, _) -> CCResult.fail ("File " ^ path ^ " not found") + | Unix.Unix_error(Unix.EACCES, _, _) -> CCResult.fail ("Permission denied on " ^ path) + | Unix.Unix_error(Unix.EBUSY, _, _) -> CCResult.fail ("File " ^ path ^ " was busy") + | Unix.Unix_error(Unix.EISDIR, _, _) -> CCResult.fail ("File " ^ path ^ " is a directory") + | _ -> CCResult.fail ("Unknown error while reading file " ^ path) let element_header separator element = match element with @@ -124,50 +103,38 @@ let element_header separator element = ^ "\r\nContent-Disposition: form-data; name=\"" ^ f.key ^ "\"\r\n\r\n" - | File f - -> - "\r\n--" - ^ separator - ^ "\r\nContent-Disposition: form-data; name=\"file\"; filename=\"" - ^ f.name - ^ "\"\r\nContent-Type: application/octet-stream\r\n\r\n" | Stream s -> "\r\n--" ^ separator - ^ "\r\nContent-Disposition: form-data; name=\"file\"; filename=\"" + ^ "\r\nContent-Disposition: form-data; name=\"" ^ s.name + ^ "\"; filename=\"" + ^ s.filename ^ "\"\r\nContent-Type: application/octet-stream\r\n\r\n" let closing_line separator = "\r\n--" ^ separator ^ "--\r\n" let closing_line_size separator = - String.length (closing_line separator) + Int64.of_int (String.length (closing_line separator)) let element_to_string separator element = match element with | MultipartRequest.Form f -> - Lwt_result.return ( + CCResult.return ( Lwt_stream.of_list [ (element_header separator element) ; f.value ] ) - | File f - -> - let open Lwt_result.Infix in - let file_header = element_header separator element in - let file_header_stream = Lwt_stream.of_list [file_header] in - safe_open_file f.path - >|= fun (file_stream) -> Lwt_stream.append file_header_stream file_stream | Stream s -> let file_header = element_header separator element in let file_header_stream = Lwt_stream.of_list [file_header] in - Lwt_result.return ( + CCResult.return ( Lwt_stream.append file_header_stream s.content ) @@ -176,21 +143,14 @@ let element_size separator element = match element with | MultipartRequest.Form _ -> - Lwt_result.return ( - String.length (element_header separator element) + CCResult.return ( + Int64.of_int (String.length (element_header separator element)) ) - | File f - -> - let open Lwt_result.Infix in - let file_header = (element_header separator element) in - let file_header_size = String.length file_header in - safe_file_size f.path - >|= fun (file_size) -> file_header_size + file_size | Stream s -> let file_header = (element_header separator element) in - Lwt_result.return ( - (String.length file_header) + s.length + CCResult.return ( + Int64.add (Int64.of_int (String.length file_header)) s.length ) @@ -198,12 +158,12 @@ let rec mfoldl f acc l = match l with | h::t -> - Lwt_result.bind + CCResult.(>>=) h (fun value -> mfoldl f (f value acc) t) | [] -> - Lwt_result.return acc + CCResult.return acc let r_body mp = @@ -214,10 +174,10 @@ let r_body mp = let r_headers mp = let {MultipartRequest.elements; separator} = mp in - let open Lwt_result.Infix in + let open CCResult.Infix in elements |> List.map (element_size separator) - |> mfoldl (+) (closing_line_size separator) + |> mfoldl Int64.add (closing_line_size separator) >|= (fun (total_size) -> [ ("Content-Type", "multipart/form-data; boundary=" ^ separator) - ; ("Content-Length", string_of_int total_size)]) + ; ("Content-Length", Int64.to_string total_size)]) diff --git a/lib/writer.mli b/lib/writer.mli.old similarity index 100% rename from lib/writer.mli rename to lib/writer.mli.old diff --git a/multipart-form-data.opam b/multipart-form-data.opam index 83b5593..9b0a25a 100644 --- a/multipart-form-data.opam +++ b/multipart-form-data.opam @@ -15,6 +15,7 @@ run-test: [ depends: [ "alcotest" {with-test} "dune" {build} + "containers" "lwt" "lwt_ppx" "ocaml-migrate-parsetree" {build} diff --git a/test/test_read_write.ml b/test/test_read_write.ml deleted file mode 100644 index e34d135..0000000 --- a/test/test_read_write.ml +++ /dev/null @@ -1,69 +0,0 @@ -(* A series of tests confirming that the reader and writer - * modules are reversible. -*) - - -let string2_list = Alcotest.(list (pair string string)) - -let string3_list = Alcotest.(list (pair (pair string string) string)) - -let test ~name ~input ~expected_parts ~expected_calls = - ( name - , `Quick - , fun () -> - let (headers, body) = - input - |> List.fold_left - Test_writer.add_test_element - (Multipart_form_data.Writer.init_with_separator Test_writer.separator) - |> Test_writer.multipart_request_to_string - in - let content_type = - headers - |> List.fold_left - (fun acc (h, v) -> - match h with - | "Content-Type" -> v - | _ -> acc - ) - "" - in - let stream = Lwt_stream.of_list [ body ] in - let calls = ref [] in - let callback ~name ~filename line = - calls := !calls @ [((name, filename), line)]; - Lwt.return_unit - in - let parts = - Multipart_form_data.Reader.parse ~stream ~content_type ~callback - |> Lwt_main.run - in - Alcotest.(check string "header" ("multipart/form-data; boundary=" ^ Test_writer.separator) content_type); - Alcotest.check string2_list "parts" expected_parts parts; - Alcotest.check - string3_list - "calls" - (List.map (fun (x, y, z) -> ((x, y), z)) expected_calls) - !calls; - ) - -let read_write_tests = - [ test - ~name:"Simple form" - ~input:[Form ("key", "value")] - ~expected_parts:[("key", "value")] - ~expected_calls:[] - ; test - ~name:"Simple file" - ~input:[String ("filename", "file\r\ncontent\r\n")] - ~expected_parts:[] - ~expected_calls:[("file", "filename", "file\r\ncontent\r\n")] - ; test - ~name:"File and form" - ~input: - [ String ("filename", "file\r\ncontent\r\n") - ; Form ("key", "value\r\n") - ] - ~expected_parts:[("key", "value\r\n")] - ~expected_calls:[("file", "filename", "file\r\ncontent\r\n")] - ] diff --git a/test/test_reader.ml b/test/test_reader.ml index dca2526..af7646a 100644 --- a/test/test_reader.ml +++ b/test/test_reader.ml @@ -1,158 +1,107 @@ -let get_file name parts = - match Multipart_form_data.Reader.StringMap.find name parts with - | `File file -> file - | `String _ -> failwith "expected a file" +open Utils -module String_or_file = struct - type t = [`String of string | `File of Multipart_form_data.Reader.file] - - let equal = (=) - - let pp fmt (part : t) = - let s = match part with - | `File _ -> "File _" - | `String s -> s +let test ~name ~input ~expected_parts = + ( name + , `Quick + , fun () -> + let request = + { Multipart_form_data.Request.headers = test_headers + ; body = Lwt_stream.of_list [ input ] + } in - Format.pp_print_string fmt s -end - -let string_or_file = (module String_or_file : Alcotest.TESTABLE with type t = String_or_file.t) - -let test_parse () = - let body = - String.concat "\r\n" - [ {|--------------------------1605451f456c9a1a|} - ; {|Content-Disposition: form-data; name="a"|} - ; {||} - ; {|b|} - ; {|--------------------------1605451f456c9a1a|} - ; {|Content-Disposition: form-data; name="c"|} - ; {||} - ; {|d|} - ; {|--------------------------1605451f456c9a1a|} - ; {|Content-Disposition: form-data; name="upload"; filename="testfile"|} - ; {|Content-Type: application/octet-stream|} - ; {||} - ; {|testfilecontent|} - ; {||} - ; {|--------------------------1605451f456c9a1a--|} - ] - in - let content_type = "multipart/form-data; boundary=------------------------1605451f456c9a1a" in - let stream = Lwt_stream.of_list [body] in - let thread = - let%lwt parts_stream = Multipart_form_data.Reader.parse_stream ~stream ~content_type in - let%lwt parts = Multipart_form_data.Reader.get_parts parts_stream in - Alcotest.check string_or_file "'a' value" (`String "b") (Multipart_form_data.Reader.StringMap.find "a" parts); - Alcotest.check string_or_file "'c' value" (`String "d") (Multipart_form_data.Reader.StringMap.find "c" parts); - let file = get_file "upload" parts in - Alcotest.check Alcotest.string "filename" "upload" (Multipart_form_data.Reader.file_name file); - Alcotest.check Alcotest.string "content_type" "application/octet-stream" (Multipart_form_data.Reader.file_content_type file); - let%lwt file_chunks = Lwt_stream.to_list (Multipart_form_data.Reader.file_stream file) in - Alcotest.check Alcotest.string "contents" "testfilecontent" (String.concat "" file_chunks); - Lwt.return_unit - in - Lwt_main.run thread - -let tc content_type chunks expected_parts expected_calls = - let stream = Lwt_stream.of_list chunks in - let calls = ref [] in - let callback ~name ~filename line = - calls := !calls @ [((name, filename), line)]; - Lwt.return_unit - in - let%lwt parts = Multipart_form_data.Reader.parse ~stream ~content_type ~callback in - let string2_list = Alcotest.(list (pair string string)) in - let string3_list = Alcotest.(list (pair (pair string string) string)) in - Alcotest.check string2_list "parts" expected_parts parts; - Alcotest.check string3_list "calls" - (List.map (fun (x, y, z) -> ((x, y), z)) expected_calls) - !calls; - Lwt.return_unit - -let test_parse_request_complex () = - let cr = "\r" in - let lf = "\n" in - let crlf = cr ^ lf in - let thread = - tc "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" - ( List.map (String.concat lf) @@ - [ [ {|--9219489391874b51bb29b52a10e8baac|} ^ cr - ; {|Content-Disposition: form-data; name="foo"|} ^ cr - ; {||} ^ cr - ; {|toto|} ^ cr - ; {|--9219489391874b51bb29b52a10e8baac|} ^ cr - ; {|Content-Disposition: form-data; name="bar"; filename="filename.data"|} ^ cr - ; {|Content-Type: application/octet-stream|} ^ cr - ; {||} ^ cr - ; {|line1|} ^ crlf - ; {|line2|} - ; {||} - ] - ; [ {|line3|} - ; {|line4|} - ; {||} - ] - ; [ {|line5|} - ; {|line6|} ^ crlf ^ cr - ; {|--9219489391874b51bb29b52a10e8baac--|} ^ cr - ; {||} - ] - ] - ) - [ ("foo", "toto") ] - [ ("bar", "filename.data", "line1\r\n\nline2\n") - ; ("bar", "filename.data", "line3\nline4\n") - ; ("bar", "filename.data", "line5\nline6\r\n") - ] - in - Lwt_main.run thread + let (callback, read) = testable_callback_factory () in + let result = Multipart_form_data.read ~request ~handle_part:callback in + let resulting_parts = + read () + |> List.map part_to_testable + in + let expected_parts = + expected_parts + |> List.map part_to_testable + in + Alcotest.(check (result unit string)) (name ^ " result") (Ok ()) result; + Alcotest.(check int) + (name ^ " part count") + (List.length expected_parts) + (List.length resulting_parts); + Alcotest.(check (list (pair (list string) (option int64)))) + (name ^ "parts") + expected_parts + resulting_parts + ) -let test_parse_request_easy () = - let cr = "\r" in - let lf = "\n" in - let crlf = cr ^ lf in - let thread = - tc - "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" - ( - [ {|--9219489391874b51bb29b52a10e8baac|} ^ crlf - ; {|Content-Disposition: form-data; name="foo"|} ^ crlf - ; crlf - ; {|toto|} ^ crlf - ; {|--9219489391874b51bb29b52a10e8baac--|} ^ crlf - ] - ) - [ ("foo", "toto") ] - [] - in - Lwt_main.run thread +let reader_tests = + [ test + ~name:"Simple form" + ~input:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"key\"" + ^ "\r\n" ^ "\r\n" + ^ "value" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ~expected_parts:[{ Multipart_form_data.Part.name = "key" + ; value = Variable "value" + }] + ; test + ~name:"File" + ~input:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" + ^ "\r\n" + ^ "Content-Type: application/octet-stream" + ^ "\r\n" ^ "\r\n" + ^ "this is the content of our file\r\n" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ~expected_parts:[{ Multipart_form_data.Part.name = "filename" + ; value = File { filename = "originalname" + ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] + ; length = None + } + }] -let test_split () = - let in_stream = - Lwt_stream.of_list - [ "ABCD" - ; "EFap" - ; "ple" - ; "ABCDEFor" - ; "angeABC" - ; "HHpl" - ; "umABCDEFkiwi" - ; "ABCDEF" - ] - in - let expected = - [ ["ap" ; "ple"] - ; ["or"; "ange"; "ABCHHpl"; "um"] - ; ["kiwi"] - ; [] - ] - in - let stream = Multipart_form_data.Reader.align in_stream "ABCDEF" in - Lwt_main.run ( - let%lwt streams = Lwt_stream.to_list stream in - let%lwt result = Lwt_list.map_s Lwt_stream.to_list streams in - Alcotest.check Alcotest.(list (list string)) "contents" expected result; - Lwt.return_unit - ) + ; test + ~name:"Mixed" + ~input:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"var1\"" + ^ "\r\n" ^ "\r\n" + ^ "\r\ntest\r\n" + ^ "\r\n" + ^ "--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" + ^ "\r\n" + ^ "Content-Type: application/octet-stream" + ^ "\r\n" ^ "\r\n" + ^ "this is \r\nthe content of our file\r\n" + ^ "\r\n" + ^ "--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"var2\"" + ^ "\r\n" ^ "\r\n" + ^ "end===stuff" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ~expected_parts:[ { Multipart_form_data.Part.name = "var2" + ; value = Variable "end===stuff" + } + ; { Multipart_form_data.Part.name = "filename" + ; value = File { filename = "originalname" + ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] + ; length = None + } + } + ; { Multipart_form_data.Part.name = "var1" + ; value = Variable "\r\ntest\r\n" + } + ] + ] diff --git a/test/test_reader_writer.ml b/test/test_reader_writer.ml new file mode 100644 index 0000000..42c8490 --- /dev/null +++ b/test/test_reader_writer.ml @@ -0,0 +1,104 @@ +open Utils + +let test ~name ~input ~expected_parts = + ( name + , `Quick + , fun () -> + let request = + { Multipart_form_data.Request.headers = test_headers + ; body = Lwt_stream.of_list [ input ] + } + in + let (callback, read) = testable_callback_factory () in + let result = Multipart_form_data.read ~request ~handle_part:callback in + Alcotest.(check (result unit string)) (name ^ " read result") (Ok ()) result; + let resulting_parts = read () in + Alcotest.(check int) + (name ^ " read parts vs expected parts") + (List.length expected_parts) + (List.length resulting_parts); + let request = + match Multipart_form_data.write_with_separator + ~separator + ~request:(List.to_seq expected_parts) + with + | Ok r -> r + | Error _ -> empty_request + in + Alcotest.(check string) (name ^ " body") input (stream_to_string request.body) + ) + + +let read_write_tests = + [ test + ~name:"Simple form" + ~input:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"key\"" + ^ "\r\n" ^ "\r\n" + ^ "value" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ~expected_parts:[{ Multipart_form_data.Part.name = "key" + ; value = Variable "value" + }] + ; test + ~name:"File from string" + ~input:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" + ^ "\r\n" + ^ "Content-Type: application/octet-stream" + ^ "\r\n" ^ "\r\n" + ^ "this is the content of our file\r\n" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ~expected_parts:[{ Multipart_form_data.Part.name = "filename" + ; value = File { filename = "originalname" + ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] + ; length = Some (Int64.of_int 33) + } + }] + ; test + ~name:"Mixed variable and file" + ~input:("\r\n--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"var1\"" + ^ "\r\n" ^ "\r\n" + ^ "\r\ntest\r\n" + ^ "\r\n" + ^ "--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" + ^ "\r\n" + ^ "Content-Type: application/octet-stream" + ^ "\r\n" ^ "\r\n" + ^ "this is \r\nthe content of our file\r\n" + ^ "\r\n" + ^ "--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"var2\"" + ^ "\r\n" ^ "\r\n" + ^ "end===stuff" + ^ "\r\n" + ^ "--" ^ separator ^ "--" + ^ "\r\n" + ) + ~expected_parts:[ { Multipart_form_data.Part.name = "var1" + ; value = Variable "\r\ntest\r\n" + } + ; { Multipart_form_data.Part.name = "filename" + ; value = File { filename = "originalname" + ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] + ; length = Some (Int64.of_int 35) + } + } + ; { Multipart_form_data.Part.name = "var2" + ; value = Variable "end===stuff" + } + ] + ] diff --git a/test/test_writer.ml b/test/test_writer.ml index c6df301..9d6ea47 100644 --- a/test/test_writer.ml +++ b/test/test_writer.ml @@ -1,99 +1,16 @@ -let get_file name parts = - match Multipart_form_data.Reader.StringMap.find name parts with - | `File file -> file - | `String _ -> failwith "expected a file" - -module String_or_file = struct - type t = [`String of string | `File of Multipart_form_data.Reader.file] - - let equal = (=) - - let pp fmt (part : t) = - let s = match part with - | `File _ -> "File _" - | `String s -> s - in - Format.pp_print_string fmt s -end - -let string_or_file = (module String_or_file : Alcotest.TESTABLE with type t = String_or_file.t) - -module TestInput = struct - type t = - | Form of (string * string) - | File of (string * string) - | Stream of (string * string) - | String of (string * string) -end - -let multipart_request_to_string mp = - let body_result = - mp - |> Multipart_form_data.Writer.r_body - |> Lwt_main.run in - let header_result = - mp - |> Multipart_form_data.Writer.r_headers - |> Lwt_main.run in - match (header_result, body_result) with - | (Ok headers, Ok stream) - -> - ( headers - , stream - |> Lwt_stream.get_available - |> String.concat "" - ) - | (_, Error err) - | (Error err, _) - -> - ([], err) - -let separator = "---------------16456c9a1a" - -let add_test_element mp element = - match element with - | TestInput.Form (name, value) -> Multipart_form_data.Writer.add_form_element ~name ~value mp - | File (name, path) -> Multipart_form_data.Writer.add_file_from_disk ~name ~path mp - | Stream (name, content) -> - Multipart_form_data.Writer.add_file_from_stream - ~name - ~content:(Lwt_stream.of_list [ content ]) - ~content_length:(String.length content) - mp - | String (name, content) -> - Multipart_form_data.Writer.add_file_from_string - ~name - ~content - mp - +open Utils let test ~name ~input ~expected_headers ~expected_body = ( name , `Quick , fun () -> - let (headers, body) = - input - |> List.fold_left - add_test_element - (Multipart_form_data.Writer.init_with_separator separator) - |> multipart_request_to_string + let request = + match Multipart_form_data.write_with_separator ~separator ~request:(List.to_seq input) with + | Ok r -> r + | Error _ -> empty_request in - Alcotest.(check (list (pair string string))) (name ^ "_headers") expected_headers headers; - Alcotest.(check string) (name ^ "_body") expected_body body - ) - -let test_fail ~name ~input ~expected_error = - ( name - , `Quick - , fun () -> - let (_, error) = - input - |> List.fold_left - add_test_element - (Multipart_form_data.Writer.init_with_separator separator) - |> multipart_request_to_string - in - Alcotest.(check string) name expected_error error + Alcotest.(check (list (pair string string))) (name ^ " headers") expected_headers request.headers; + Alcotest.(check string) (name ^ " body") expected_body (stream_to_string request.body) ) let writer_tests = @@ -107,7 +24,9 @@ let writer_tests = ~expected_body:("\r\n--" ^ separator ^ "--\r\n") ; test ~name:"Simple form" - ~input:[Form ("key", "value")] + ~input:[{ Multipart_form_data.Part.name = "key" + ; value = Variable "value" + }] ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); ("Content-Length", "110")] ~expected_body:("\r\n--" ^ separator @@ -119,18 +38,19 @@ let writer_tests = ^ "--" ^ separator ^ "--" ^ "\r\n" ) - ; test_fail - ~name:"Missing file" - ~input:[File ("missing_file", "/this/file/does/not/exist")] - ~expected_error:"File /this/file/does/not/exist not found" ; test ~name:"File from string" - ~input:[String ("filename", "this is the content of our file\r\n")] + ~input:[{ Multipart_form_data.Part.name = "filename" + ; value = File { filename = "originalname" + ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] + ; length = Some (Int64.of_int 33) + } + }] ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); - ("Content-Length", "205")] + ("Content-Length", "213")] ~expected_body:("\r\n--" ^ separator ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"file\"; filename=\"filename\"" + ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" ^ "\r\n" ^ "Content-Type: application/octet-stream" ^ "\r\n" ^ "\r\n" @@ -140,17 +60,41 @@ let writer_tests = ^ "\r\n" ) ; test - ~name:"File from stream" - ~input:[Stream ("filename", "this is the content of our file\r\n")] + ~name:"Mixed variable and file" + ~input:[ { Multipart_form_data.Part.name = "var1" + ; value = Variable "\r\ntest\r\n" + } + ; { Multipart_form_data.Part.name = "filename" + ; value = File { filename = "originalname" + ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] + ; length = Some (Int64.of_int 35) + } + } + ; { Multipart_form_data.Part.name = "var2" + ; value = Variable "end===stuff" + } + ] ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); - ("Content-Length", "205")] + ("Content-Length", "371")] ~expected_body:("\r\n--" ^ separator ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"file\"; filename=\"filename\"" + ^ "Content-Disposition: form-data; name=\"var1\"" + ^ "\r\n" ^ "\r\n" + ^ "\r\ntest\r\n" + ^ "\r\n" + ^ "--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" ^ "\r\n" ^ "Content-Type: application/octet-stream" ^ "\r\n" ^ "\r\n" - ^ "this is the content of our file\r\n" + ^ "this is \r\nthe content of our file\r\n" + ^ "\r\n" + ^ "--" ^ separator + ^ "\r\n" + ^ "Content-Disposition: form-data; name=\"var2\"" + ^ "\r\n" ^ "\r\n" + ^ "end===stuff" ^ "\r\n" ^ "--" ^ separator ^ "--" ^ "\r\n" diff --git a/test/tests.ml b/test/tests.ml index 9b67420..665bddf 100644 --- a/test/tests.ml +++ b/test/tests.ml @@ -1,16 +1,12 @@ let () = Alcotest.run "multipart-form-data" [ - ("Multipart_form_data.Reader", - [ "parse", `Quick, Test_reader.test_parse - ; "parse_easy_request", `Quick, Test_reader.test_parse_request_easy - ; "parse_complex_request", `Quick, Test_reader.test_parse_request_complex - ; "split", `Quick, Test_reader.test_split - ] + ("Multipart_form_data - read", + Test_reader.reader_tests ) - ; ("Multipart_form_data.Writer", + ; ("Multipart_form_data - write", Test_writer.writer_tests ) - ; ("Multipart_form_data.Reader & Writer", - Test_read_write.read_write_tests + ; ("Multipart_form_data - read & write", + Test_reader_writer.read_write_tests ) ] diff --git a/test/utils.ml b/test/utils.ml new file mode 100644 index 0000000..3cd8662 --- /dev/null +++ b/test/utils.ml @@ -0,0 +1,29 @@ +let stream_to_string stream = + stream + |> Lwt_stream.get_available + |> String.concat "" + +let part_to_testable part = + match part with + | {Multipart_form_data.Part.name=name; value=Variable value} + -> + (["variable"; name; ""; value], None) + | {name=name; value=File {filename=filename; content=content; length=length}} + -> + (["file"; name; filename; stream_to_string content], length) + +let testable_callback_factory () = + let parts = ref [] in + let callback part = + Lwt.return (parts := part :: !parts) + in + let read () = + !parts + in + (callback, read) + +let empty_request = {Multipart_form_data.Request.headers = []; body = Lwt_stream.of_list [""]} + +let separator = "===============1269689916" + +let test_headers = [("Content-Type", "multipart/form-data; boundary=" ^ separator)] From c313b23dd72f04bef3808078f828a4e8a471bf58 Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Mon, 3 Jun 2019 15:40:44 +0200 Subject: [PATCH 4/9] Add Ocaml 4.07 build --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 90f6ac8..d8fe6b0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,3 +12,4 @@ env: - OCAML_VERSION=4.04 - OCAML_VERSION=4.05 - OCAML_VERSION=4.06 + - OCAML_VERSION=4.07 From 495f21ec7a2b65735304d073c9cd90e1c5159d56 Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Thu, 6 Jun 2019 16:28:02 +0200 Subject: [PATCH 5/9] New, simpler API MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fix bug where the all the files would end up in the same stream Add test with multiple «files» Add test/utils.mli Removed old files and unused functions --- lib/multipart_form_data.ml | 100 ++++++++++------ lib/multipart_form_data.mli | 14 +-- lib/reader.ml | 46 ++------ lib/reader.mli.old | 30 ----- lib/writer.ml | 127 +++++---------------- lib/writer.mli.old | 18 --- test/dune | 1 + test/test_reader.ml | 221 +++++++++++++++++++++++------------- test/test_reader_writer.ml | 164 ++++++++++++++------------ test/test_writer.ml | 186 +++++++++++++++++------------- test/utils.ml | 22 ++-- test/utils.mli | 11 ++ 12 files changed, 476 insertions(+), 464 deletions(-) delete mode 100644 lib/reader.mli.old delete mode 100644 lib/writer.mli.old create mode 100644 test/utils.mli diff --git a/lib/multipart_form_data.ml b/lib/multipart_form_data.ml index 27bf503..96b226a 100644 --- a/lib/multipart_form_data.ml +++ b/lib/multipart_form_data.ml @@ -6,26 +6,32 @@ module Request = struct end module Part = struct - module Value = struct - type t = - | Variable of string - | File of {filename : string; content : string Lwt_stream.t; length : int64 option} - end - type t = { name: string - ; value: Value.t + ; filename: string option + ; content_length: int64 option + ; content: string Lwt_stream.t } end +(** + * Utils + **) +let rec lowercase_first = function + | (h, v)::t -> ((String.lowercase_ascii h), v)::(lowercase_first t) + | [] -> [] + (** * Read multipart streams **) -let variable_callback_factory ~callback ~name ~value = - callback {Part.name = name; value = Variable value} +type content_part_struct = + { cache: (string list) ref + ; finished: bool ref + ; stream: string Lwt_stream.t + } -let file_callback_factory ~callback = +let stream_factory () = let cache = (ref []: (string list) ref) in let finished = (ref false) in let generator () = @@ -35,21 +41,52 @@ let file_callback_factory ~callback = | (h::t, _) -> cache := t; Some h in let stream = Lwt_stream.from_direct generator in - let file_callback ~name ~filename line is_finished = - cache := line::!cache; - finished := is_finished; - callback - { Part.name = name - ; value = File {filename = filename; content = stream; length = None} - } + { cache = cache + ; finished = finished + ; stream = stream + } + +let callback_factory ~callback = + let current_part = ref (stream_factory ()) in + let generate_new_stream = ref true in + let caching_callback ~name ~filename line is_finished = + if !generate_new_stream then + (* We finished the previous part and start a new one *) + let _ = + current_part := stream_factory (); + (* Add line to the stream *) + !current_part.cache := line::!(!current_part.cache); + !current_part.finished := is_finished; + in + generate_new_stream := is_finished; + (* Call the callback with the stream that we just generated *) + callback + { Part.name = name + ; filename = filename + ; content_length = None + ; content = !current_part.stream + } + else + (* Continuation of the last part *) + let _ = + !current_part.cache := line::!(!current_part.cache); + !current_part.finished := is_finished; + in + (* If the current part is finished, we need to put the next + * incoming line into a new stream. + *) + generate_new_stream := is_finished; + Lwt.return () in - file_callback + caching_callback let part_parser callback headers body = - let file_callback = file_callback_factory ~callback in - let variable_callback = variable_callback_factory ~callback in - let content_type = List.assoc "Content-Type" headers in - Reader.parse ~stream:body ~content_type ~variable_callback ~file_callback + let callback = callback_factory ~callback in + let lowercased_headers = lowercase_first headers in + let content_type = List.assoc "content-type" lowercased_headers in + print_endline content_type; + try (Reader.parse ~stream:body ~content_type ~callback) with + | _ -> print_endline "EXCEPTION"; Ok () let read ~request ~handle_part = let {Request.headers; body} = request in @@ -61,23 +98,20 @@ let read ~request ~handle_part = let add_part_to_multipart_request multipart_request part = match part with - | {Part.name=name; value=Variable value} - -> - Writer.add_form_element ~name ~value multipart_request - | {name=name; value=(File {filename=filename; content=content; length=Some content_length})} - -> - Writer.add_file_from_stream ~name ~filename ~content ~content_length multipart_request - | {name=_; value=File {filename=_; content=_; length=None}} + | {Part.name = _; filename = _; content_length = None; content = _} -> failwith "File length is required when writing a multipart request body" + | {name = name; filename = filename; content_length = Some content_length; content = content} + -> + Writer.add_from_stream ~name ~filename ~content ~content_length multipart_request -let write_with_separator ~separator ~request = +let write_with_boundary ~boundary ~request = let open CCResult.Infix in let multipart_request = Seq.fold_left add_part_to_multipart_request - (Writer.init separator) + (Writer.init boundary) request in Writer.r_headers multipart_request @@ -90,5 +124,5 @@ let write_with_separator ~separator ~request = let write ~request = Random.self_init (); (* It does not matter if the random numbers are not safe here *) - let separator = "-----------------" ^ (string_of_int (Random.int 536870912)) in - write_with_separator ~separator ~request + let boundary = "-----------------" ^ (string_of_int (Random.int 536870912)) in + write_with_boundary ~boundary ~request diff --git a/lib/multipart_form_data.mli b/lib/multipart_form_data.mli index 9770f5a..e45add0 100644 --- a/lib/multipart_form_data.mli +++ b/lib/multipart_form_data.mli @@ -6,15 +6,11 @@ module Request : sig end module Part : sig - module Value : sig - type t = - | Variable of string - | File of {filename : string; content : string Lwt_stream.t; length : int64 option} - end - type t = { name: string - ; value: Value.t + ; filename: string option + ; content_length: int64 option + ; content: string Lwt_stream.t } end @@ -23,8 +19,8 @@ val read : -> handle_part:(Part.t -> unit Lwt.t) -> (unit, string) result -val write_with_separator : - separator:string +val write_with_boundary : + boundary:string -> request:Part.t Seq.t -> (Request.t, string) result diff --git a/lib/reader.ml b/lib/reader.ml index db22f19..e578076 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -156,25 +156,6 @@ type stream_part = ; body : string Lwt_stream.t } -let parse_part chunk_stream = - let lines = align chunk_stream "\r\n" in - match%lwt get_headers lines with - | [] -> Lwt.return_none - | headers -> - let body = Lwt_stream.concat @@ Lwt_stream.clone lines in - Lwt.return_some { headers ; body } - -let parse_stream ~stream ~content_type = - match extract_boundary content_type with - | None -> Lwt.fail_with "Cannot parse content-type" - | Some boundary -> - begin - let actual_boundary = ("--" ^ boundary) in - Lwt.return @@ Lwt_stream.filter_map_s parse_part @@ align stream actual_boundary - end - -let s_part_body {body; _} = body - let s_part_name {headers; _} = match parse_name @@ List.assoc "Content-Disposition" headers @@ -198,14 +179,6 @@ let parse_filename s = let s_part_filename {headers; _} = parse_filename @@ List.assoc "Content-Disposition" headers -type file = stream_part - -let file_stream = s_part_body -let file_name = s_part_name - -let file_content_type {headers; _} = - List.assoc "Content-Type" headers - let as_part part = match s_part_filename part with | Some _filename -> @@ -297,7 +270,6 @@ end let read_inital_comments boundary reader = let rec go comments = let%lwt line = Reader.read_line reader in - print_endline ("Comment line : " ^ line); if line = boundary ^ "\r\n" then Lwt.return comments else @@ -309,7 +281,6 @@ let read_inital_comments boundary reader = let read_headers reader = let rec go headers = let%lwt line = Reader.read_line reader in - print_endline ("Header line : " ^ line); if line = "\r\n" then Lwt.return headers else @@ -428,7 +399,7 @@ let read_string_part reader boundary = let%lwt () = iter_string_part reader boundary append_to_value in Lwt.return (Buffer.contents value) -let read_part reader boundary variable_callback file_callback = +let read_part reader boundary callback = let%lwt headers = read_headers reader in let content_disposition = List.assoc "Content-Disposition" headers in let name = @@ -436,13 +407,10 @@ let read_part reader boundary variable_callback file_callback = | Some x -> x | None -> invalid_arg "handle_multipart" in - match parse_filename content_disposition with - | Some filename -> read_file_part reader boundary (file_callback ~name ~filename) - | None -> - let%lwt value = read_string_part reader boundary in - variable_callback ~name ~value + let filename = parse_filename content_disposition in + read_file_part reader boundary (callback ~name ~filename) -let handle_multipart reader boundary variable_callback file_callback = +let handle_multipart reader boundary callback = let%lwt read_multipart = let%lwt _comments = read_inital_comments boundary reader in let fin = ref false in @@ -450,12 +418,12 @@ let handle_multipart reader boundary variable_callback file_callback = if%lwt Reader.empty reader then Lwt.return (fin := true) else - read_part reader boundary variable_callback file_callback + read_part reader boundary callback done in Lwt.return read_multipart -let parse ~stream ~content_type ~variable_callback ~file_callback = +let parse ~stream ~content_type ~callback = let reader = Reader.make stream in let boundary = match extract_boundary content_type with @@ -463,7 +431,7 @@ let parse ~stream ~content_type ~variable_callback ~file_callback = | None -> invalid_arg ("Could not extract boundary from Content-Type : " ^ content_type) in try - handle_multipart reader boundary variable_callback file_callback + handle_multipart reader boundary callback |> Lwt_main.run |> fun _ -> Ok () with diff --git a/lib/reader.mli.old b/lib/reader.mli.old deleted file mode 100644 index 3afa051..0000000 --- a/lib/reader.mli.old +++ /dev/null @@ -1,30 +0,0 @@ -module Request : sig - type t = - { headers : (string * string) list - ; body : string Lwt_stream.t - } -end - -module Part : sig - - module Value : sig - type t = - | Variable of string - | File of {filename : string; content : string Lwt_stream.t; length : int64 option} - end - - type t = - { name: string - ; value: Value.t - } -end - -val read : - request:Request.t - -> handle_part:(Part.t -> unit Lwt.t) - -> (unit, string) result - - -val write : - request:Part.t Seq.t - -> (Request.t, string) result diff --git a/lib/writer.ml b/lib/writer.ml index 2acf0d4..58ba668 100644 --- a/lib/writer.ml +++ b/lib/writer.ml @@ -1,21 +1,12 @@ module MultipartRequest = struct - type form_element = - { key : string - ; value : string - } - - type stream_element = + type element = { name : string - ; filename : string + ; filename : string option ; content : string Lwt_stream.t ; length : int64 } - type element = - | Form of form_element - | Stream of stream_element - type t = { elements : element list ; separator : string @@ -28,89 +19,48 @@ let init separator = ; separator = separator } -let add_form_element ~name ~value mp = - let open MultipartRequest in - { mp with elements = Form { key=name; value=value } :: mp.elements} - -let add_file_from_string ~name ~filename ~content mp = +let add_from_string ~name ~filename ~content mp = let open MultipartRequest in { mp with elements = - Stream { content = Lwt_stream.of_list [ content ] - ; name=name - ; filename=filename - ; length=Int64.of_int(String.length content) - } + { content = Lwt_stream.of_list [ content ] + ; name=name + ; filename=filename + ; length=Int64.of_int(String.length content) + } :: mp.elements } -let add_file_from_stream ~name ~filename ~content ~content_length mp = +let add_from_stream ~name ~filename ~content ~content_length mp = let open MultipartRequest in { mp with elements = - Stream { content = content - ; name=name - ; filename=filename - ; length=content_length - } + { content = content + ; name=name + ; filename=filename + ; length=content_length + } :: mp.elements } -let open_file path = - (* This function returns a buffered IO read of a file *) - let open Lwt.Infix in - let read_while_not_empty channel () = - (Lwt_io.read ~count:4096 channel) - >|= (fun chunck -> - match chunck with - | "" -> None - | _ -> Some chunck - ) - in - path - |> Lwt_io.open_file ~mode:Lwt_io.Input - >|= read_while_not_empty - >|= Lwt_stream.from - |> CCResult.pure - -let safe_open_file path = - try open_file path with - | Unix.Unix_error(Unix.ENOENT, _, _) -> CCResult.fail ("File " ^ path ^ " not found") - | Unix.Unix_error(Unix.EACCES, _, _) -> CCResult.fail ("Permission denied on " ^ path) - | Unix.Unix_error(Unix.EBUSY, _, _) -> CCResult.fail ("File " ^ path ^ " was busy") - | Unix.Unix_error(Unix.EISDIR, _, _) -> CCResult.fail ("File " ^ path ^ " is a directory") - | _ -> CCResult.fail ("Unknown error while reading file " ^ path) - -let file_size path = - path - |> Lwt_io.file_length - |> CCResult.pure - -let safe_file_size path = - try file_size path with - | Unix.Unix_error(Unix.ENOENT, _, _) -> CCResult.fail ("File " ^ path ^ " not found") - | Unix.Unix_error(Unix.EACCES, _, _) -> CCResult.fail ("Permission denied on " ^ path) - | Unix.Unix_error(Unix.EBUSY, _, _) -> CCResult.fail ("File " ^ path ^ " was busy") - | Unix.Unix_error(Unix.EISDIR, _, _) -> CCResult.fail ("File " ^ path ^ " is a directory") - | _ -> CCResult.fail ("Unknown error while reading file " ^ path) let element_header separator element = - match element with - | MultipartRequest.Form f + match element.MultipartRequest.filename with + | None -> "\r\n--" ^ separator ^ "\r\nContent-Disposition: form-data; name=\"" - ^ f.key + ^ element.name ^ "\"\r\n\r\n" - | Stream s + | Some filename -> "\r\n--" ^ separator ^ "\r\nContent-Disposition: form-data; name=\"" - ^ s.name + ^ element.name ^ "\"; filename=\"" - ^ s.filename + ^ filename ^ "\"\r\nContent-Type: application/octet-stream\r\n\r\n" let closing_line separator = @@ -121,37 +71,18 @@ let closing_line_size separator = let element_to_string separator element = - match element with - | MultipartRequest.Form f - -> - CCResult.return ( - Lwt_stream.of_list - [ (element_header separator element) - ; f.value - ] - ) - | Stream s - -> - let file_header = element_header separator element in - let file_header_stream = Lwt_stream.of_list [file_header] in - CCResult.return ( - Lwt_stream.append file_header_stream s.content - ) + let file_header = element_header separator element in + let file_header_stream = Lwt_stream.of_list [file_header] in + CCResult.return ( + Lwt_stream.append file_header_stream element.content + ) let element_size separator element = - match element with - | MultipartRequest.Form _ - -> - CCResult.return ( - Int64.of_int (String.length (element_header separator element)) - ) - | Stream s - -> - let file_header = (element_header separator element) in - CCResult.return ( - Int64.add (Int64.of_int (String.length file_header)) s.length - ) + let file_header = (element_header separator element) in + CCResult.return ( + Int64.add (Int64.of_int (String.length file_header)) element.length + ) let rec mfoldl f acc l = diff --git a/lib/writer.mli.old b/lib/writer.mli.old deleted file mode 100644 index 5b88a5c..0000000 --- a/lib/writer.mli.old +++ /dev/null @@ -1,18 +0,0 @@ -module MultipartRequest : sig - type t -end - -val init : unit -> MultipartRequest.t -val init_with_separator : string -> MultipartRequest.t -val add_form_element : name:string -> value:string -> MultipartRequest.t -> MultipartRequest.t -val add_file_from_disk : name:string -> path:string -> MultipartRequest.t -> MultipartRequest.t -val add_file_from_string : name:string -> content:string -> MultipartRequest.t -> MultipartRequest.t -val add_file_from_stream : - name:string -> - content:(string Lwt_stream.t) -> - content_length:int -> - MultipartRequest.t -> - MultipartRequest.t - -val r_body : MultipartRequest.t -> (string Lwt_stream.t, string) Lwt_result.t -val r_headers : MultipartRequest.t -> ((string * string) list, string) Lwt_result.t diff --git a/test/dune b/test/dune index 2968eba..60aee05 100644 --- a/test/dune +++ b/test/dune @@ -4,6 +4,7 @@ multipart-form-data alcotest lwt.unix + seq ) (preprocess (pps diff --git a/test/test_reader.ml b/test/test_reader.ml index af7646a..d649c6d 100644 --- a/test/test_reader.ml +++ b/test/test_reader.ml @@ -1,107 +1,172 @@ -open Utils - let test ~name ~input ~expected_parts = ( name , `Quick , fun () -> let request = - { Multipart_form_data.Request.headers = test_headers + { Multipart_form_data.Request.headers = Utils.test_headers ; body = Lwt_stream.of_list [ input ] } in - let (callback, read) = testable_callback_factory () in + let (callback, read) = Utils.testable_callback_factory () in let result = Multipart_form_data.read ~request ~handle_part:callback in let resulting_parts = read () - |> List.map part_to_testable - in - let expected_parts = - expected_parts - |> List.map part_to_testable in Alcotest.(check (result unit string)) (name ^ " result") (Ok ()) result; Alcotest.(check int) (name ^ " part count") (List.length expected_parts) (List.length resulting_parts); - Alcotest.(check (list (pair (list string) (option int64)))) - (name ^ "parts") - expected_parts + Utils.test_parts + ~name:(name ^ "parts") + ~expected:expected_parts resulting_parts ) let reader_tests = [ test ~name:"Simple form" - ~input:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"key\"" - ^ "\r\n" ^ "\r\n" - ^ "value" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) - ~expected_parts:[{ Multipart_form_data.Part.name = "key" - ; value = Variable "value" - }] + ~input: + (Printf.sprintf + "\ + \r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"key\"\r\n\ + \r\n\ + value\r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + ) + ~expected_parts: + [ { Multipart_form_data.Part.name = "key" + ; content = Lwt_stream.of_list [ "value" ] + ; content_length = None + ; filename = None + } + ] ; test ~name:"File" - ~input:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" - ^ "\r\n" - ^ "Content-Type: application/octet-stream" - ^ "\r\n" ^ "\r\n" - ^ "this is the content of our file\r\n" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) - ~expected_parts:[{ Multipart_form_data.Part.name = "filename" - ; value = File { filename = "originalname" - ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] - ; length = None - } - }] + ~input: + (Printf.sprintf + "\ + \r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"\r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is the content of our file\r\n\r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + ) + ~expected_parts: + [ { Multipart_form_data.Part.name = "filename" + ; filename = Some "originalname" + ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] + ; content_length = None + } + ] ; test ~name:"Mixed" - ~input:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"var1\"" - ^ "\r\n" ^ "\r\n" - ^ "\r\ntest\r\n" - ^ "\r\n" - ^ "--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" - ^ "\r\n" - ^ "Content-Type: application/octet-stream" - ^ "\r\n" ^ "\r\n" - ^ "this is \r\nthe content of our file\r\n" - ^ "\r\n" - ^ "--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"var2\"" - ^ "\r\n" ^ "\r\n" - ^ "end===stuff" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) - ~expected_parts:[ { Multipart_form_data.Part.name = "var2" - ; value = Variable "end===stuff" - } - ; { Multipart_form_data.Part.name = "filename" - ; value = File { filename = "originalname" - ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] - ; length = None - } - } - ; { Multipart_form_data.Part.name = "var1" - ; value = Variable "\r\ntest\r\n" - } - ] - + ~input: + (Printf.sprintf + "\ + \r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"var1\"\r\n\ + \r\n\ + \r\ntest\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"\r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is \r\nthe content of our file\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"var2\"\r\n\ + \r\n\ + end===stuff\ + \r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + Utils.boundary + Utils.boundary + ) + ~expected_parts: + [ { Multipart_form_data.Part.name = "var2" + ; content = Lwt_stream.of_list [ "end===stuff" ] + ; content_length = None + ; filename = None + } + ; { Multipart_form_data.Part.name = "filename" + ; filename = Some "originalname" + ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] + ; content_length = None + } + ; { Multipart_form_data.Part.name = "var1" + ; content = Lwt_stream.of_list [ "\r\ntest\r\n" ] + ; content_length = None + ; filename = None + } + ] + ; test + ~name:"Double file" + ~input: + (Printf.sprintf + "\ + \r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"var1\"\r\n\ + \r\n\ + \r\ntest\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"\r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is \r\nthe content of our file\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"filename2\"; filename=\"originalname2\"\r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is \r\nthe content of another file\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"var2\"\r\n\ + \r\n\ + end===stuff\ + \r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + Utils.boundary + Utils.boundary + Utils.boundary + ) + ~expected_parts: + [ { Multipart_form_data.Part.name = "var2" + ; content = Lwt_stream.of_list [ "end===stuff" ] + ; content_length = None + ; filename = None + } + ; { Multipart_form_data.Part.name = "filename2" + ; filename = Some "originalname2" + ; content = Lwt_stream.of_list ["this is \r\nthe content of another file\r\n"] + ; content_length = None + } + ; { Multipart_form_data.Part.name = "filename" + ; filename = Some "originalname" + ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] + ; content_length = None + } + ; { Multipart_form_data.Part.name = "var1" + ; content = Lwt_stream.of_list [ "\r\ntest\r\n" ] + ; content_length = None + ; filename = None + } + ] ] diff --git a/test/test_reader_writer.ml b/test/test_reader_writer.ml index 42c8490..2a09011 100644 --- a/test/test_reader_writer.ml +++ b/test/test_reader_writer.ml @@ -1,15 +1,17 @@ -open Utils +let rec to_seq = function + | h::t -> (fun () -> Seq.Cons (h, to_seq t)) + | [] -> (fun () -> Seq.Nil) let test ~name ~input ~expected_parts = ( name , `Quick , fun () -> let request = - { Multipart_form_data.Request.headers = test_headers + { Multipart_form_data.Request.headers = Utils.test_headers ; body = Lwt_stream.of_list [ input ] } in - let (callback, read) = testable_callback_factory () in + let (callback, read) = Utils.testable_callback_factory () in let result = Multipart_form_data.read ~request ~handle_part:callback in Alcotest.(check (result unit string)) (name ^ " read result") (Ok ()) result; let resulting_parts = read () in @@ -18,87 +20,103 @@ let test ~name ~input ~expected_parts = (List.length expected_parts) (List.length resulting_parts); let request = - match Multipart_form_data.write_with_separator - ~separator - ~request:(List.to_seq expected_parts) + match Multipart_form_data.write_with_boundary + ~boundary:Utils.boundary + ~request:(to_seq expected_parts) with | Ok r -> r - | Error _ -> empty_request + | Error _ -> Utils.empty_request in - Alcotest.(check string) (name ^ " body") input (stream_to_string request.body) + Alcotest.(check string) (name ^ " body") input (Utils.stream_to_string request.body) ) let read_write_tests = [ test ~name:"Simple form" - ~input:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"key\"" - ^ "\r\n" ^ "\r\n" - ^ "value" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) - ~expected_parts:[{ Multipart_form_data.Part.name = "key" - ; value = Variable "value" - }] + ~input: + (Printf.sprintf + "\ + \r\n--%s\r\n\ + Content-Disposition: form-data; name=\"key\"\r\n\ + \r\n\ + value\r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + ) + ~expected_parts: + [ { Multipart_form_data.Part.name = "key" + ; content = Lwt_stream.of_list [ "value" ] + ; content_length = Some (Int64.of_int 5) + ; filename = None + } + ] ; test ~name:"File from string" - ~input:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" - ^ "\r\n" - ^ "Content-Type: application/octet-stream" - ^ "\r\n" ^ "\r\n" - ^ "this is the content of our file\r\n" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) - ~expected_parts:[{ Multipart_form_data.Part.name = "filename" - ; value = File { filename = "originalname" - ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] - ; length = Some (Int64.of_int 33) - } - }] + ~input: + (Printf.sprintf + "\ + \r\n--%s\r\n\ + Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"\r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is the content of our file\r\n\ + \r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + ) + ~expected_parts: + [ { Multipart_form_data.Part.name = "filename" + ; filename = Some "originalname" + ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] + ; content_length = Some (Int64.of_int 38) + } + ] ; test ~name:"Mixed variable and file" - ~input:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"var1\"" - ^ "\r\n" ^ "\r\n" - ^ "\r\ntest\r\n" - ^ "\r\n" - ^ "--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" - ^ "\r\n" - ^ "Content-Type: application/octet-stream" - ^ "\r\n" ^ "\r\n" - ^ "this is \r\nthe content of our file\r\n" - ^ "\r\n" - ^ "--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"var2\"" - ^ "\r\n" ^ "\r\n" - ^ "end===stuff" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) - ~expected_parts:[ { Multipart_form_data.Part.name = "var1" - ; value = Variable "\r\ntest\r\n" - } - ; { Multipart_form_data.Part.name = "filename" - ; value = File { filename = "originalname" - ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] - ; length = Some (Int64.of_int 35) - } - } - ; { Multipart_form_data.Part.name = "var2" - ; value = Variable "end===stuff" - } - ] + ~input: + (Printf.sprintf + "\ + \r\n--%s\r\n\ + Content-Disposition: form-data; name=\"var1\"\r\n\ + \r\n\ + \r\ntest\r\n\ + \r\n--%s\r\n\ + Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"\r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is \r\nthe content of our file\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"var2\"\r\n\ + \r\n\ + end===stuff\ + \r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + Utils.boundary + Utils.boundary + ) + ~expected_parts: + [ { Multipart_form_data.Part.name = "var1" + ; content = Lwt_stream.of_list [ "\r\ntest\r\n" ] + ; content_length = Some (Int64.of_int 8) + ; filename = None + } + ; { Multipart_form_data.Part.name = "filename" + ; filename = Some "originalname" + ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] + ; content_length = Some (Int64.of_int 38) + } + ; { Multipart_form_data.Part.name = "var2" + ; content = Lwt_stream.of_list [ "end===stuff" ] + ; content_length = Some (Int64.of_int 11) + ; filename = None + } + ] ] diff --git a/test/test_writer.ml b/test/test_writer.ml index 9d6ea47..8530199 100644 --- a/test/test_writer.ml +++ b/test/test_writer.ml @@ -1,16 +1,22 @@ -open Utils +let rec to_seq = function + | h::t -> (fun () -> Seq.Cons (h, to_seq t)) + | [] -> (fun () -> Seq.Nil) let test ~name ~input ~expected_headers ~expected_body = ( name , `Quick , fun () -> let request = - match Multipart_form_data.write_with_separator ~separator ~request:(List.to_seq input) with + match + Multipart_form_data.write_with_boundary + ~boundary:Utils.boundary + ~request:(to_seq input) + with | Ok r -> r - | Error _ -> empty_request + | Error _ -> Utils.empty_request in Alcotest.(check (list (pair string string))) (name ^ " headers") expected_headers request.headers; - Alcotest.(check string) (name ^ " body") expected_body (stream_to_string request.body) + Alcotest.(check string) (name ^ " body") expected_body (Utils.stream_to_string request.body) ) let writer_tests = @@ -18,85 +24,111 @@ let writer_tests = ~name:"Empty" ~input:[] ~expected_headers: - [ ("Content-Type", "multipart/form-data; boundary=" ^ separator) + [ ("Content-Type", "multipart/form-data; boundary=" ^ Utils.boundary) ; ("Content-Length", "33") ] - ~expected_body:("\r\n--" ^ separator ^ "--\r\n") + ~expected_body:("\r\n--" ^ Utils.boundary ^ "--\r\n") ; test ~name:"Simple form" - ~input:[{ Multipart_form_data.Part.name = "key" - ; value = Variable "value" - }] - ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); - ("Content-Length", "110")] - ~expected_body:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"key\"" - ^ "\r\n" ^ "\r\n" - ^ "value" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) + ~input: + [ { Multipart_form_data.Part.name = "key" + ; content = Lwt_stream.of_list [ "value" ] + ; content_length = Some (Int64.of_int 5) + ; filename = None + } + ] + ~expected_headers: + [ ("Content-Type", "multipart/form-data; boundary=" ^ Utils.boundary); + ("Content-Length", "115") + ] + ~expected_body: + (Printf.sprintf + "\ + \r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"key\"\r\n\ + \r\n\ + value\r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + ) ; test ~name:"File from string" - ~input:[{ Multipart_form_data.Part.name = "filename" - ; value = File { filename = "originalname" - ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] - ; length = Some (Int64.of_int 33) - } - }] - ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); - ("Content-Length", "213")] - ~expected_body:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" - ^ "\r\n" - ^ "Content-Type: application/octet-stream" - ^ "\r\n" ^ "\r\n" - ^ "this is the content of our file\r\n" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) + ~input: + [ { Multipart_form_data.Part.name = "filename" + ; filename = Some "originalname" + ; content = Lwt_stream.of_list ["this is the content of our file\r\n"] + ; content_length = Some (Int64.of_int 33) + } + ] + ~expected_headers: + [ ("Content-Type", "multipart/form-data; boundary=" ^ Utils.boundary); + ("Content-Length", "213") + ] + ~expected_body: + (Printf.sprintf + "\ + \r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"\r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is the content of our file\r\n\ + \r\n\ + --%s--\r\n\ + " + Utils.boundary + Utils.boundary + ) ; test ~name:"Mixed variable and file" - ~input:[ { Multipart_form_data.Part.name = "var1" - ; value = Variable "\r\ntest\r\n" - } - ; { Multipart_form_data.Part.name = "filename" - ; value = File { filename = "originalname" - ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] - ; length = Some (Int64.of_int 35) - } - } - ; { Multipart_form_data.Part.name = "var2" - ; value = Variable "end===stuff" - } - ] - ~expected_headers:[("Content-Type", "multipart/form-data; boundary=" ^ separator); - ("Content-Length", "371")] - ~expected_body:("\r\n--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"var1\"" - ^ "\r\n" ^ "\r\n" - ^ "\r\ntest\r\n" - ^ "\r\n" - ^ "--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"" - ^ "\r\n" - ^ "Content-Type: application/octet-stream" - ^ "\r\n" ^ "\r\n" - ^ "this is \r\nthe content of our file\r\n" - ^ "\r\n" - ^ "--" ^ separator - ^ "\r\n" - ^ "Content-Disposition: form-data; name=\"var2\"" - ^ "\r\n" ^ "\r\n" - ^ "end===stuff" - ^ "\r\n" - ^ "--" ^ separator ^ "--" - ^ "\r\n" - ) + ~input: + [ { Multipart_form_data.Part.name = "var1" + ; content = Lwt_stream.of_list [ "\r\ntest\r\n" ] + ; content_length = Some (Int64.of_int 8) + ; filename = None + } + ; { Multipart_form_data.Part.name = "filename" + ; filename = Some "originalname" + ; content = Lwt_stream.of_list ["this is \r\nthe content of our file\r\n"] + ; content_length = Some (Int64.of_int 38) + } + ; { Multipart_form_data.Part.name = "var2" + ; content = Lwt_stream.of_list [ "end===stuff" ] + ; content_length = Some (Int64.of_int 11) + ; filename = None + } + ] + ~expected_headers: + [ ("Content-Type", "multipart/form-data; boundary=" ^ Utils.boundary); + ("Content-Length", "393") + ] + ~expected_body: + (Printf.sprintf + "\ + \r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"var1\"\r\n\ + \r\n\ + \r\ntest\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"filename\"; filename=\"originalname\"\ + \r\n\ + Content-Type: application/octet-stream\r\n\ + \r\n\ + this is \r\nthe content of our file\r\n\r\n\ + --%s\r\n\ + Content-Disposition: form-data; name=\"var2\"\r\n\ + \r\n\ + end===stuff\r\n\ + --%s--\ + \r\n\ + " + Utils.boundary + Utils.boundary + Utils.boundary + Utils.boundary + ) ] diff --git a/test/utils.ml b/test/utils.ml index 3cd8662..57f2584 100644 --- a/test/utils.ml +++ b/test/utils.ml @@ -3,14 +3,18 @@ let stream_to_string stream = |> Lwt_stream.get_available |> String.concat "" -let part_to_testable part = - match part with - | {Multipart_form_data.Part.name=name; value=Variable value} +let part_to_testable = function + | {Multipart_form_data.Part.name = name; filename = filename; content = content; content_length = length} -> - (["variable"; name; ""; value], None) - | {name=name; value=File {filename=filename; content=content; length=length}} - -> - (["file"; name; filename; stream_to_string content], length) + ([name; stream_to_string content], (filename, length)) + +let test_parts ~name ~expected values = + let expected_testable = List.map part_to_testable expected in + let values_testable = List.map part_to_testable values in + Alcotest.(check (list (pair (list string) (pair (option string) (option int64))))) + name + expected_testable + values_testable let testable_callback_factory () = let parts = ref [] in @@ -24,6 +28,6 @@ let testable_callback_factory () = let empty_request = {Multipart_form_data.Request.headers = []; body = Lwt_stream.of_list [""]} -let separator = "===============1269689916" +let boundary = "===============1269689916" -let test_headers = [("Content-Type", "multipart/form-data; boundary=" ^ separator)] +let test_headers = [("Content-Type", "multipart/form-data; boundary=" ^ boundary)] diff --git a/test/utils.mli b/test/utils.mli new file mode 100644 index 0000000..998a079 --- /dev/null +++ b/test/utils.mli @@ -0,0 +1,11 @@ +val stream_to_string : string Lwt_stream.t -> string +val test_parts : + name:string -> + expected:Multipart_form_data.Part.t list -> + Multipart_form_data.Part.t list -> + unit +val testable_callback_factory : unit -> (('a -> unit Lwt.t) * (unit -> 'a list)) + +val empty_request : Multipart_form_data.Request.t +val boundary : string +val test_headers : (string * string) list From 90cf740d5340c407a3b220d61fb2fe45ff288b90 Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Fri, 7 Jun 2019 15:00:22 +0200 Subject: [PATCH 6/9] New README --- README.md | 103 +++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 98 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 46fa6ad..58df99e 100644 --- a/README.md +++ b/README.md @@ -5,10 +5,103 @@ multipart/form-data (RFC2388) parser for OCaml This is a parser for structured form data based on `Lwt_stream` in order to use it with [cohttp](https://github.com/mirage/ocaml-cohttp/). You can use it to -send POST parameters. +receive and send POST parameters. -There are two APIs: +# Cohttp -- a high-level one: `parse_stream` and `get_parts`. It works for strings, but - has some problems with files. -- a low-level one: `parse`. It works for well for both strings and files. +This library integrates well with cohttp and cohttp-lwt. + +### Read API + +Example with a cohttp-lwt request : +```ocaml +open Lwt.Infix + +let request = + Cohttp_lwt_unix.Client.get ~ctx (Uri.of_string "http://url/") + >>= fun (resp, body) -> + { Multipart_part_form.Request.headers = resp |> Cohttp.Header.to_list + ; body = body |> Cohttp_lwt.to_stream + } + +let callback part = + (* Do stuff with the elements of the response *) + +Multipart_part_form.read request callback +``` + +Example with a cohttp-lwt server : +```ocaml +open Cohttp +open Cohttp_lwt_unix + +let file_upload_callback part = + Lwt.return (print_endline ("Incoming variable '" ^ part.Multipart_form_data.Part.name ^ "'")) + +let server = + let callback _conn req body = + let _uri = req |> Request.uri |> Uri.to_string in + let _meth = req |> Request.meth |> Code.string_of_method in + let headers = req |> Request.headers |> Header.to_list in + body + |> Cohttp_lwt.Body.to_stream + |> (fun body -> + { Multipart_form_data.Request.headers = headers + ; body = body + } + ) + |> (fun request -> + Multipart_form_data.read ~request ~handle_part:file_upload_callback + ) + |> (fun result -> + match result with + | Ok () -> Server.respond_string ~status:`OK ~body:"Success" () + | Error e -> print_endline e; Server.respond_string ~status:`Bad_request ~body:e () + ) + in + Server.create ~mode:(`TCP (`Port 8000)) (Server.make ~callback ()) + +let () = Lwt_main.run server +``` + +### Write API + +Example with cohttp-lwt : +```ocaml +open Lwt +open Cohttp +open Cohttp_lwt_unix + +let multipart = + [ { Multipart_form_data.Part.name = "var" + ; filename = None + ; content = Lwt_stream.of_list [ "content" ] + ; content_length = Some (Int64.of_int 7) + } + ] + |> List.to_seq + +let request = + Multipart_form_data.write ~request:multipart + |> function + | Ok r -> r + | Error _ -> failwith "Failure" + +let body = + (Client.post + ~body:(request.Multipart_form_data.Request.body |> Cohttp_lwt.Body.of_stream) + ~headers:(request.headers |> Cohttp.Header.of_list) + (Uri.of_string "http://localhost:8000") + ) + >>= fun (resp, body) -> + let code = resp |> Response.status |> Code.code_of_status in + Printf.printf "Response code: %d\n" code; + Printf.printf "Headers: %s\n" (resp |> Response.headers |> Header.to_string); + body |> Cohttp_lwt.Body.to_string >|= fun body -> + Printf.printf "Body of length: %d\n" (String.length body); + body + +let () = + let body = Lwt_main.run body in + print_endline ("Received body\n" ^ body) +``` From cc9260aae09b972a11b9f78e3414824adf81d878 Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Fri, 7 Jun 2019 15:17:32 +0200 Subject: [PATCH 7/9] Made `boundary` optional Rename requests -> parts in write function --- lib/multipart_form_data.ml | 17 ++++++++++------- lib/multipart_form_data.mli | 8 ++------ test/test_reader_writer.ml | 4 ++-- test/test_writer.ml | 4 ++-- 4 files changed, 16 insertions(+), 17 deletions(-) diff --git a/lib/multipart_form_data.ml b/lib/multipart_form_data.ml index 96b226a..a666d4b 100644 --- a/lib/multipart_form_data.ml +++ b/lib/multipart_form_data.ml @@ -106,13 +106,21 @@ let add_part_to_multipart_request multipart_request part = Writer.add_from_stream ~name ~filename ~content ~content_length multipart_request -let write_with_boundary ~boundary ~request = +let write ?boundary ~parts = + let boundary = + match boundary with + | Some b -> b + | None -> + (* It does not matter if the random numbers are not safe here *) + Random.self_init (); + "-----------------" ^ (string_of_int (Random.int 536870912)) + in let open CCResult.Infix in let multipart_request = Seq.fold_left add_part_to_multipart_request (Writer.init boundary) - request + parts in Writer.r_headers multipart_request >>= fun headers -> Writer.r_body multipart_request @@ -121,8 +129,3 @@ let write_with_boundary ~boundary ~request = ; body = body } -let write ~request = - Random.self_init (); - (* It does not matter if the random numbers are not safe here *) - let boundary = "-----------------" ^ (string_of_int (Random.int 536870912)) in - write_with_boundary ~boundary ~request diff --git a/lib/multipart_form_data.mli b/lib/multipart_form_data.mli index e45add0..1d220ad 100644 --- a/lib/multipart_form_data.mli +++ b/lib/multipart_form_data.mli @@ -19,11 +19,7 @@ val read : -> handle_part:(Part.t -> unit Lwt.t) -> (unit, string) result -val write_with_boundary : - boundary:string - -> request:Part.t Seq.t - -> (Request.t, string) result - val write : - request:Part.t Seq.t + ?boundary:string + -> parts:Part.t Seq.t -> (Request.t, string) result diff --git a/test/test_reader_writer.ml b/test/test_reader_writer.ml index 2a09011..1a590a6 100644 --- a/test/test_reader_writer.ml +++ b/test/test_reader_writer.ml @@ -20,9 +20,9 @@ let test ~name ~input ~expected_parts = (List.length expected_parts) (List.length resulting_parts); let request = - match Multipart_form_data.write_with_boundary + match Multipart_form_data.write ~boundary:Utils.boundary - ~request:(to_seq expected_parts) + ~parts:(to_seq expected_parts) with | Ok r -> r | Error _ -> Utils.empty_request diff --git a/test/test_writer.ml b/test/test_writer.ml index 8530199..9506356 100644 --- a/test/test_writer.ml +++ b/test/test_writer.ml @@ -8,9 +8,9 @@ let test ~name ~input ~expected_headers ~expected_body = , fun () -> let request = match - Multipart_form_data.write_with_boundary + Multipart_form_data.write ~boundary:Utils.boundary - ~request:(to_seq input) + ~parts:(to_seq input) with | Ok r -> r | Error _ -> Utils.empty_request From 525583315ee750c1cec969b03c4c49742a09b57a Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Fri, 7 Jun 2019 15:44:42 +0200 Subject: [PATCH 8/9] Add mli files And remove a lot of dead code --- lib/reader.ml | 146 ------------------------------------------------- lib/reader.mli | 7 +++ lib/writer.ml | 12 ---- lib/writer.mli | 14 +++++ 4 files changed, 21 insertions(+), 158 deletions(-) create mode 100644 lib/reader.mli create mode 100644 lib/writer.mli diff --git a/lib/reader.ml b/lib/reader.ml index e578076..197afa8 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -60,70 +60,6 @@ let split_on_string ~pattern s = in List.rev (go 0 []) -let split_and_process_string ~boundary s = - let f = function - | None -> `Delim - | Some w -> `Word w - in - List.map f @@ split_on_string ~pattern:boundary s - -let split s boundary = - let r = ref None in - let push v = - match !r with - | None -> r := Some v - | Some _ -> assert false - in - let pop () = - let res = !r in - r := None; - res - in - let go c0 = - let c = - match pop () with - | Some x -> x ^ c0 - | None -> c0 - in - let string_to_process = match find_common_idx c boundary with - | None -> c - | Some idx -> - begin - let prefix = String.sub c 0 idx in - let suffix = String.sub c idx (String.length c - idx) in - push suffix; - prefix - end - in - Lwt.return @@ split_and_process_string ~boundary string_to_process - in - let initial = Lwt_stream.map_list_s go s in - let final = - Lwt_stream.flatten @@ - Lwt_stream.from_direct @@ fun () -> - option_map (split_and_process_string ~boundary) @@ pop () - in - Lwt_stream.append initial final - -let until_next_delim s = - Lwt_stream.from @@ fun () -> - let%lwt res = Lwt_stream.get s in - match res with - | None - | Some `Delim -> Lwt.return_none - | Some (`Word w) -> Lwt.return_some w - -let join s = - Lwt_stream.filter_map (function - | `Delim -> Some (until_next_delim @@ Lwt_stream.clone s) - | `Word _ -> None - ) s - -let align stream boundary = - join @@ split stream boundary - -type header = string * string - let extract_boundary content_type = Stringext.chop_prefix ~prefix:"multipart/form-data; boundary=" content_type @@ -138,31 +74,6 @@ let parse_header s = | Some (key, value) -> (key, value) | None -> invalid_arg ("Could not parse header :" ^ s) -let non_empty st = - let%lwt r = Lwt_stream.to_list @@ Lwt_stream.clone st in - Lwt.return (String.concat "" r <> "") - -let get_headers : string Lwt_stream.t Lwt_stream.t -> header list Lwt.t - = fun lines -> - let%lwt header_lines = Lwt_stream.get_while_s non_empty lines in - Lwt_list.map_s (fun header_line_stream -> - let%lwt parts = Lwt_stream.to_list header_line_stream in - Lwt.return @@ parse_header @@ String.concat "" parts - ) - header_lines - -type stream_part = - { headers : header list - ; body : string Lwt_stream.t - } - -let s_part_name {headers; _} = - match - parse_name @@ List.assoc "Content-Disposition" headers - with - | Some x -> x - | None -> invalid_arg "s_part_name" - let parse_filename s = let parts = split_on_string s ~pattern:"; " in let f = function @@ -176,26 +87,6 @@ let parse_filename s = in first_matching f parts -let s_part_filename {headers; _} = - parse_filename @@ List.assoc "Content-Disposition" headers - -let as_part part = - match s_part_filename part with - | Some _filename -> - Lwt.return (`File part) - | None -> - let%lwt chunks = Lwt_stream.to_list part.body in - let body = String.concat "" chunks in - Lwt.return (`String body) - -let get_parts s = - let go part m = - let name = s_part_name part in - let%lwt parsed_part = as_part part in - Lwt.return @@ StringMap.add name parsed_part m - in - Lwt_stream.fold_s go s StringMap.empty - let concat a b = match (a, b) with | (_, "") -> a @@ -362,43 +253,6 @@ let read_file_part reader boundary callback = * We construct a buffer that will contain the entirety of * the value before being passed to the callback. **) -let iter_string_part reader boundary callback = - let fin = ref false in - let last () = - fin := true; - Lwt.return_unit - in - let handle ~send ~unread ~finish = - let%lwt () = callback send in - Reader.unread reader unread; - if finish then - last () - else - Lwt.return_unit - in - while%lwt not !fin do - let%lwt res = compute_case reader boundary in - match res with - | `Empty - -> - last () - | `Boundary (pre, post) - -> - handle ~send:pre ~unread:post ~finish:true - | `May_end_with_boundary (unambiguous, ambiguous) - -> - handle ~send:unambiguous ~unread:ambiguous ~finish:false - | `App_data line - -> - callback line - done - -let read_string_part reader boundary = - let value = Buffer.create 0 in - let append_to_value line = Lwt.return (Buffer.add_string value line) in - let%lwt () = iter_string_part reader boundary append_to_value in - Lwt.return (Buffer.contents value) - let read_part reader boundary callback = let%lwt headers = read_headers reader in let content_disposition = List.assoc "Content-Disposition" headers in diff --git a/lib/reader.mli b/lib/reader.mli new file mode 100644 index 0000000..0c87530 --- /dev/null +++ b/lib/reader.mli @@ -0,0 +1,7 @@ +val parse : + stream:string Lwt_stream.t + -> content_type:string + -> callback:( + name:string -> filename:string option -> string -> bool -> unit Lwt.t + ) + -> (unit, string) result diff --git a/lib/writer.ml b/lib/writer.ml index 58ba668..681db0e 100644 --- a/lib/writer.ml +++ b/lib/writer.ml @@ -19,18 +19,6 @@ let init separator = ; separator = separator } -let add_from_string ~name ~filename ~content mp = - let open MultipartRequest in - { mp with - elements = - { content = Lwt_stream.of_list [ content ] - ; name=name - ; filename=filename - ; length=Int64.of_int(String.length content) - } - :: mp.elements - } - let add_from_stream ~name ~filename ~content ~content_length mp = let open MultipartRequest in { mp with diff --git a/lib/writer.mli b/lib/writer.mli new file mode 100644 index 0000000..4962a82 --- /dev/null +++ b/lib/writer.mli @@ -0,0 +1,14 @@ +module MultipartRequest : sig + type t +end + +val init : string -> MultipartRequest.t +val add_from_stream : + name:string + -> filename:string option + -> content:string Lwt_stream.t + -> content_length:int64 + -> MultipartRequest.t + -> MultipartRequest.t +val r_headers : MultipartRequest.t -> ((string * string) list, 'a) result +val r_body : MultipartRequest.t -> (string Lwt_stream.t, 'a) result From 0c2383e7669a1aa33bb755327dceca567528c4e0 Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Tue, 11 Jun 2019 09:16:57 +0200 Subject: [PATCH 9/9] Better README --- README.md | 47 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 45 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 58df99e..27f7fe3 100644 --- a/README.md +++ b/README.md @@ -4,8 +4,51 @@ multipart/form-data (RFC2388) parser for OCaml [![Build Status](https://travis-ci.org/cryptosense/multipart-form-data.svg?branch=master)](https://travis-ci.org/cryptosense/multipart-form-data) [![docs](https://img.shields.io/badge/doc-online-blue.svg)](https://cryptosense.github.io/multipart-form-data/doc/) This is a parser for structured form data based on `Lwt_stream` in order to use -it with [cohttp](https://github.com/mirage/ocaml-cohttp/). You can use it to -receive and send POST parameters. +it with [cohttp](https://github.com/mirage/ocaml-cohttp/). You can use it to read POST parameters from a given body or generate a new body containing specified parameters. + +# File system + +This library does not interact with the file system, but can easily be used to upload large files without a significant RAM impact. + +Example of chunked reads from the filesystem : +```ocaml +let file_size path = + path + |> Lwt_io.file_length + |> Lwt_result.ok + +let open_file path = + (* This function returns a buffered IO read of a file *) + let open Lwt.Infix in + let read_while_not_empty channel () = + (Lwt_io.read ~count:4096 channel) + >|= (fun chunck -> + match chunck with + | "" -> None + | _ -> Some chunck + ) + in + path + |> Lwt_io.open_file ~mode:Lwt_io.Input + >|= read_while_not_empty + >|= Lwt_stream.from + >>= fun file_stream -> file_size path + >|= fun file_size -> + match file_size with + | Ok file_size -> Ok (file_stream, file_size) + | Error err -> Error err + +let part_from_file path = + let open Lwt_result.Infix in + open_file path + >|= fun (file_stream, file_size) -> + Seq.return + { Multipart_form_data.Part.name = "file" + ; filename = "filename" + ; content = content + ; content_length = content_length + } +``` # Cohttp