From 0e0c38fa077a104c3f5cb60448625fe6d0808c66 Mon Sep 17 00:00:00 2001 From: Romain Calascibetta Date: Thu, 20 May 2021 18:42:12 +0200 Subject: [PATCH] Fix how we parse quoted-printable contents with a simple example --- lib/mail.ml | 7 ++++++- lib/quoted_printable.ml | 38 ++++++++++++++++++++------------------ mrmime.opam | 4 ++++ test/test_mail.ml | 37 +++++++++++++++++++++++++++++++++---- 4 files changed, 63 insertions(+), 23 deletions(-) diff --git a/lib/mail.ml b/lib/mail.ml index 1214896..5f7eb5e 100644 --- a/lib/mail.ml +++ b/lib/mail.ml @@ -65,12 +65,17 @@ let heavy_octet boundary header = | None -> let buf = Buffer.create 0x800 in let write_line line = + Fmt.epr ">>> %S.\n%!" line; Buffer.add_string buf line; Buffer.add_string buf "\n" in - let write_data = Buffer.add_string buf in + let write_data str = + Fmt.epr ">>> %S.\n%!" str; + Buffer.add_string buf str + in (match Header.content_encoding header with | `Quoted_printable -> + Fmt.epr ">>> parse quoted-printable.\n%!"; Quoted_printable.to_end_of_input ~write_data ~write_line | `Base64 -> B64.to_end_of_input ~write_data | `Bit7 | `Bit8 | `Binary -> to_end_of_input ~write_data diff --git a/lib/quoted_printable.ml b/lib/quoted_printable.ml index 9b12bf7..a91cbfb 100644 --- a/lib/quoted_printable.ml +++ b/lib/quoted_printable.ml @@ -111,28 +111,30 @@ let with_emitter ?(end_of_line = "\n") ~emitter end_of_body = let write_line x = emitter (Some (x ^ end_of_line)) in parser ~write_data ~write_line end_of_body -let to_end_of_input ~write_data ~write_line = - let dec = Pecu.decoder `Manual in - - fix @@ fun m -> +let rec parser ~write_data ~write_line dec = match Pecu.decode dec with | `End -> commit - | `Await -> ( - peek_char >>= function - | None -> - Pecu.src dec Bytes.empty 0 0; - return () - | Some _ -> - available >>= fun n -> - Unsafe.take n (fun ba ~off ~len -> - let chunk = Bytes.create len in - Bigstringaf.blit_to_bytes ba ~src_off:off chunk ~dst_off:0 ~len; - Pecu.src dec chunk 0 len) - >>= fun () -> m) | `Data data -> write_data data; - m + parser ~write_data ~write_line dec | `Line line -> write_line line; - m + parser ~write_data ~write_line dec | `Malformed err -> fail err + | `Await -> ( + peek_char >>= function + | None -> + let () = Pecu.src dec Bytes.empty 0 0 in + return () + | Some _ -> + available >>= take <* commit >>= fun str -> + let () = + Pecu.src dec (Bytes.unsafe_of_string str) 0 (String.length str) + in + parser ~write_data ~write_line dec) + +let to_end_of_input ~write_data ~write_line = + let dec = Pecu.decoder `Manual in + peek_char *> available >>= take >>= fun str -> + Pecu.src dec (Bytes.unsafe_of_string str) 0 (String.length str); + parser ~write_data ~write_line dec diff --git a/mrmime.opam b/mrmime.opam index 3d2376b..34bdf81 100644 --- a/mrmime.opam +++ b/mrmime.opam @@ -38,3 +38,7 @@ depends: [ "jsonm" {with-test} "crowbar" {with-test} ] + +pin-depends: [ + [ "pecu.dev" "git+https://github.com/mirage/pecu.git#b33965ed8ade1102ae1f18ba6c95aa5d696ec9c3" ] +] diff --git a/test/test_mail.ml b/test/test_mail.ml index 9c3d12b..de32c23 100644 --- a/test/test_mail.ml +++ b/test/test_mail.ml @@ -240,9 +240,7 @@ let remove_fws (unstrctrd : Unstrctrd.t) = let test2 () = Alcotest.test_case "large subject" `Quick @@ fun () -> let res0 = stream_to_string (Mrmime.Mt.to_stream example2) in - match - Angstrom.parse_string ~consume:Angstrom.Consume.All Mrmime.Mail.mail res0 - with + match Angstrom.parse_string ~consume:All Mrmime.Mail.mail res0 with | Ok (header, _) -> ( let open Mrmime in match Header.assoc Field_name.subject header with @@ -255,4 +253,35 @@ let test2 () = | _ -> Fmt.invalid_arg "Field \"Subject\" does not exist") | Error _ -> Fmt.invalid_arg "Generate unparsable email" -let () = Alcotest.run "mail" [ ("example", [ test0 (); test1 (); test2 () ]) ] +let example3 = + {mrmime|From: romain.calascibetta@x25519.net +To: romain.calascibetta@din.osau.re +Content-Type: text/plain; charset=utf-8 +Content-Transfer-Encoding: quoted-printable + +J'interdis aux marchands de vanter trop leurs marchandises. Car ils se font= + vite p=C3=A9dagogues et t'enseignent comme but ce qui n'est par essence qu= +'un moyen, et te trompant ainsi sur la route =C3=A0 suivre les voil=C3=A0 = +bient=C3=B4t qui te d=C3=A9gradent, car si leur musique est vulgaire il= +s te fabriquent pour te la vendre une =C3=A2me vulgaire. + =E2=80=94=E2=80=89Antoine de Saint-Exup=C3=A9ry, Citadelle (1948) + +|mrmime} + +let contents = + {unicode|J'interdis aux marchands de vanter trop leurs marchandises. Car ils se font vite pédagogues et t'enseignent comme but ce qui n'est par essence qu'un moyen, et te trompant ainsi sur la route à suivre les voilà bientôt qui te dégradent, car si leur musique est vulgaire ils te fabriquent pour te la vendre une âme vulgaire. + — Antoine de Saint-Exupéry, Citadelle (1948) + +|unicode} + +let test3 () = + Alcotest.test_case "quoted-printable contents" `Quick @@ fun () -> + match Angstrom.parse_string ~consume:Prefix Mrmime.Mail.mail example3 with + | Ok (_, Leaf { Mrmime.Mail.body; _ }) -> + Alcotest.(check string) "contents" body contents + | Ok _ -> Fmt.invalid_arg "Invalid structure of the email" + | Error _ -> Fmt.invalid_arg "Invalid email" + +let () = + Alcotest.run "mail" + [ ("example", [ test0 (); test1 (); test2 (); test3 () ]) ]