diff options
Diffstat (limited to 'lib/stream.ml')
| -rw-r--r-- | lib/stream.ml | 14 |
1 files changed, 5 insertions, 9 deletions
diff --git a/lib/stream.ml b/lib/stream.ml index 4bc0901..0ea7850 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -57,16 +57,12 @@ let parse_features (stanza : Xml.element) : features = This function should be called every time a stream needs to be reopened and stream negotiation takes place. - When the XMPP server advertises optional STARTTLS support, whether the connection - will be upgraded to STARTTLS depends on [prefer_starttls]. - Basically, it conforms to {{: https://datatracker.ietf.org/doc/html/rfc6120#section-4.3 }}. *) let negotiate - ?(prefer_starttls = true) (domain : string) (portal : Portal.t) - (auth : Sasl.config) : features Lwt.t = + (config : config) : features Lwt.t = (* Test if a specific features mandates a restart of the stream. *) let needs_restart = function | Mechanisms _ | STARTTLS -> true @@ -80,7 +76,7 @@ let negotiate (* Handle a single feature. Mandatory is whether the feature is mandatory. *) let handle_feature (mandatory : bool) (f : feature) : unit Lwt.t = let handle_starttls () = - if (mandatory || prefer_starttls) + if (mandatory || config.starttls.prefer_starttls) then Starttls.upgrade portal else Lwt.return_unit and handle_mechanisms mechanisms = @@ -94,7 +90,7 @@ let negotiate | _ -> "Unknown error!" in if allow_auth () then - let* auth_result = authenticate portal auth mechanisms + let* auth_result = authenticate portal config.sasl mechanisms in match auth_result with | Error err -> Lwt.fail_with (parse_auth_error err) | Ok _ -> print_endline "Success!"; Lwt.return_unit @@ -117,9 +113,9 @@ let negotiate Once [None] is pushed into the stream, the receiving stream is drained and the socket is closed. *) -let initiate (domain : string) (auth : Sasl.config) : (Portal.t * features) Lwt.t = +let initiate (domain : string) (config : config) : (Portal.t * features) Lwt.t = let open Portal in let* p = connect domain - in let+ features = negotiate domain p auth + in let+ features = negotiate domain p config in (p, features) |