From 8a1fb5ca997f88e33cc1e3b5ace2079fdab72f7e Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Mon, 3 Jun 2019 10:25:32 +0200 Subject: [PATCH] Add buggy unittests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit [WARNING : may break your compiler] --- 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 {test => old.test}/test_read_write.ml | 0 old.test/test_reader.ml.old | 158 +++++++++++++++++++ old.test/test_writer.ml | 138 ++++++++++++++++ old.test/tests.ml | 16 ++ test/test_reader.ml | 218 ++++++++------------------ test/test_writer.ml | 150 ++++++------------ test/tests.ml | 13 +- test/utils.ml | 29 ++++ 16 files changed, 720 insertions(+), 393 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%) rename {test => old.test}/test_read_write.ml (100%) create mode 100644 old.test/test_reader.ml.old create mode 100644 old.test/test_writer.ml create mode 100644 old.test/tests.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..00252f8 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 false 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/test/test_read_write.ml b/old.test/test_read_write.ml similarity index 100% rename from test/test_read_write.ml rename to old.test/test_read_write.ml diff --git a/old.test/test_reader.ml.old b/old.test/test_reader.ml.old new file mode 100644 index 0000000..dca2526 --- /dev/null +++ b/old.test/test_reader.ml.old @@ -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/old.test/test_writer.ml b/old.test/test_writer.ml new file mode 100644 index 0000000..04711b2 --- /dev/null +++ b/old.test/test_writer.ml @@ -0,0 +1,138 @@ +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/old.test/tests.ml b/old.test/tests.ml new file mode 100644 index 0000000..9b67420 --- /dev/null +++ b/old.test/tests.ml @@ -0,0 +1,16 @@ +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.Writer", + Test_writer.writer_tests + ) + ; ("Multipart_form_data.Reader & Writer", + Test_read_write.read_write_tests + ) + ] diff --git a/test/test_reader.ml b/test/test_reader.ml index dca2526..c83012b 100644 --- a/test/test_reader.ml +++ b/test/test_reader.ml @@ -1,158 +1,68 @@ -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 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 + 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 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 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 = None + } + }] + + ] 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..adf5b6c 100644 --- a/test/tests.ml +++ b/test/tests.ml @@ -1,16 +1,9 @@ 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 - ) ] 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)]