diff options
| -rw-r--r-- | lib/stream.ml | 26 |
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) |