diff options
| author | Clombrong <cromblong@egregore.fun> | 2025-06-29 18:41:14 +0200 |
|---|---|---|
| committer | Clombrong <cromblong@egregore.fun> | 2025-06-29 19:01:41 +0200 |
| commit | fa95a6ba1f42611c068b14941a141a995421d5f6 (patch) | |
| tree | 80666af1e0b1ee2186e85d06dad428e8d0d5b420 /lib/stream.ml | |
| parent | 1842a1fe0f21457d55c4479f2e3cb7a7b2c2b3e0 (diff) | |
feat(stream): detach starttls function from handle_features
Diffstat (limited to 'lib/stream.ml')
| -rw-r--r-- | lib/stream.ml | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/lib/stream.ml b/lib/stream.ml index 0ea7850..362b3ee 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -50,6 +50,15 @@ let parse_features (stanza : Xml.element) : features = | [], [STARTTLS] -> [STARTTLS], [] | _ -> features +(** [starttls mandatory portal config] negotiates STARTTLS and establishes a TLS + handshake with the XMPP server [portal], following the stream config [config]. + + If STARTLS is required during negotiation, [mandatory] is true. *) +let starttls mandatory portal {starttls=config; _} = + if (mandatory || config.prefer_starttls) + then Starttls.upgrade portal + else Lwt.return_unit + (** [negotiate domain portal auth] is a promise containing the features supported by the XMPP server [portal], after eventual STARTTLS negotiation and authentication using the auth config [auth]. @@ -75,11 +84,7 @@ let negotiate in (* 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 || config.starttls.prefer_starttls) - then Starttls.upgrade portal - else Lwt.return_unit - and handle_mechanisms mechanisms = + let handle_mechanisms mechanisms = let open Sasl in let allow_auth () = Portal._encrypted portal._socket || @@ -96,7 +101,7 @@ let negotiate | Ok _ -> print_endline "Success!"; Lwt.return_unit else Lwt.fail InsufficientEncryption in match f with - | STARTTLS -> handle_starttls () + | STARTTLS -> starttls mandatory portal config | Mechanisms m -> handle_mechanisms m | _ -> Lwt.return_unit in |