├── .gitignore ├── .travis.yml ├── CHANGES.md ├── LICENSE.md ├── README.md ├── dune-project ├── lib ├── dune ├── multipart_form_data.ml └── multipart_form_data.mli ├── multipart-form-data.opam └── test ├── dune └── tests.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.native 3 | *.merlin 4 | *.install 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | os: linux 3 | services: 4 | - docker 5 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh 6 | script: bash ./.travis-docker.sh 7 | env: 8 | global: 9 | - PACKAGE=multipart-form-data 10 | - DISTRO=alpine 11 | jobs: 12 | - OCAML_VERSION=4.04 13 | - OCAML_VERSION=4.05 14 | - OCAML_VERSION=4.06 15 | - OCAML_VERSION=4.07 16 | - OCAML_VERSION=4.08 17 | - OCAML_VERSION=4.09 18 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | ## 0.3.0 - 2020-02-03 4 | 5 | * Breaking changes: 6 | * `Multipart` module was renamed `Multipart_form_data` to match package name (#24). 7 | * Port to Dune (#24). 8 | * Use Opam 2 (#26). 9 | 10 | ## 0.2.0 - 2018-04-11 11 | 12 | * Port to jbuilder (#18). 13 | * CI improvements (#19): 14 | * Use travis-docker. 15 | * Add 4.05 + 4.06 builds. 16 | * Use the standalone `lwt_ppx` for compatibility with `lwt >= 4.0.0` (#20). 17 | 18 | ## 0.1.0 - 2016-12-06 19 | 20 | Initial release. 21 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Cryptosense 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | multipart/form-data (RFC2388) parser for OCaml 2 | ============================================== 3 | 4 | [![Build Status](https://travis-ci.org/cryptosense/multipart-form-data.svg?branch=master)](https://travis-ci.org/cryptosense/multipart-form-data) [![docs](https://img.shields.io/badge/doc-online-blue.svg)](https://cryptosense.github.io/multipart-form-data/doc/) 5 | 6 | This is a parser for structured form data based on `Lwt_stream` in order to use 7 | it with [cohttp](https://github.com/mirage/ocaml-cohttp/). You can use it to 8 | send POST parameters. 9 | 10 | There are two APIs: 11 | 12 | - a high-level one: `parse_stream` and `get_parts`. It works for strings, but 13 | has some problems with files. 14 | - a low-level one: `parse`. It works for well for both strings and files. 15 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name multipart_form_data) 3 | (public_name multipart-form-data) 4 | (libraries 5 | lwt 6 | stringext 7 | ) 8 | (preprocess 9 | (pps 10 | lwt_ppx 11 | ))) 12 | -------------------------------------------------------------------------------- /lib/multipart_form_data.ml: -------------------------------------------------------------------------------- 1 | module StringMap = Map.Make(String) 2 | 3 | let string_eq ~a ~a_start ~b ~len = 4 | let r = ref true in 5 | for i = 0 to len - 1 do 6 | let a_i = a_start + i in 7 | let b_i = i in 8 | if a.[a_i] <> b.[b_i] then 9 | r := false 10 | done; 11 | !r 12 | 13 | let ends_with ~suffix ~suffix_length s = 14 | let s_length = String.length s in 15 | (s_length >= suffix_length) && 16 | (string_eq ~a:s ~a_start:(s_length - suffix_length) ~b:suffix ~len:suffix_length) 17 | 18 | let rec first_matching p = function 19 | | [] -> None 20 | | x::xs -> 21 | begin 22 | match p x with 23 | | Some y -> Some y 24 | | None -> first_matching p xs 25 | end 26 | 27 | let option_map f = function 28 | | None -> None 29 | | Some x -> Some (f x) 30 | 31 | let find_common_idx a b = 32 | let rec go i = 33 | if i <= 0 then 34 | None 35 | else 36 | begin 37 | if ends_with ~suffix:b ~suffix_length:i a then 38 | Some (String.length a - i) 39 | else 40 | go (i - 1) 41 | end 42 | in 43 | go (String.length b) 44 | 45 | let word = function 46 | | "" -> [] 47 | | w -> [Some w] 48 | 49 | let split_on_string ~pattern s = 50 | let pattern_length = String.length pattern in 51 | let rec go start acc = 52 | match Stringext.find_from ~start s ~pattern with 53 | | Some match_start -> 54 | let before = String.sub s start (match_start - start) in 55 | let new_acc = None::(word before)@acc in 56 | let new_start = match_start + pattern_length in 57 | go new_start new_acc 58 | | None -> 59 | (word (Stringext.string_after s start))@acc 60 | in 61 | List.rev (go 0 []) 62 | 63 | let split_and_process_string ~boundary s = 64 | let f = function 65 | | None -> `Delim 66 | | Some w -> `Word w 67 | in 68 | List.map f @@ split_on_string ~pattern:boundary s 69 | 70 | let split s boundary = 71 | let r = ref None in 72 | let push v = 73 | match !r with 74 | | None -> r := Some v 75 | | Some _ -> assert false 76 | in 77 | let pop () = 78 | let res = !r in 79 | r := None; 80 | res 81 | in 82 | let go c0 = 83 | let c = 84 | match pop () with 85 | | Some x -> x ^ c0 86 | | None -> c0 87 | in 88 | let string_to_process = match find_common_idx c boundary with 89 | | None -> c 90 | | Some idx -> 91 | begin 92 | let prefix = String.sub c 0 idx in 93 | let suffix = String.sub c idx (String.length c - idx) in 94 | push suffix; 95 | prefix 96 | end 97 | in 98 | Lwt.return @@ split_and_process_string ~boundary string_to_process 99 | in 100 | let initial = Lwt_stream.map_list_s go s in 101 | let final = 102 | Lwt_stream.flatten @@ 103 | Lwt_stream.from_direct @@ fun () -> 104 | option_map (split_and_process_string ~boundary) @@ pop () 105 | in 106 | Lwt_stream.append initial final 107 | 108 | let until_next_delim s = 109 | Lwt_stream.from @@ fun () -> 110 | let%lwt res = Lwt_stream.get s in 111 | match res with 112 | | None 113 | | Some `Delim -> Lwt.return_none 114 | | Some (`Word w) -> Lwt.return_some w 115 | 116 | let join s = 117 | Lwt_stream.filter_map (function 118 | | `Delim -> Some (until_next_delim @@ Lwt_stream.clone s) 119 | | `Word _ -> None 120 | ) s 121 | 122 | let align stream boundary = 123 | join @@ split stream boundary 124 | 125 | type header = string * string 126 | 127 | let extract_boundary content_type = 128 | Stringext.chop_prefix ~prefix:"multipart/form-data; boundary=" content_type 129 | 130 | let unquote s = 131 | Scanf.sscanf s "%S" @@ (fun x -> x);; 132 | 133 | let parse_name s = 134 | option_map unquote @@ Stringext.chop_prefix ~prefix:"form-data; name=" s 135 | 136 | let parse_header s = 137 | match Stringext.cut ~on:": " s with 138 | | Some (key, value) -> (key, value) 139 | | None -> invalid_arg "parse_header" 140 | 141 | let non_empty st = 142 | let%lwt r = Lwt_stream.to_list @@ Lwt_stream.clone st in 143 | Lwt.return (String.concat "" r <> "") 144 | 145 | let get_headers : string Lwt_stream.t Lwt_stream.t -> header list Lwt.t 146 | = fun lines -> 147 | let%lwt header_lines = Lwt_stream.get_while_s non_empty lines in 148 | Lwt_list.map_s (fun header_line_stream -> 149 | let%lwt parts = Lwt_stream.to_list header_line_stream in 150 | Lwt.return @@ parse_header @@ String.concat "" parts 151 | ) header_lines 152 | 153 | type stream_part = 154 | { headers : header list 155 | ; body : string Lwt_stream.t 156 | } 157 | 158 | let parse_part chunk_stream = 159 | let lines = align chunk_stream "\r\n" in 160 | match%lwt get_headers lines with 161 | | [] -> Lwt.return_none 162 | | headers -> 163 | let body = Lwt_stream.concat @@ Lwt_stream.clone lines in 164 | Lwt.return_some { headers ; body } 165 | 166 | let parse_stream ~stream ~content_type = 167 | match extract_boundary content_type with 168 | | None -> Lwt.fail_with "Cannot parse content-type" 169 | | Some boundary -> 170 | begin 171 | let actual_boundary = ("--" ^ boundary) in 172 | Lwt.return @@ Lwt_stream.filter_map_s parse_part @@ align stream actual_boundary 173 | end 174 | 175 | let s_part_body {body; _} = body 176 | 177 | let s_part_name {headers; _} = 178 | match 179 | parse_name @@ List.assoc "Content-Disposition" headers 180 | with 181 | | Some x -> x 182 | | None -> invalid_arg "s_part_name" 183 | 184 | let parse_filename s = 185 | let parts = split_on_string s ~pattern:"; " in 186 | let f = function 187 | | None -> None 188 | | Some part -> 189 | begin 190 | match Stringext.cut part ~on:"=" with 191 | | Some ("filename", quoted_string) -> Some (unquote quoted_string) 192 | | _ -> None 193 | end 194 | in 195 | first_matching f parts 196 | 197 | let s_part_filename {headers; _} = 198 | parse_filename @@ List.assoc "Content-Disposition" headers 199 | 200 | type file = stream_part 201 | 202 | let file_stream = s_part_body 203 | let file_name = s_part_name 204 | 205 | let file_content_type {headers; _} = 206 | List.assoc "Content-Type" headers 207 | 208 | let as_part part = 209 | match s_part_filename part with 210 | | Some _filename -> 211 | Lwt.return (`File part) 212 | | None -> 213 | let%lwt chunks = Lwt_stream.to_list part.body in 214 | let body = String.concat "" chunks in 215 | Lwt.return (`String body) 216 | 217 | let get_parts s = 218 | let go part m = 219 | let name = s_part_name part in 220 | let%lwt parsed_part = as_part part in 221 | Lwt.return @@ StringMap.add name parsed_part m 222 | in 223 | Lwt_stream.fold_s go s StringMap.empty 224 | 225 | let concat a b = 226 | match (a, b) with 227 | | (_, "") -> a 228 | | ("", _) -> b 229 | | _ -> a ^ b 230 | 231 | module Reader = struct 232 | type t = 233 | { mutable buffer : string 234 | ; source : string Lwt_stream.t 235 | } 236 | 237 | let make stream = 238 | { buffer = "" 239 | ; source = stream 240 | } 241 | 242 | let unread r s = 243 | r.buffer <- concat s r.buffer 244 | 245 | let empty r = 246 | if r.buffer = "" then 247 | Lwt_stream.is_empty r.source 248 | else 249 | Lwt.return false 250 | 251 | let read_next r = 252 | let%lwt next_chunk = Lwt_stream.next r.source in 253 | r.buffer <- concat r.buffer next_chunk; 254 | Lwt.return_unit 255 | 256 | let read_chunk r = 257 | try%lwt 258 | let%lwt () = 259 | if r.buffer = "" then 260 | read_next r 261 | else 262 | Lwt.return_unit 263 | in 264 | let res = r.buffer in 265 | r.buffer <- ""; 266 | Lwt.return (Some res) 267 | with Lwt_stream.Empty -> 268 | Lwt.return None 269 | 270 | let buffer_contains r s = 271 | match Stringext.cut r.buffer ~on:s with 272 | | Some _ -> true 273 | | None -> false 274 | 275 | let rec read_until r cond = 276 | if cond () then 277 | Lwt.return_unit 278 | else 279 | begin 280 | let%lwt () = read_next r in 281 | read_until r cond 282 | end 283 | 284 | let read_line r = 285 | let delim = "\r\n" in 286 | let%lwt () = read_until r (fun () -> buffer_contains r delim) in 287 | match Stringext.cut r.buffer ~on:delim with 288 | | None -> assert false 289 | | Some (line, next) -> 290 | begin 291 | r.buffer <- next; 292 | Lwt.return (line ^ delim) 293 | end 294 | end 295 | 296 | let read_headers reader = 297 | let rec go headers = 298 | let%lwt line = Reader.read_line reader in 299 | if line = "\r\n" then 300 | Lwt.return headers 301 | else 302 | let header = parse_header line in 303 | go (header::headers) 304 | in 305 | go [] 306 | 307 | let rec compute_case reader boundary = 308 | match%lwt Reader.read_chunk reader with 309 | | None -> Lwt.return `Empty 310 | | Some line -> 311 | begin 312 | match Stringext.cut line ~on:(boundary ^ "\r\n") with 313 | | Some (pre, post) -> Lwt.return @@ `Boundary (pre, post) 314 | | None -> 315 | begin 316 | match Stringext.cut line ~on:(boundary ^ "--\r\n") with 317 | | Some (pre, post) -> Lwt.return @@ `Boundary (pre, post) 318 | | None -> 319 | begin 320 | match find_common_idx line boundary with 321 | | Some 0 -> 322 | begin 323 | Reader.unread reader line; 324 | let%lwt () = Reader.read_next reader in 325 | compute_case reader boundary 326 | end 327 | | Some amb_idx -> 328 | let unambiguous = String.sub line 0 amb_idx in 329 | let ambiguous = String.sub line amb_idx (String.length line - amb_idx) in 330 | Lwt.return @@ `May_end_with_boundary (unambiguous, ambiguous) 331 | | None -> Lwt.return @@ `App_data line 332 | end 333 | end 334 | end 335 | 336 | let iter_part reader boundary callback = 337 | let fin = ref false in 338 | let last () = 339 | fin := true; 340 | Lwt.return_unit 341 | in 342 | let handle ~send ~unread ~finish = 343 | let%lwt () = callback send in 344 | Reader.unread reader unread; 345 | if finish then 346 | last () 347 | else 348 | Lwt.return_unit 349 | in 350 | while%lwt not !fin do 351 | let%lwt res = compute_case reader boundary in 352 | match res with 353 | | `Empty -> last () 354 | | `Boundary (pre, post) -> handle ~send:pre ~unread:post ~finish:true 355 | | `May_end_with_boundary (unambiguous, ambiguous) -> handle ~send:unambiguous ~unread:ambiguous ~finish:false 356 | | `App_data line -> callback line 357 | done 358 | 359 | let read_file_part reader boundary callback = 360 | iter_part reader boundary callback 361 | 362 | let strip_crlf s = 363 | if ends_with ~suffix:"\r\n" ~suffix_length:2 s then 364 | String.sub s 0 (String.length s - 2) 365 | else 366 | s 367 | 368 | let read_string_part reader boundary = 369 | let value = Buffer.create 0 in 370 | let append_to_value line = Lwt.return (Buffer.add_string value line) in 371 | let%lwt () = iter_part reader boundary append_to_value in 372 | Lwt.return @@ strip_crlf (Buffer.contents value) 373 | 374 | let read_part reader boundary callback fields = 375 | let%lwt headers = read_headers reader in 376 | let content_disposition = List.assoc "Content-Disposition" headers in 377 | let name = 378 | match parse_name content_disposition with 379 | | Some x -> x 380 | | None -> invalid_arg "handle_multipart" 381 | in 382 | match parse_filename content_disposition with 383 | | Some filename -> read_file_part reader boundary (callback ~name ~filename) 384 | | None -> 385 | let%lwt value = read_string_part reader boundary in 386 | fields := (name, value)::!fields; 387 | Lwt.return_unit 388 | 389 | let handle_multipart reader boundary callback = 390 | let fields = (ref [] : (string * string) list ref) in 391 | let%lwt () = 392 | let%lwt _dummyline = Reader.read_line reader in 393 | let fin = ref false in 394 | while%lwt not !fin do 395 | if%lwt Reader.empty reader then 396 | Lwt.return (fin := true) 397 | else 398 | read_part reader boundary callback fields 399 | done 400 | in 401 | Lwt.return (!fields) 402 | 403 | let parse ~stream ~content_type ~callback = 404 | let reader = Reader.make stream in 405 | let boundary = 406 | match extract_boundary content_type with 407 | | Some s -> "--" ^ s 408 | | None -> invalid_arg "iter_multipart" 409 | in 410 | handle_multipart reader boundary callback 411 | -------------------------------------------------------------------------------- /lib/multipart_form_data.mli: -------------------------------------------------------------------------------- 1 | (** 2 | Align a stream on a particular sequence and remove these boundaries. 3 | *) 4 | val align : string Lwt_stream.t -> string -> string Lwt_stream.t Lwt_stream.t 5 | 6 | type stream_part 7 | 8 | val s_part_name : stream_part -> string 9 | 10 | val s_part_body : stream_part -> string Lwt_stream.t 11 | 12 | val s_part_filename : stream_part -> string option 13 | 14 | val parse_stream : stream:string Lwt_stream.t -> content_type:string -> stream_part Lwt_stream.t Lwt.t 15 | 16 | type file 17 | 18 | val file_name : file -> string 19 | val file_content_type : file -> string 20 | val file_stream : file -> string Lwt_stream.t 21 | 22 | module StringMap : Map.S with type key = string 23 | 24 | val get_parts : stream_part Lwt_stream.t -> [`String of string | `File of file] StringMap.t Lwt.t 25 | 26 | val parse : 27 | stream:string Lwt_stream.t 28 | -> content_type:string 29 | -> callback:(name:string -> filename:string -> string -> unit Lwt.t) 30 | -> (string * string) list Lwt.t 31 | -------------------------------------------------------------------------------- /multipart-form-data.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: ["Cryptosense "] 3 | authors: ["Cryptosense "] 4 | homepage: "https://github.com/cryptosense/multipart-form-data" 5 | bug-reports: "https://github.com/cryptosense/multipart-form-data/issues" 6 | license: "BSD-2" 7 | dev-repo: "git+https://github.com/cryptosense/multipart-form-data.git" 8 | doc: "https://cryptosense.github.io/multipart-form-data/doc" 9 | build: [ 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ] 12 | run-test: [ 13 | ["dune" "runtest" "-p" name "-j" jobs] 14 | ] 15 | depends: [ 16 | "alcotest" {with-test} 17 | "dune" 18 | "lwt" 19 | "lwt_ppx" 20 | "stringext" 21 | ] 22 | synopsis: "Parser for multipart/form-data (RFC2388)" 23 | description: """ 24 | This is a parser for structured form data based on `Lwt_stream` in order to use 25 | it with cohttp. You can use it to send POST parameters. 26 | """ 27 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name tests) 3 | (libraries 4 | multipart-form-data 5 | alcotest 6 | lwt.unix 7 | ) 8 | (preprocess 9 | (pps 10 | lwt_ppx 11 | ) 12 | ) 13 | ) 14 | -------------------------------------------------------------------------------- /test/tests.ml: -------------------------------------------------------------------------------- 1 | let get_file name parts = 2 | match Multipart_form_data.StringMap.find name parts with 3 | | `File file -> file 4 | | `String _ -> failwith "expected a file" 5 | 6 | module String_or_file = struct 7 | type t = [`String of string | `File of Multipart_form_data.file] 8 | 9 | let equal = (=) 10 | 11 | let pp fmt (part : t) = 12 | let s = match part with 13 | | `File _ -> "File _" 14 | | `String s -> s 15 | in 16 | Format.pp_print_string fmt s 17 | end 18 | 19 | let string_or_file = (module String_or_file : Alcotest.TESTABLE with type t = String_or_file.t) 20 | 21 | let test_parse () = 22 | let body = 23 | String.concat "\r\n" 24 | [ {|--------------------------1605451f456c9a1a|} 25 | ; {|Content-Disposition: form-data; name="a"|} 26 | ; {||} 27 | ; {|b|} 28 | ; {|--------------------------1605451f456c9a1a|} 29 | ; {|Content-Disposition: form-data; name="c"|} 30 | ; {||} 31 | ; {|d|} 32 | ; {|--------------------------1605451f456c9a1a|} 33 | ; {|Content-Disposition: form-data; name="upload"; filename="testfile"|} 34 | ; {|Content-Type: application/octet-stream|} 35 | ; {||} 36 | ; {|testfilecontent|} 37 | ; {||} 38 | ; {|--------------------------1605451f456c9a1a--|} 39 | ] 40 | in 41 | let content_type = "multipart/form-data; boundary=------------------------1605451f456c9a1a" in 42 | let stream = Lwt_stream.of_list [body] in 43 | let thread = 44 | let%lwt parts_stream = Multipart_form_data.parse_stream ~stream ~content_type in 45 | let%lwt parts = Multipart_form_data.get_parts parts_stream in 46 | Alcotest.check string_or_file "'a' value" (`String "b") (Multipart_form_data.StringMap.find "a" parts); 47 | Alcotest.check string_or_file "'c' value" (`String "d") (Multipart_form_data.StringMap.find "c" parts); 48 | let file = get_file "upload" parts in 49 | Alcotest.check Alcotest.string "filename" "upload" (Multipart_form_data.file_name file); 50 | Alcotest.check Alcotest.string "content_type" "application/octet-stream" (Multipart_form_data.file_content_type file); 51 | let%lwt file_chunks = Lwt_stream.to_list (Multipart_form_data.file_stream file) in 52 | Alcotest.check Alcotest.string "contents" "testfilecontent" (String.concat "" file_chunks); 53 | Lwt.return_unit 54 | in 55 | Lwt_main.run thread 56 | 57 | let tc content_type chunks expected_parts expected_calls = 58 | let stream = Lwt_stream.of_list chunks in 59 | let calls = ref [] in 60 | let callback ~name ~filename line = 61 | calls := !calls @ [((name, filename), line)]; 62 | Lwt.return_unit 63 | in 64 | let%lwt parts = Multipart_form_data.parse ~stream ~content_type ~callback in 65 | let string2_list = Alcotest.(list (pair string string)) in 66 | let string3_list = Alcotest.(list (pair (pair string string) string)) in 67 | Alcotest.check string2_list "parts" expected_parts parts; 68 | Alcotest.check string3_list "calls" 69 | (List.map (fun (x, y, z) -> ((x, y), z)) expected_calls) 70 | !calls; 71 | Lwt.return_unit 72 | 73 | let test_parse_request () = 74 | let cr = "\r" in 75 | let lf = "\n" in 76 | let crlf = cr ^ lf in 77 | let thread = 78 | let%lwt () = 79 | tc "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" 80 | ( List.map (String.concat "\n") @@ 81 | [ [ {|--9219489391874b51bb29b52a10e8baac|} ^ cr 82 | ; {|Content-Disposition: form-data; name="foo"|} ^ cr 83 | ; {||} ^ cr 84 | ; {|toto|} ^ cr 85 | ; {|--9219489391874b51bb29b52a10e8baac|} ^ cr 86 | ; {|Content-Disposition: form-data; name="bar"; filename="filename.data"|} ^ cr 87 | ; {|Content-Type: application/octet-stream|} ^ cr 88 | ; {||} ^ cr 89 | ; {|line1|} 90 | ; {|line2|} 91 | ; {||} 92 | ] 93 | ; [ {|line3|} 94 | ; {|line4|} 95 | ; {||} 96 | ] 97 | ; [ {|line5|} 98 | ; {|line6|} 99 | ; {|--9219489391874b51bb29b52a10e8baac--|} ^ cr 100 | ; {||} 101 | ] 102 | ] 103 | ) 104 | [ ("foo", "toto") ] 105 | [ ("bar", "filename.data", "line1\nline2\n") 106 | ; ("bar", "filename.data", "line3\nline4\n") 107 | ; ("bar", "filename.data", "line5\nline6\n") 108 | ] 109 | in 110 | tc 111 | "multipart/form-data; boundary=9219489391874b51bb29b52a10e8baac" 112 | ( 113 | [ {|--9219489391874b51bb29b52a10e8baac|} ^ crlf 114 | ; {|Content-Disposition: form-data; name="foo"|} ^ crlf 115 | ; crlf 116 | ; {|toto|} ^ crlf 117 | ; {|--9219489391874b|} 118 | ; {|51bb29b52a10e8baac--|} ^ crlf 119 | ] 120 | ) 121 | [ ("foo", "toto") ] 122 | [] 123 | in 124 | Lwt_main.run thread 125 | 126 | let test_split () = 127 | let in_stream = 128 | Lwt_stream.of_list 129 | [ "ABCD" 130 | ; "EFap" 131 | ; "ple" 132 | ; "ABCDEFor" 133 | ; "angeABC" 134 | ; "HHpl" 135 | ; "umABCDEFkiwi" 136 | ; "ABCDEF" 137 | ] 138 | in 139 | let expected = 140 | [ ["ap" ; "ple"] 141 | ; ["or"; "ange"; "ABCHHpl"; "um"] 142 | ; ["kiwi"] 143 | ; [] 144 | ] 145 | in 146 | let stream = Multipart_form_data.align in_stream "ABCDEF" in 147 | Lwt_main.run ( 148 | let%lwt streams = Lwt_stream.to_list stream in 149 | let%lwt result = Lwt_list.map_s Lwt_stream.to_list streams in 150 | Alcotest.check Alcotest.(list (list string)) "contents" expected result; 151 | Lwt.return_unit 152 | ) 153 | 154 | let () = 155 | Alcotest.run "multipart-form-data" [ ("Multipart_form_data", 156 | [ "parse", `Quick, test_parse 157 | ; "parse_request", `Quick, test_parse_request 158 | ; "split", `Quick, test_split 159 | ] 160 | )] 161 | --------------------------------------------------------------------------------