Merge pull request #59 from mirage/fix-quoted-printable

Fix how we parse quoted-printable contents with a simple example

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

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

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

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