diff options
author | Clombrong <cromblong@egregore.fun> | 2025-06-26 17:09:20 +0200 |
---|---|---|
committer | Clombrong <cromblong@egregore.fun> | 2025-06-26 21:40:53 +0200 |
commit | 38b332a6c3940c3156b27b88e15e9735bebce718 (patch) | |
tree | b8c3cacfe0f81d879328dafefb442e446a8fae73 /lib | |
parent | fada25b1563d3d1da08da3ce8c47fa5b820cfbd8 (diff) |
refactor(sasl): handle stream features outside of authenticate
Diffstat (limited to 'lib')
-rw-r--r-- | lib/sasl.ml | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/lib/sasl.ml b/lib/sasl.ml index 2241a91..4bd80cc 100644 --- a/lib/sasl.ml +++ b/lib/sasl.ml @@ -1,4 +1,3 @@ -open Lwt.Syntax open Lwt.Infix open Stream @@ -56,28 +55,29 @@ let send_auth_stanza (stream, push) localpart pass mechanism = try Xml.get stream >|= parse_sasl_response with exn -> Lwt.fail exn -let authenticate (portal : Portal.t) ({jid; password; preferred_mechanisms} : auth_config) = +let authenticate + (portal : Portal.t) + ({jid; password; preferred_mechanisms} : auth_config) + (sasl_mechanisms : Stream.auth_mechanism list) = (* Probably not exactly compliant with https://xmpp.org/extensions/xep-0029.html, but it's just for simplicity's sake in alpha. *) let localpart = match String.split_on_char '@' jid with | [localpart; _domain] -> localpart | _ -> failwith "Invalid JID" + and preferred, not_preferred = + List.partition (fun f -> List.exists ((=) f) preferred_mechanisms) sasl_mechanisms in - let* {mechanisms; _} = Xml.get (fst portal) >|= Stream.parse_features - in let preferred, not_preferred = - List.partition (fun f -> List.exists ((=) f) preferred_mechanisms) mechanisms - in - (* Function that takes a [sasl_auth] and returns whether this attempt should be - retried, or is definitive (e.g, success or bad credentials). *) - let definitive = function - | Ok _ -> true - | Error (sasl, _) -> unrecoverable sasl - in let try_auth acc sasl = - if definitive acc - then Lwt.return acc - else (send_auth_stanza portal localpart password sasl) + (* Function that takes a [sasl_auth] and returns whether this attempt should be + retried, or is definitive (e.g, success or bad credentials). *) + let definitive = function + | Ok _ -> true + | Error (sasl, _) -> unrecoverable sasl + in let try_auth acc sasl = + if definitive acc + then Lwt.return acc + else (send_auth_stanza portal localpart password sasl) in Lwt_seq.of_list (preferred @ not_preferred) - (* This is a particularly shameful hack: This auth will always be retried. + (* This is a particularly shameful hack: This auth result will always be retried. TODO: make something less unstable. *) |> Lwt_seq.fold_left_s try_auth (Error (MalformedRequest, None)) |