Merge pull request #93 from c-cube/simon/multipart-form

library for multipart form data handling

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)

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" ];
+                          ];
+                      ];
                   ];
               ];
           ]

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
+        match parse_line_ line with
-          let i = String.index line ':' in
+        | Ok r -> r
-          let k = String.sub line 0 i in
+        | Error msg ->
-          if not (for_all is_tchar k) then
+          bad_reqf 400 "invalid header line: %s\nline is: %S" msg line
-            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
       in
       loop ((String.lowercase_ascii k, v) :: acc)
   in

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
+(**/*)

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 })

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))

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

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
+(**/*)

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

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))

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"

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'));
+  ()

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

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" });
+  ()

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

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");
+  ()

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

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'));
+  ()