diff options
| author | Clombrong <cromblong@egregore.fun> | 2025-06-29 05:10:58 +0200 |
|---|---|---|
| committer | Clombrong <cromblong@egregore.fun> | 2025-06-29 05:13:52 +0200 |
| commit | 692e7a46b5a8f34e754df6786f5852b68aca3251 (patch) | |
| tree | a1bbc4000cf6c5c04f3abec8e59ef108a975e8a5 /portal | |
| parent | c94278c2e3ac251ee0c4201599f79fdd7a089c5e (diff) | |
fix(portal_tcp): move stream rehydration to the header function
this fixes the annoying xml declaration bug
Diffstat (limited to 'portal')
| -rw-r--r-- | portal/portal.mli | 7 | ||||
| -rw-r--r-- | portal/tcp/portal.ml | 13 |
2 files changed, 12 insertions, 8 deletions
diff --git a/portal/portal.mli b/portal/portal.mli index 8790b77..9652783 100644 --- a/portal/portal.mli +++ b/portal/portal.mli @@ -25,8 +25,11 @@ val xmlns : string (** [connect domain] returns a Portal connected to the XMPP server [domain]. *) val connect : string -> t Lwt.t -(** [starttls portal] mutates [portal] into a TLS-encrypted stream with the same - state. *) +(** [starttls portal] mutates [portal] into a TLS-encrypted stream with the same state. + + Note that when you call this function, the [stream] and [push] of the Portal are + invalidated, and need to be regenerated using [header] (this should always be done + anyways, according to the XMPP spec). *) val starttls : t -> unit Lwt.t (** [header domain portal] sends an initial stream header to the XMPP server [portal] 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 |