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 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 + <starttls/> 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 |