aboutsummaryrefslogtreecommitdiff
path: root/lib/stream.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stream.ml')
-rw-r--r--lib/stream.ml26
1 files changed, 26 insertions, 0 deletions
diff --git a/lib/stream.ml b/lib/stream.ml
index 141e2a5..aa2e2e7 100644
--- a/lib/stream.ml
+++ b/lib/stream.ml
@@ -44,3 +44,29 @@ let start domain : Portal.t Lwt.t =
(* TODO: check this is a good stanza *)
let+ _ = get stream
in stream, push
+
+let parse_features (el : Xml.element) : stream_features =
+ (** [parse_features el] is a [stream_features] record with all the features of the
+ [<stream:features>] stanza contained in [el]. *)
+ let open Xml in
+ let open Either in
+ let parse_mechanism_stanza = function
+ | Left {local_name = "mechanism"; children = [Right mechanism]; _} ->
+ Some (parse_auth_mechanism mechanism)
+ | _ -> None
+ in
+ let parse_feature (acc : stream_features) (feature : Xml.element) : stream_features =
+ let parse_mechanisms ch =
+ List.filter_map parse_mechanism_stanza 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 sasl_mechanisms=parse_mechanisms feature.children}
+ | "starttls" -> {acc with starttls=parse_starttls feature.children}
+ | _ -> {acc with unknown_features = feature :: acc.unknown_features}
+ in List.fold_left
+ parse_feature
+ {sasl_mechanisms=[]; starttls=`None; unknown_features=[]}
+ (List.filter_map find_left el.children)