feat(sasl): replace full jid with node part in SASL auth

sasl'ing with the full jid is not compliant (and works with ejabberd only)

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)