diff options
| -rw-r--r-- | portal/tcp/portal_tcp.ml | 19 |
1 files changed, 11 insertions, 8 deletions
diff --git a/portal/tcp/portal_tcp.ml b/portal/tcp/portal_tcp.ml index 69f0348..451d303 100644 --- a/portal/tcp/portal_tcp.ml +++ b/portal/tcp/portal_tcp.ml @@ -32,11 +32,14 @@ let tcp_stream (domain : string) : (string Lwt_stream.t * file_descr) Lwt.t = | len -> Lwt.return_some (Bytes.sub_string buffer 0 len)) in (stream, sock) -let connect (domain : string) = - let+ tcp_stream, tcp_socket = tcp_stream domain - in let push msg = - let none () = close tcp_socket - and some s () = - write_string tcp_socket s 0 (String.length s) |> Lwt.map ignore - in Option.fold ~none ~some msg |> Lwt.async - in tcp_stream, push +let connect (domain : string) : t Lwt.t = + let+ tcp_stream, tcp_socket = tcp_stream domain in + let push msg = + let none () = close tcp_socket + and some s () = + let str = write_xml s |> to_string + in write_string tcp_socket str 0 (String.length str) |> Lwt.map ignore + in Option.fold ~none ~some msg |> Lwt.async + and report loc err = raise (MalformedStanza (loc, err)) in + let open Markup_lwt in + tcp_stream |> lwt_stream |> strings_to_bytes |> parse_xml ~report |> signals, push |