diff options
| -rw-r--r-- | lib/sasl.ml | 4 | ||||
| -rw-r--r-- | test/js/websockets_hello.ml | 16 |
2 files changed, 13 insertions, 7 deletions
diff --git a/lib/sasl.ml b/lib/sasl.ml index 606beb6..5a0dd80 100644 --- a/lib/sasl.ml +++ b/lib/sasl.ml @@ -13,9 +13,9 @@ let read_sasl_error = function type sasl_auth = (string option, sasl_error * (string * string) option) result -let send_auth_stanza (stream, push) jid pass mechanism = +let send_auth_stanza (stream, push) localpart pass mechanism = let gen_auth = function - | PLAIN -> Base64.encode_exn ("\x00" ^ jid ^ "\x00" ^ pass) + | PLAIN -> Base64.encode_exn ("\x00" ^ localpart ^ "\x00" ^ pass) and parse_sasl_response stanza = let open Markup in let parse_additional_info = function diff --git a/test/js/websockets_hello.ml b/test/js/websockets_hello.ml index 6882c5b..d417e62 100644 --- a/test/js/websockets_hello.ml +++ b/test/js/websockets_hello.ml @@ -16,23 +16,29 @@ let rec run t = then next_tick (fun () -> run t) else () -let main (stream, push) jid password = +let main (stream, push) localpart password = let* _stream = Lwt_stream.get stream in let+ _auth = Sasl.send_auth_stanza (stream, push) - jid password + localpart password Sasl.PLAIN in push None; match _auth with | Error (NotAuthorized, Some (_, text)) -> print_endline ("Not authorized: " ^ text) | Error (MalformedRequest, Some (_, text)) -> print_endline ("Malformed request: " ^ text) - | _ -> () + | Error _ -> print_endline "Error!" + | Ok _ -> print_endline "Success!" let () = run @@ let jid = (Sys.getenv "EXAMPLE_JID") and password = (Sys.getenv "EXAMPLE_PASSWORD") - in let domain = (List.nth (String.split_on_char '@' jid) 1) in + in + (* Probably not exactly compliant with https://xmpp.org/extensions/xep-0029.html, + but it's just for simplicity's sake in the testing. *) + let domain = (List.nth (String.split_on_char '@' jid) 1) + and localpart = (List.nth (String.split_on_char '@' jid) 0) + in let* stream, push = Stream.start domain in Lwt.catch - (fun () -> main (stream, push) jid password) + (fun () -> main (stream, push) localpart password) (fun exn -> push None; Lwt.fail exn) |