From 692e7a46b5a8f34e754df6786f5852b68aca3251 Mon Sep 17 00:00:00 2001 From: Clombrong Date: Sun, 29 Jun 2025 05:10:58 +0200 Subject: fix(portal_tcp): move stream rehydration to the header function this fixes the annoying xml declaration bug --- portal/tcp/portal.ml | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'portal/tcp') diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml index 5e75c76..c4c5e55 100644 --- a/portal/tcp/portal.ml +++ b/portal/tcp/portal.ml @@ -157,12 +157,9 @@ let starttls (portal : t) : unit Lwt.t = in let+ tls_sock = upgrade_to_tls s in let sock = Tls tls_sock - in let stream, push = socket_to_stream sock - in portal.stream <- stream; - portal.push <- push; - portal._socket <- sock + in portal._socket <- sock -let header ?from domain ({stream; push; _} : t) = +let header ?from domain (portal : t) = let stanza = let attributes = [(("", "to"), domain); (("", "version"), "1.0"); @@ -183,7 +180,11 @@ let header ?from domain ({stream; push; _} : t) = If you have Github, feel free to get the word out to aantron. *) `Comment ""] - in push (Some (of_list stanza)); + in + let stream, push = socket_to_stream portal._socket + in portal.stream <- stream; + portal.push <- push; + push (Some (of_list stanza)); let some_id ((_, name), value) = if name = "id" then Some value else None in let* xml = Markup_lwt.next stream in let* id = match xml with -- cgit v1.2.3