blob: d97a8cb58d039342c6c88428aed181d7a4ebb9ea (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
type auth_mechanism = PLAIN [@@deriving show { with_path = false }]
type sasl_error =
| NotAuthorized
let read_sasl_error = function
| "not-authorized" -> NotAuthorized
| _ -> failwith "Unsupported SASL error returned by the server."
let send_auth_stanza (stream, push) jid pass mechanism =
let gen_auth = function
| PLAIN -> Base64.encode_exn ("\x00" ^ jid ^ "\x00" ^ pass)
in let xmlns = "urn:ietf:params:xml:ns:xmpp-sasl" in
let stanza_list = [`Start_element
((xmlns, "auth"),
[(("", "xmlns"), xmlns);
(("", "mechanism"), show_auth_mechanism mechanism)]);
`Text [gen_auth mechanism];
`End_element]
in Markup.(stanza_list |> of_list |> write_xml |> to_string) |> Option.some |> push;
(* TODO: use stream result for exceptions, etc. *)
Lwt_stream.get stream
|
