diff options
Diffstat (limited to 'lib/stream.ml')
| -rw-r--r-- | lib/stream.ml | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/lib/stream.ml b/lib/stream.ml index 0b600a7..2c6bf37 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -47,7 +47,7 @@ let negotiate ?(prefer_starttls = true) (domain : string) (portal : Portal.t) - (_auth : Sasl.auth_config) : features Lwt.t = + (auth : Sasl.auth_config) : features Lwt.t = (* Restart a stream: Send the usual business, ask for features. *) let start_stream () : features Lwt.t = let* _id = Portal.header domain portal @@ -58,7 +58,15 @@ let negotiate | `Optional, false | `None, _ -> Lwt.return features | `Optional, true | `Required, _-> Starttls.upgrade portal >>= start_stream - in start_stream () >>= starttls + in + let sasl_auth features = + let* auth_result = Sasl.authenticate portal auth features.mechanisms in + match auth_result with + | Error (NotAuthorized, Some (_, text)) -> Lwt.fail_with ("Not authorized: " ^ text) + | Error (MalformedRequest, Some (_, text)) -> Lwt.fail_with ("Malformed request: " ^ text) + | Error _ -> Lwt.fail_with "Unknown error!" + | Ok _ -> print_endline "Success!"; start_stream () + in start_stream () >>= starttls >>= sasl_auth (** [initiate domain] initiates a stream with the XMPP server [domain]. |