diff --git a/lib/content_type.ml b/lib/content_type.ml index 0d1da38..2711dd8 100644 --- a/lib/content_type.ml +++ b/lib/content_type.ml @@ -544,7 +544,11 @@ module Decoder = struct char '\\' *> any_char >>| Parameters.of_escaped_character >>| String.make 1 let quoted_string = - char '"' *> many (quoted_pair <|> utf_8_and is_qtext) + char '"' + *> many + (quoted_pair + <|> utf_8_and is_qtext + <|> (satisfy is_wsp >>| String.make 1)) <* char '"' >>| String.concat "" diff --git a/test/rfc5322.ml b/test/rfc5322.ml index 27cf2ef..5b212de 100644 --- a/test/rfc5322.ml +++ b/test/rfc5322.ml @@ -166,14 +166,61 @@ let parse_header x = Angstrom.parse_string ~consume:Angstrom.Consume.Prefix Mrmime.Header.Decoder.header (x ^ "\r\n") with - | Ok header -> Fmt.pr "header: @[%a@].\n%!" Mrmime.Header.pp header + | Ok header -> header | Error _ -> Fmt.failwith "Invalid header" +let parse_and_print_header x = + parse_header x |> Fmt.pr "header: @[%a@].\n%!" Mrmime.Header.pp + let header_tests = let make idx input = Alcotest.test_case (Fmt.strf "header %d" idx) `Quick @@ fun () -> - Alcotest.(check pass) input (parse_header input) () + Alcotest.(check pass) input (parse_and_print_header input) () in List.mapi make header_tests -let () = Alcotest.run "rfc5322" [ ("header", header_tests) ] +(* [parse_content_type x expected] extracts a content-type header from + x and compares its types, subtypes and parameters counts to the + expected values [expected] *) +let parse_content_type x (ty, subty, param_count) = + let open Mrmime in + let content_type = parse_header x |> Header.assoc Field_name.content_type in + let ty', subty', param_count' = + match content_type with + | [ Mrmime.Field.Field (_, w, v) ] -> ( + match w with + | Field.Content -> + ( Content_type.ty v, + Content_type.subty v, + Content_type.parameters v |> List.length ) + | _ -> Fmt.failwith "Not a content type.") + | _ -> Fmt.failwith "Invalid header" + in + if not (Content_type.Type.equal ty ty') then + Fmt.failwith "Content-type don't matched" + else if not (Content_type.Subtype.equal subty subty') then + Fmt.failwith "Content-subtype don't matched" + else if not (param_count = param_count') then + Fmt.failwith "Not the same number of parameters." + else () + +(* Check that whitespaces are allowed in content type parameter value (PR#72) *) +let content_type_test = + let test = + {|From: Nathaniel Borenstein + (=?iso-8859-8?b?7eXs+SDv4SDp7Oj08A==?=) +To: Greg Vaudreuil , Ned Freed + , Keith Moore +Subject: Test of new header generator +MIME-Version: 1.0 +Content-type: text/plain; wpefjjnqwisj231=" q02eifwe0sn "; weinfw="qwewqe" +|} + in + let ct = + Mrmime.Content_type.(Type.text, Subtype.iana_exn Type.text "plain", 2) + in + Alcotest.test_case "header - content-type" `Quick @@ fun () -> + Alcotest.(check pass) test (parse_content_type test ct) () + +let () = + Alcotest.run "rfc5322" [ ("header", header_tests @ [ content_type_test ]) ]