summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/stream.ml6
1 files changed, 6 insertions, 0 deletions
diff --git a/lib/stream.ml b/lib/stream.ml
index 31581a0..2e39935 100644
--- a/lib/stream.ml
+++ b/lib/stream.ml
@@ -14,22 +14,28 @@ type features = {
let parse_features (el : Xml.element) : features =
let open Xml in
let open Either in
+
let parse_single_mechanism = function
| Left {local_name = "mechanism"; children = [Right mechanism]; _} ->
Sasl.parse_auth_mechanism mechanism
| _ -> raise (InvalidStanza (element_to_string el))
in
+
let parse_feature (acc : features) (feature : Xml.element) : features =
+
let parse_mechanisms ch = List.map parse_single_mechanism ch
+
and parse_starttls = function
| [Left {local_name="required"; _}] -> `Required
| [] -> `Optional
| _ -> raise (InvalidStanza (element_to_string el))
+
in match feature.local_name with
| "mechanisms" -> {acc with mechanisms=parse_mechanisms feature.children}
| "starttls" -> {acc with starttls=parse_starttls feature.children}
| _ -> {acc with unknown = feature :: acc.unknown}
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