From 495f21ec7a2b65735304d073c9cd90e1c5159d56 Mon Sep 17 00:00:00 2001 From: Xavier Nunn Date: Thu, 6 Jun 2019 16:28:02 +0200 Subject: [PATCH] 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