diff options
| -rw-r--r-- | lib/sasl.ml | 11 | ||||
| -rw-r--r-- | lib/stream.ml | 12 | ||||
| -rw-r--r-- | test/hello.ml | 2 |
3 files changed, 12 insertions, 13 deletions
diff --git a/lib/sasl.ml b/lib/sasl.ml index 4bd80cc..137d84a 100644 --- a/lib/sasl.ml +++ b/lib/sasl.ml @@ -1,5 +1,8 @@ open Lwt.Infix -open Stream + +type auth_mechanism = + | PLAIN + | Unknown of string [@@deriving show { with_path = false }] type auth_config = { jid : string; @@ -15,6 +18,10 @@ let unrecoverable = function | NotAuthorized -> true | _ -> false +let parse_auth_mechanism = function + | "PLAIN" -> PLAIN + | other -> Unknown other + let parse_sasl_error = function | "not-authorized" -> NotAuthorized | "malformed-request" -> MalformedRequest @@ -58,7 +65,7 @@ let send_auth_stanza (stream, push) localpart pass mechanism = let authenticate (portal : Portal.t) ({jid; password; preferred_mechanisms} : auth_config) - (sasl_mechanisms : Stream.auth_mechanism list) = + (sasl_mechanisms : 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 diff --git a/lib/stream.ml b/lib/stream.ml index 607319d..e3ed62f 100644 --- a/lib/stream.ml +++ b/lib/stream.ml @@ -1,15 +1,7 @@ exception ClosedStream -type auth_mechanism = - | PLAIN - | Unknown of string [@@deriving show { with_path = false }] - -let parse_auth_mechanism = function - | "PLAIN" -> PLAIN - | other -> Unknown other - type features = { - mechanisms : auth_mechanism list; + mechanisms : Sasl.auth_mechanism list; starttls : [`Required | `Optional | `None]; unknown : Xml.element list; } @@ -21,7 +13,7 @@ let parse_features (el : Xml.element) : features = let open Either in let parse_mechanism_stanza = function | Left {local_name = "mechanism"; children = [Right mechanism]; _} -> - Some (parse_auth_mechanism mechanism) + Some (Sasl.parse_auth_mechanism mechanism) | _ -> None in let parse_feature (acc : features) (feature : Xml.element) : features = diff --git a/test/hello.ml b/test/hello.ml index 392c3a1..1975871 100644 --- a/test/hello.ml +++ b/test/hello.ml @@ -16,7 +16,7 @@ let main = let config : Sasl.auth_config = { jid = (Sys.getenv "FLESH_JID"); password = (Sys.getenv "FLESH_PASSWORD"); - preferred_mechanisms = [Stream.PLAIN] + preferred_mechanisms = [Sasl.PLAIN] } in let domain = (List.nth (String.split_on_char '@' config.jid) 1) in let* stream, push = Portal.connect domain in |