diff options
| -rw-r--r-- | lib/stream.ml | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/lib/stream.ml b/lib/stream.ml index ee33575..2b98192 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -43,10 +43,18 @@ let parse_features (el : Xml.element) : features = Basically, it conforms to {{: https://datatracker.ietf.org/doc/html/rfc6120#section-4.3 }}. *) -let negotiate (domain : string) (portal : Portal.t) : features Lwt.t = - let* _id = Portal.header domain portal - in let+ features = Wire.get portal.stream >|= parse_features - in features +let negotiate ?(prefer_starttls = true) (domain : string) (portal : Portal.t) : features Lwt.t = + (* Restart a stream: Send the usual business, ask for features. *) + let start_stream () : features Lwt.t = + let* _id = Portal.header domain portal + in Wire.get portal.stream >|= parse_features + in + let starttls features = + match features.starttls, prefer_starttls with + | `Optional, false | `None, _ -> Lwt.return features + | `Optional, true | `Required, _-> + Starttls.upgrade portal >>= start_stream + in start_stream () >>= starttls (** [initiate domain] initiates a stream with the XMPP server [domain]. |