diff options
| -rw-r--r-- | portal/tcp/portal.ml | 17 |
1 files changed, 10 insertions, 7 deletions
diff --git a/portal/tcp/portal.ml b/portal/tcp/portal.ml index 3abf00e..48d0571 100644 --- a/portal/tcp/portal.ml +++ b/portal/tcp/portal.ml @@ -185,10 +185,15 @@ let _encrypted = function | Plain _ -> false | Tls _ -> true -let header ?from (portal : t) = +let stream ?from (_socket : socket) : t Lwt.t = let stanza = + let domain = match _socket with + | Plain s -> s.domain + | Tls s -> s.domain + in let attributes = - [(("", "to"), portal.domain); (("", "version"), "1.0"); + [(("", "to"), domain); + (("", "version"), "1.0"); (("http://www.w3.org/XML/1998/namespace", "lang"), "en"); (("http://www.w3.org/2000/xmlns/", "xmlns"), "jabber:client"); (("http://www.w3.org/2000/xmlns/", "stream"), xmlns)] @@ -207,12 +212,10 @@ let header ?from (portal : t) = If you have Github, feel free to get the word out to aantron. *) `Comment ""] in - let stream, push = match portal._socket with + let stream, push = match _socket with | Plain s -> socket_to_stream s | Tls s -> socket_to_stream s - in portal.stream <- stream; - portal.push <- push; - push (Some (of_list stanza)); + in 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 @@ -225,5 +228,5 @@ let header ?from (portal : t) = end | _ -> Lwt.return_none in match id with - | Some id -> Lwt.return id + | Some _id -> Lwt.return {stream; push; _socket} | None -> Lwt.fail_with "Invalid stream opening server-side." |