From 32fe064825f5a495c5c291df494c4e4dd9846c53 Mon Sep 17 00:00:00 2001 From: Clombrong Date: Sun, 29 Jun 2025 06:56:36 +0200 Subject: fix(stream): allow required special case --- lib/stream.ml | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/lib/stream.ml b/lib/stream.ml index b997a25..d544f14 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -30,10 +30,18 @@ let parse_features (el : Xml.element) : features = | "mechanisms" -> {acc with mechanisms=parse_mechanisms feature.children} | "starttls" -> {acc with starttls=parse_starttls feature.children} | _ -> {acc with unknown = feature :: acc.unknown} - in List.fold_left - parse_feature - {mechanisms=[]; starttls=`None; unknown=[]} - (List.filter_map find_left el.children) + in + (* The XMPP spec mandates that sending a features element that contains only a + means the STARTTLS negotiation is required. *) + match el.children with + | [Left {local_name="starttls"; + attributes=[]; + children=[]; + namespace; _}] when namespace = Xmlns.tls -> + {mechanisms=[]; starttls=`Required; unknown=[]} + | _ -> List.fold_left parse_feature + {mechanisms=[]; starttls=`None; unknown=[]} + (List.filter_map find_left el.children) (** [negotiate domain portal auth] is a promise containing the features supported by the XMPP server [portal], after eventual STARTTLS negotiation and authentication using -- cgit v1.2.3