diff --git a/examples/dune b/examples/dune index d2c19915..08d06886 100644 --- a/examples/dune +++ b/examples/dune @@ -12,7 +12,7 @@ (name echo) (flags :standard -warn-error -a+8) (modules echo vfs) - (libraries tiny_httpd logs tiny_httpd_camlzip)) + (libraries tiny_httpd logs tiny_httpd_camlzip tiny_httpd.multipart-form-data)) (executable (name writer) diff --git a/examples/echo.ml b/examples/echo.ml index f3d0f2af..af133187 100644 --- a/examples/echo.ml +++ b/examples/echo.ml @@ -1,5 +1,6 @@ open Tiny_httpd_core module Log = Tiny_httpd.Log +module MFD = Tiny_httpd_multipart_form_data let now_ = Unix.gettimeofday @@ -78,6 +79,58 @@ let setup_logging () = Logs.set_reporter @@ Logs.format_reporter (); Logs.set_level ~all:true (Some Logs.Debug) +let setup_upload server : unit = + Server.add_route_handler_stream ~meth:`POST server + Route.(exact "upload" @/ return) + (fun req -> + let (`boundary boundary) = + match MFD.parse_content_type req.headers with + | Some b -> b + | None -> Response.fail_raise ~code:400 "no boundary found" + in + + let st = MFD.create ~boundary req.body in + let tbl = Hashtbl.create 16 in + let cur = ref "" in + let cur_kind = ref "" in + let buf = Buffer.create 16 in + let rec loop () = + match MFD.next st with + | End_of_input -> + if !cur <> "" then + Hashtbl.add tbl !cur (!cur_kind, Buffer.contents buf) + | Part headers -> + if !cur <> "" then + Hashtbl.add tbl !cur (!cur_kind, Buffer.contents buf); + (match MFD.Content_disposition.parse headers with + | Some { kind; name = Some name; filename = _ } -> + cur := name; + cur_kind := kind; + Buffer.clear buf; + loop () + | _ -> Response.fail_raise ~code:400 "content disposition missing") + | Read sl -> + Buffer.add_subbytes buf sl.bytes sl.off sl.len; + loop () + in + loop (); + + let open Tiny_httpd_html in + let data = + Hashtbl.fold + (fun name (kind, data) acc -> + Printf.sprintf "%S (kind: %S): %S" name kind data :: acc) + tbl [] + in + let html = + body [] + [ + pre [] + [ txt (Printf.sprintf "{\n%s\n}" @@ String.concat "\n" data) ]; + ] + in + Response.make_string ~code:201 @@ Ok (to_string_top html)) + let () = let port_ = ref 8080 in let j = ref 32 in @@ -198,6 +251,8 @@ let () = ~dir_behavior:Tiny_httpd.Dir.Index_or_lists ()) ~vfs:Vfs.vfs ~prefix:"vfs"; + setup_upload server; + (* main page *) Server.add_route_handler server Route.(return) @@ -267,6 +322,34 @@ let () = txt " (POST) to log out"; ]; ]; + li [] + [ + form + [ + A.action "/upload"; + A.enctype "multipart/form-data"; + A.target "_self"; + A.method_ "POST"; + ] + [ + label [] [ txt "my beautiful form" ]; + input [ A.type_ "file"; A.name "file1" ]; + input [ A.type_ "file"; A.name "file2" ]; + input + [ + A.type_ "text"; + A.name "a"; + A.placeholder "text A"; + ]; + input + [ + A.type_ "text"; + A.name "b"; + A.placeholder "text B"; + ]; + input [ A.type_ "submit" ]; + ]; + ]; ]; ]; ] diff --git a/src/core/headers.ml b/src/core/headers.ml index 1c1d8f87..19f06a3d 100644 --- a/src/core/headers.ml +++ b/src/core/headers.ml @@ -46,6 +46,21 @@ let for_all pred s = true with Exit -> false +let parse_line_ (line : string) : _ result = + try + let i = + try String.index line ':' + with Not_found -> failwith "invalid header, missing ':'" + in + let k = String.sub line 0 i in + if not (for_all is_tchar k) then + failwith (Printf.sprintf "Invalid header key: %S" k); + let v = + String.sub line (i + 1) (String.length line - i - 1) |> String.trim + in + Ok (k, v) + with Failure msg -> Error msg + let parse_ ~(buf : Buf.t) (bs : IO.Input.t) : t = let rec loop acc = match IO.Input.read_line_using_opt ~buf bs with @@ -56,16 +71,10 @@ let parse_ ~(buf : Buf.t) (bs : IO.Input.t) : t = bad_reqf 400 "bad header line, not ended in CRLF" | Some line -> let k, v = - try - let i = String.index line ':' in - let k = String.sub line 0 i in - if not (for_all is_tchar k) then - invalid_arg (Printf.sprintf "Invalid header key: %S" k); - let v = - String.sub line (i + 1) (String.length line - i - 1) |> String.trim - in - k, v - with _ -> bad_reqf 400 "invalid header line: %S" line + match parse_line_ line with + | Ok r -> r + | Error msg -> + bad_reqf 400 "invalid header line: %s\nline is: %S" msg line in loop ((String.lowercase_ascii k, v) :: acc) in diff --git a/src/core/headers.mli b/src/core/headers.mli index b46b5d54..67feb9a8 100644 --- a/src/core/headers.mli +++ b/src/core/headers.mli @@ -33,3 +33,7 @@ val pp : Format.formatter -> t -> unit (** Pretty print the headers. *) val parse_ : buf:Buf.t -> IO.Input.t -> t +(**/*) + +val parse_line_ : string -> (string * string, string) result +(**/*) diff --git a/src/multipart_form/content_disposition.ml b/src/multipart_form/content_disposition.ml new file mode 100644 index 00000000..9f545729 --- /dev/null +++ b/src/multipart_form/content_disposition.ml @@ -0,0 +1,31 @@ +open Utils_ + +type t = { kind: string; name: string option; filename: string option } + +(** Simple display *) +let to_string (self : t) = + let stropt = function + | None -> "None" + | Some s -> spf "%S" s + in + spf "{kind=%S; name=%s; filename=%s}" self.kind (stropt self.name) + (stropt self.filename) + +let parse (hs : Tiny_httpd.Headers.t) : t option = + match Tiny_httpd.Headers.get "content-disposition" hs with + | None -> None + | Some s -> + (match String.split_on_char ';' s with + | [] -> + failwith (Printf.sprintf "multipart: invalid content-disposition %S" s) + | kind :: tl -> + let name = ref None in + let filename = ref None in + List.iter + (fun s -> + match Utils_.split1_on ~c:'=' @@ String.trim s with + | Some ("name", v) -> name := Some (Utils_.remove_quotes v) + | Some ("filename", v) -> filename := Some (Utils_.remove_quotes v) + | _ -> ()) + tl; + Some { kind; name = !name; filename = !filename }) diff --git a/src/multipart_form/dune b/src/multipart_form/dune new file mode 100644 index 00000000..6adfd691 --- /dev/null +++ b/src/multipart_form/dune @@ -0,0 +1,5 @@ +(library + (name tiny_httpd_multipart_form_data) + (public_name tiny_httpd.multipart-form-data) + (synopsis "Port of multipart-form-data for tiny_httpd") + (libraries iostream tiny_httpd)) diff --git a/src/multipart_form/tiny_httpd_multipart_form_data.ml b/src/multipart_form/tiny_httpd_multipart_form_data.ml new file mode 100644 index 00000000..229e8537 --- /dev/null +++ b/src/multipart_form/tiny_httpd_multipart_form_data.ml @@ -0,0 +1,250 @@ +(* ported from https://github.com/cryptosense/multipart-form-data . *) + +open Tiny_httpd +module Slice = Iostream.Slice +module Content_disposition = Content_disposition + +let spf = Printf.sprintf + +type buf = { bs: bytes; mutable len: int } + +let shift_left_ (self : buf) n = + if n = self.len then + self.len <- 0 + else ( + assert (n < self.len); + Bytes.blit self.bs n self.bs 0 (self.len - n); + self.len <- self.len - n + ) + +let[@inline] buf_full (self : buf) : bool = self.len >= Bytes.length self.bs + +type slice = Iostream.Slice.t +type event = Part of Tiny_httpd.Headers.t | Read of slice | End_of_input +type out_state = Begin | Inside_part | Eof + +type st = { + boundary: string; + ic: Iostream.In.t; + buf: buf; (** Used to split on the boundary *) + mutable first: bool; (** Are we parsing the first boundary? *) + mutable eof_split: bool; + buf_out: buf; (** Used to return output slices *) + mutable st_out: out_state; +} + +let create ?(buf_size = 64 * 1024) ?(out_buf_size = 8 * 1024) ~boundary ic : st + = + let ic = (ic : #Iostream.In.t :> Iostream.In.t) in + { + boundary; + first = true; + ic; + buf = { bs = Bytes.create buf_size; len = 0 }; + eof_split = false; + buf_out = { bs = Bytes.create out_buf_size; len = 0 }; + st_out = Begin; + } + +type chunk = Delim | Eof | Read of int + +let[@inline] prefix_size_ (self : st) : int = + if self.first then + 2 + else + 4 + +let[@inline] min_len_ (self : st) : int = + prefix_size_ self + String.length self.boundary + +exception Found_boundary of int + +let rec read_chunk_ (self : st) buf i_buf len : chunk = + if self.eof_split then + Eof + else if self.buf.len < min_len_ self then ( + (* try to refill buffer *) + let n = + Iostream.In.input self.ic self.buf.bs self.buf.len + (Bytes.length self.buf.bs - self.buf.len) + in + if n = 0 && self.buf.len = 0 then ( + self.eof_split <- true; + Eof + ) else if n = 0 then ( + let n_read = min len self.buf.len in + Bytes.blit self.buf.bs 0 buf i_buf n_read; + shift_left_ self.buf n_read; + Read n_read + ) else ( + self.buf.len <- self.buf.len + n; + read_chunk_ self buf i_buf len + ) + ) else ( + try + let i = ref 0 in + let end_pos = + min len self.buf.len - prefix_size_ self - String.length self.boundary + in + while !i <= end_pos do + if + self.first + && Bytes.unsafe_get self.buf.bs !i = '-' + && Bytes.unsafe_get self.buf.bs (!i + 1) = '-' + && Utils_.string_eq + ~a:(Bytes.unsafe_to_string self.buf.bs) + ~a_start:(!i + 2) ~b:self.boundary + ~len:(String.length self.boundary) + || (not self.first) + && Bytes.unsafe_get self.buf.bs !i = '\r' + && Bytes.unsafe_get self.buf.bs (!i + 1) = '\n' + && Bytes.unsafe_get self.buf.bs (!i + 2) = '-' + && Bytes.unsafe_get self.buf.bs (!i + 3) = '-' + && Utils_.string_eq + ~a:(Bytes.unsafe_to_string self.buf.bs) + ~a_start:(!i + 4) ~b:self.boundary + ~len:(String.length self.boundary) + then + raise_notrace (Found_boundary !i); + incr i + done; + let n_read = min !i len in + Bytes.blit self.buf.bs 0 buf i_buf n_read; + shift_left_ self.buf n_read; + Read n_read + with + | Found_boundary 0 -> + shift_left_ self.buf (prefix_size_ self + String.length self.boundary); + self.first <- false; + Delim + | Found_boundary n -> + let n_read = min n len in + Bytes.blit self.buf.bs 0 buf i_buf n_read; + shift_left_ self.buf n_read; + Read n_read + ) + +exception Found of int + +(** Find \r\n *) +let find_crlf_exn (buf : buf) : int = + try + for i = 0 to buf.len - 2 do + if + Bytes.unsafe_get buf.bs i = '\r' + && Bytes.unsafe_get buf.bs (i + 1) = '\n' + then + raise_notrace (Found i) + done; + raise Not_found + with Found i -> i + +let[@inline] read_to_buf_out_ (self : st) = + assert (not (buf_full self.buf_out)); + read_chunk_ self self.buf_out.bs self.buf_out.len + (Bytes.length self.buf_out.bs - self.buf_out.len) + +let read_data_or_fail_ (self : st) : unit = + match read_to_buf_out_ self with + | Delim -> failwith "multipart: unexpected boundary while parsing headers" + | Eof -> failwith "multipart: unexpected EOF while parsing headers" + | Read n -> self.buf_out.len <- self.buf_out.len + n + +let rec next (self : st) : event = + match self.st_out with + | Eof -> End_of_input + | Inside_part when self.buf_out.len > 0 -> + (* there's data to return *) + let sl = + { Slice.bytes = self.buf_out.bs; off = 0; len = self.buf_out.len } + in + self.buf_out.len <- 0; + Read sl + | Inside_part -> + (* refill or reach boundary *) + (match read_to_buf_out_ self with + | Eof -> + self.st_out <- Eof; + End_of_input + | Delim -> parse_after_boundary self + | Read n -> + self.buf_out.len <- n; + next self) + | Begin -> + (match read_to_buf_out_ self with + | Delim -> parse_after_boundary self + | Eof -> + self.st_out <- Eof; + End_of_input + | Read _ -> failwith "multipart: expected boundary, got data") + +and parse_after_boundary (self : st) : event = + while self.buf_out.len < 2 do + read_data_or_fail_ self + done; + + let after_boundary = Bytes.sub_string self.buf_out.bs 0 2 in + shift_left_ self.buf_out 2; + match after_boundary with + | "--" -> + self.st_out <- Eof; + End_of_input + | "\r\n" -> + let headers = parse_headers_rec self [] in + self.st_out <- Inside_part; + Part headers + | s -> + failwith (spf "multipart: expect '--' or '\r\n' after boundary, got %S" s) + +and parse_headers_rec (self : st) acc : Headers.t = + if self.buf_out.len = 0 then ( + read_data_or_fail_ self; + parse_headers_rec self acc + ) else ( + match find_crlf_exn self.buf_out with + | exception Not_found -> + if buf_full self.buf_out then + failwith "multipart: header line is too long" + else ( + read_data_or_fail_ self; + parse_headers_rec self acc + ) + | i -> + let line = Bytes.sub_string self.buf_out.bs 0 i in + shift_left_ self.buf_out (i + 2); + if line = "" then + List.rev acc + else ( + match Tiny_httpd.Headers.parse_line_ line with + | Ok (k, v) -> + parse_headers_rec self ((String.lowercase_ascii k, v) :: acc) + | Error msg -> + failwith + (spf "multipart: failed to parser header: %s\nline: %S" msg line) + ) + ) + +let parse_content_type (hs : Tiny_httpd.Headers.t) : _ option = + match Tiny_httpd.Headers.get "content-type" hs with + | None -> None + | Some s -> + (match String.split_on_char ';' s with + | "multipart/form-data" :: tl -> + let boundary = ref None in + List.iter + (fun s -> + match Utils_.split1_on ~c:'=' @@ String.trim s with + | Some ("boundary", "") -> () + | Some ("boundary", s) -> + let s = Utils_.remove_quotes s in + boundary := Some (`boundary s) + | _ -> ()) + tl; + !boundary + | _ -> None) + +module Private_ = struct + type nonrec chunk = chunk = Delim | Eof | Read of int + + let read_chunk_ = read_chunk_ +end diff --git a/src/multipart_form/tiny_httpd_multipart_form_data.mli b/src/multipart_form/tiny_httpd_multipart_form_data.mli new file mode 100644 index 00000000..dd7bbebc --- /dev/null +++ b/src/multipart_form/tiny_httpd_multipart_form_data.mli @@ -0,0 +1,25 @@ +(** Streaming parser for multipart/form-data *) + +module Content_disposition = Content_disposition + +type st +(** Parser state *) + +val create : + ?buf_size:int -> ?out_buf_size:int -> boundary:string -> #Iostream.In.t -> st + +val parse_content_type : Tiny_httpd.Headers.t -> [ `boundary of string ] option +(** Parse headers for [content-type: multipart/form-data; boundary=…] *) + +type slice = Iostream.Slice.t +type event = Part of Tiny_httpd.Headers.t | Read of slice | End_of_input + +val next : st -> event + +(**/*) +module Private_ : sig + type chunk = Delim | Eof | Read of int + + val read_chunk_ : st -> bytes -> int -> int -> chunk +end +(**/*) diff --git a/src/multipart_form/utils_.ml b/src/multipart_form/utils_.ml new file mode 100644 index 00000000..cb3d8a5b --- /dev/null +++ b/src/multipart_form/utils_.ml @@ -0,0 +1,28 @@ +let spf = Printf.sprintf + +let string_eq ~a ~a_start ~b ~len : bool = + assert (len <= String.length b); + if String.length a >= a_start + len then ( + try + for i = 0 to len - 1 do + let a_i = a_start + i in + if String.unsafe_get a a_i <> String.unsafe_get b i then + raise_notrace Exit + done; + true + with Exit -> false + ) else + false + +let split1_on ~c s = + match String.index s c with + | exception Not_found -> None + | i -> Some (String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1)) + +let remove_quotes s : string = + if String.length s < 2 then + s + else if s.[0] = '"' && s.[String.length s - 1] = '"' then + String.sub s 1 (String.length s - 2) + else + s diff --git a/tests/multipart_form/dune b/tests/multipart_form/dune new file mode 100644 index 00000000..38e8d9f8 --- /dev/null +++ b/tests/multipart_form/dune @@ -0,0 +1,3 @@ +(tests + (names t_chunk t_parse t_content_type t_content_disposition) + (libraries tiny_httpd tiny_httpd.multipart-form-data)) diff --git a/tests/multipart_form/t_chunk.expected b/tests/multipart_form/t_chunk.expected new file mode 100644 index 00000000..97b413f8 --- /dev/null +++ b/tests/multipart_form/t_chunk.expected @@ -0,0 +1,25 @@ +T1 +chunk "hello" +delim +chunk "\n world\n what is the meaning of" +delim +chunk "this??" +delim +chunk "ok ok ok" +delim +T2 +delim +delim +chunk "ah bon" +delim +chunk "aight" +delim +delim +T3 +delim +chunk "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" +delim +delim +chunk "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" +delim +chunk "cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc" diff --git a/tests/multipart_form/t_chunk.ml b/tests/multipart_form/t_chunk.ml new file mode 100644 index 00000000..897e0b60 --- /dev/null +++ b/tests/multipart_form/t_chunk.ml @@ -0,0 +1,53 @@ +module MFD = Tiny_httpd_multipart_form_data + +let spf = Printf.sprintf +let pf = Printf.printf + +let read_stream (st : MFD.st) : _ list = + let l = ref [] in + let buf = Bytes.create 12 in + let buffer = Buffer.create 32 in + let rec loop () = + match MFD.Private_.read_chunk_ st buf 0 (Bytes.length buf) with + | Delim -> + if Buffer.length buffer > 0 then l := `Str (Buffer.contents buffer) :: !l; + Buffer.clear buffer; + l := `Delim :: !l; + loop () + | Read n -> + Buffer.add_subbytes buffer buf 0 n; + loop () + | Eof -> + if Buffer.length buffer > 0 then l := `Str (Buffer.contents buffer) :: !l; + List.rev !l + in + loop () + +let test input_str = + let st = + MFD.create ~buf_size:16 ~boundary:"YOLO" (Iostream.In.of_string input_str) + in + let chunks = read_stream st in + List.iter + (function + | `Delim -> pf "delim\n" + | `Str s -> pf "chunk %S\n" s) + chunks; + () + +let () = + pf "T1\n"; + test + "hello--YOLO\n\ + \ world\n\ + \ what is the meaning of\r\n\ + --YOLOthis??\r\n\ + --YOLOok ok ok\r\n\ + --YOLO"; + pf "T2\n"; + test "--YOLO\r\n--YOLOah bon\r\n--YOLOaight\r\n--YOLO\r\n--YOLO"; + pf "T3\n"; + test + (spf "--YOLO%s\r\n--YOLO\r\n--YOLO%s\r\n--YOLO%s" (String.make 400 'a') + (String.make 512 'b') (String.make 400 'c')); + () diff --git a/tests/multipart_form/t_content_disposition.expected b/tests/multipart_form/t_content_disposition.expected new file mode 100644 index 00000000..a44bee6c --- /dev/null +++ b/tests/multipart_form/t_content_disposition.expected @@ -0,0 +1,3 @@ +h: ["content-foobar": "yolo";"other": "whatev"], no content disp +h ["content-disposition": "form-data; name=helloworld; junk";"other": "whatev"]: got {kind="form-data"; name="helloworld"; filename=None}, expected {kind="form-data"; name="helloworld"; filename=None}, same=true +h ["content-disposition": "form-data; lol=mdr; filename=\"some quoted stuff\""]: got {kind="form-data"; name=None; filename="some quoted stuff"}, expected {kind="form-data"; name=None; filename="some quoted stuff"}, same=true diff --git a/tests/multipart_form/t_content_disposition.ml b/tests/multipart_form/t_content_disposition.ml new file mode 100644 index 00000000..355b6cf7 --- /dev/null +++ b/tests/multipart_form/t_content_disposition.ml @@ -0,0 +1,39 @@ +module MFD = Tiny_httpd_multipart_form_data + +let pf = Printf.printf +let spf = Printf.sprintf + +let pp_headers hs = + spf "[%s]" (String.concat ";" @@ List.map (fun (k, v) -> spf "%S: %S" k v) hs) + +let test_headers h (exp : _ option) = + match MFD.Content_disposition.parse h, exp with + | Some c1, Some c2 -> + pf "h %s: got %s, expected %s, same=%b\n" (pp_headers h) + (MFD.Content_disposition.to_string c1) + (MFD.Content_disposition.to_string c2) + (c1 = c2) + | Some c1, None -> + pf "h: %s, unexpected content disp %s\n" (pp_headers h) + (MFD.Content_disposition.to_string c1) + | None, Some c2 -> + pf "h: %s, expected content disp %s\n" (pp_headers h) + (MFD.Content_disposition.to_string c2) + | None, None -> pf "h: %s, no content disp\n" (pp_headers h) + +let () = + test_headers [ "content-foobar", "yolo"; "other", "whatev" ] None; + test_headers + [ + "content-disposition", "form-data; name=helloworld; junk"; + "other", "whatev"; + ] + (Some { kind = "form-data"; name = Some "helloworld"; filename = None }); + test_headers + [ + ( "content-disposition", + "form-data; lol=mdr; filename=\"some quoted stuff\"" ); + ] + (Some + { kind = "form-data"; name = None; filename = Some "some quoted stuff" }); + () diff --git a/tests/multipart_form/t_content_type.expected b/tests/multipart_form/t_content_type.expected new file mode 100644 index 00000000..4f4a6a83 --- /dev/null +++ b/tests/multipart_form/t_content_type.expected @@ -0,0 +1,3 @@ +h: ["content-type": "yolo";"other": "whatev"], no content type +h ["content-type": "multipart/form-data; boundary=helloworld; junk";"other": "whatev"]: got "helloworld", expected "helloworld", same=true +h ["content-type": "multipart/form-data; lol=mdr; boundary=\"some quoted boundary\""]: got "some quoted boundary", expected "some quoted boundary", same=true diff --git a/tests/multipart_form/t_content_type.ml b/tests/multipart_form/t_content_type.ml new file mode 100644 index 00000000..9159ba45 --- /dev/null +++ b/tests/multipart_form/t_content_type.ml @@ -0,0 +1,32 @@ +module MFD = Tiny_httpd_multipart_form_data + +let pf = Printf.printf +let spf = Printf.sprintf + +let pp_headers hs = + spf "[%s]" (String.concat ";" @@ List.map (fun (k, v) -> spf "%S: %S" k v) hs) + +let test_headers h (exp : string option) = + match MFD.parse_content_type h, exp with + | Some (`boundary c1), Some c2 -> + pf "h %s: got %S, expected %S, same=%b\n" (pp_headers h) c1 c2 (c1 = c2) + | Some (`boundary c1), None -> + pf "h: %s, unexpected content type %S\n" (pp_headers h) c1 + | None, Some c2 -> pf "h: %s, expected content type %S\n" (pp_headers h) c2 + | None, None -> pf "h: %s, no content type\n" (pp_headers h) + +let () = + test_headers [ "content-type", "yolo"; "other", "whatev" ] None; + test_headers + [ + "content-type", "multipart/form-data; boundary=helloworld; junk"; + "other", "whatev"; + ] + (Some "helloworld"); + test_headers + [ + ( "content-type", + "multipart/form-data; lol=mdr; boundary=\"some quoted boundary\"" ); + ] + (Some "some quoted boundary"); + () diff --git a/tests/multipart_form/t_parse.expected b/tests/multipart_form/t_parse.expected new file mode 100644 index 00000000..9a1bd7dd --- /dev/null +++ b/tests/multipart_form/t_parse.expected @@ -0,0 +1,12 @@ +T1 +part ["some-super-cool":"header here";"ohlook":"here"] +chunk "and now for the b-o-d-y \240\159\145\143\n" +part ["more":"headers"] +chunk "and another body\r\n" +end of input +T1 +part ["some-super-cool":"header here";"ohlook":"here"] +chunk "and now for the bigger body:\naaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n" +part ["more":"headers"] +chunk "and another body" +end of input diff --git a/tests/multipart_form/t_parse.ml b/tests/multipart_form/t_parse.ml new file mode 100644 index 00000000..19225b78 --- /dev/null +++ b/tests/multipart_form/t_parse.ml @@ -0,0 +1,72 @@ +module MFD = Tiny_httpd_multipart_form_data + +let spf = Printf.sprintf +let pf = Printf.printf + +let read_stream (st : MFD.st) : _ list = + let l = ref [] in + let buffer = Buffer.create 32 in + let rec loop () = + match MFD.next st with + | Part headers -> + if Buffer.length buffer > 0 then l := `Str (Buffer.contents buffer) :: !l; + Buffer.clear buffer; + l := `Part headers :: !l; + loop () + | Read sl -> + Buffer.add_subbytes buffer sl.bytes sl.off sl.len; + loop () + | End_of_input -> + if Buffer.length buffer > 0 then l := `Str (Buffer.contents buffer) :: !l; + l := `End_of_input :: !l; + List.rev !l + in + loop () + +let test input_str = + let st = + MFD.create ~buf_size:16 ~boundary:"YOLO" (Iostream.In.of_string input_str) + in + let chunks = read_stream st in + List.iter + (function + | `End_of_input -> pf "end of input\n" + | `Part hs -> + pf "part [%s]\n" + (String.concat ";" @@ List.map (fun (k, v) -> spf "%S:%S" k v) hs) + | `Str s -> pf "chunk %S\n" s) + chunks; + () + +let () = + pf "T1\n"; + test + "--YOLO\r\n\ + some-super-cool: header here\r\n\ + ohlook: here\r\n\ + \r\n\ + and now for the b-o-d-y 👏\n\ + \r\n\ + --YOLO\r\n\ + more: headers\r\n\ + \r\n\ + and another body\r\n\ + \r\n\ + --YOLO--"; + pf "T1\n"; + test + (spf + "--YOLO\r\n\ + some-super-cool: header here\r\n\ + ohlook: here\r\n\ + \r\n\ + and now for the bigger body:\n\ + %s\n\ + \r\n\ + --YOLO\r\n\ + more: headers\r\n\ + \r\n\ + and another body\r\n\ + --YOLO--" + (String.make 500 'a')); + ()