diff options
Diffstat (limited to 'portal')
| -rw-r--r-- | portal/tcp/portal.ml | 26 |
1 files changed, 21 insertions, 5 deletions
diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml index 89adb2d..35930e4 100644 --- a/portal/tcp/portal.ml +++ b/portal/tcp/portal.ml @@ -86,9 +86,24 @@ let socket_to_stream (sock : socket) = in match len with | 0 -> Lwt.return_none | len -> Lwt.return_some (Bytes.sub_string recv_bytes 0 len)) - and send_char c = - (* This is gross, but it doesn't matter because TCP does buffering. *) - let+ _ = Lwt_unix.write_string sock (Char.escaped c) 0 1 in () + in + let buffer = Buffer.create 1024 in + let flush_buffer () = + let content = Buffer.to_bytes buffer in + Buffer.clear buffer; + let* _ = + try%lwt Lwt_unix.write sock content 0 (Bytes.length content) + with + | Unix.Unix_error (Unix.ECONNRESET, _, _) + | Unix.Unix_error (Unix.EPIPE, _, _) -> Lwt.return 0 + | exn -> Lwt.fail exn + in Lwt.return_unit + in + let chomp c = + Buffer.add_char buffer c; + if Buffer.length buffer >= 1024 || c = '>' + then flush_buffer () + else Lwt.return_unit and xml_stream, xml_push = Lwt_stream.create () in let push = function | None -> xml_push None @@ -101,8 +116,9 @@ let socket_to_stream (sock : socket) = |> parse_xml ~report |> signals in Lwt.async (fun () -> - let* _ = lwt_stream xml_stream |> Markup_lwt.write_xml |> iter send_char - in Lwt_unix.close sock); + let* _ = lwt_stream xml_stream |> Markup_lwt.write_xml |> iter chomp + in let* _ = flush_buffer () + in Lwt_unix.close sock); (stream, push) (** [connect domain] is a Portal.t communicating with the XMPP server located at |