integrate lxmppc into escalus

.gitignore

@@ -6,3 +6,4 @@ tags
 deps
 .eunit
 rebar
+test/*.beam

.travis.yml

@@ -0,0 +1,9 @@
+language: erlang
+branches:
+        only:
+                - master
+notifications:
+        email: [email protected]
+env:
+        - R14B03
+        - R14B02

include/escalus.hrl

@@ -18,3 +18,16 @@
         jid :: binary(),
         conn :: any()
 }).
+
+-record(jid, {
+        user :: binary(),
+        server :: binary(),
+        resource = <<"">> :: binary()}).
+
+-record(transport, {
+        module :: atom(),
+        socket :: term(),
+        ssl :: boolean(),
+        compress :: {zlib, {Zin::zlib:zstream(), Zout::zlib:zstream()}}
+                 |  false,
+        rcv_pid :: pid()}).

rebar.config

@@ -4,5 +4,7 @@
 {require_otp_vsn, "R1[45]"}.
 
 {deps, [
-    {lxmppc, ".*", {git, "git://github.com/esl/lxmppc.git", {branch, "master"}}}
+    {exml, ".*", {git, "git://github.com/esl/exml.git", {branch, "master"}}},
+    {base16, ".*", {git, "git://github.com/goj/base16.git", {branch, "master"}}},
+    {lhttpc, ".*", {git, "git://github.com/esl/lhttpc.git", {branch, "master"}}}
 ]}.

run_ct

@@ -1,2 +1,2 @@
 #!/bin/bash
-ct_run -config test/test.config -logdir logs -dir test -erl_args -pa $PWD/ebin $PWD/deps/lxmppc/ebin $PWD/deps/exml/ebin
+ct_run -config test/test.config -logdir logs -dir test -erl_args -pa $PWD/ebin $PWD/deps/exml/ebin

src/csvkv.erl

@@ -0,0 +1,72 @@
+%%%===================================================================
+%%% @copyright (C) 2012, Erlang Solutions Ltd.
+%%% @doc Module for parsing DIGEST-MD5 - style k1=v1,k2="v2" content
+%%% @end
+%%%===================================================================
+
+-module(csvkv).
+-export([parse/1, format/1]).
+
+%%--------------------------------------------------------------------
+%% Public API
+%%--------------------------------------------------------------------
+
+-spec parse(binary()) -> [{binary(), binary()}].
+parse(Text) ->
+    do_parse(rev_lex(Text, []), []).
+
+-spec format([{binary(), binary()}]) -> binary().
+format(Items) ->
+    IOList = join([format_item(I) || I <- Items], $,),
+    list_to_binary(IOList).
+
+%%--------------------------------------------------------------------
+%% Implementation
+%%--------------------------------------------------------------------
+
+%% note: lexemes are in reverse order
+do_parse([{v, V}, {k, K} | Rest], Acc) ->
+    do_parse(Rest, [{K, V} | Acc]);
+do_parse([], Acc) ->
+    Acc.
+
+%% note: returns lexemes in reverse order
+rev_lex(<<>>, Acc) ->
+    Acc;
+rev_lex(Text, Acc) ->
+    rev_lex_key(Text, Acc).
+
+rev_lex_key(Text, Acc) ->
+    [Key, Rest] = binary:split(Text, <<"=">>),
+    rev_lex_value(Rest, [{k, Key} | Acc]).
+
+rev_lex_value(<<"\"", Text/binary>>, Acc) ->
+    rev_lex_value_quoted(Text, <<>>, Acc);
+rev_lex_value(Text, Acc) ->
+    rev_lex_value_bare(Text, Acc).
+
+rev_lex_value_quoted(<<"\\\"",T/binary>>, Val, Acc) ->
+    rev_lex_value_quoted(T, <<Val/binary,"\"">>, Acc);
+rev_lex_value_quoted(<<"\",",T/binary>>, Val, Acc) ->
+    rev_lex(T, [{v, Val} | Acc]);
+rev_lex_value_quoted(<<"\"",T/binary>>, Val, Acc) ->
+    rev_lex(T, [{v, Val} | Acc]);
+rev_lex_value_quoted(<<H,T/binary>>, Val, Acc) ->
+    rev_lex_value_quoted(T, <<Val/binary,H>>, Acc).
+
+rev_lex_value_bare(Text, Acc) ->
+    case binary:split(Text, <<",">>) of
+        [Val, Rest] ->
+            rev_lex(Rest, [{v, Val} | Acc]);
+        [Val] ->
+            rev_lex(<<>>, [{v, Val} | Acc])
+    end.
+
+join([], _) ->
+    [];
+join(Items, Sep) ->
+    tl(lists:append([[Sep, I] || I <- Items])).
+
+format_item({Key, Val}) ->
+    EscVal = re:replace(Val, "\"", "\\\"", [global]),
+    [Key, $=, $", EscVal, $"].

src/escalus.erl

@@ -46,7 +46,6 @@ suite() ->
 
 init_per_suite(Config) ->
     application:start(exml),
-    application:start(lxmppc),
     Config.
 
 end_per_suite(_Config) ->

src/escalus_auth.erl

@@ -0,0 +1,127 @@
+%%%===================================================================
+%%% @copyright (C) 2012, Erlang Solutions Ltd.
+%%% @doc Module supporting various authentication mechanisms
+%%% @end
+%%%===================================================================
+-module(escalus_auth).
+
+%% Public APi
+-export([auth_plain/2,
+         auth_digest_md5/2,
+         auth_sasl_anon/2]).
+
+%% Useful helpers for writing own mechanisms
+-export([get_challenge/2,
+         wait_for_success/2]).
+
+-include_lib("exml/include/exml.hrl").
+
+%%--------------------------------------------------------------------
+%% Public API
+%%--------------------------------------------------------------------
+
+auth_plain(Conn, Props) ->
+    Username = get_property(username, Props),
+    Password = get_property(password, Props),
+    Payload = <<0:8,Username/binary,0:8,Password/binary>>,
+    Stanza = escalus_stanza:auth_stanza(<<"PLAIN">>, base64_cdata(Payload)),
+    ok = escalus_connection:send(Conn, Stanza),
+    wait_for_success(Username, Conn).
+
+auth_digest_md5(Conn, Props) ->
+    ok = escalus_connection:send(Conn, escalus_stanza:auth_stanza(<<"DIGEST-MD5">>, [])),
+    ChallengeData = get_challenge(Conn, challenge1),
+    Response = md5_digest_response(ChallengeData, Props),
+    ResponseStanza1 = escalus_stanza:auth_response_stanza([Response]),
+    ok = escalus_connection:send(Conn, ResponseStanza1),
+    [{<<"rspauth">>, _}] = get_challenge(Conn, challenge2), %% TODO: validate
+    ResponseStanza2 = escalus_stanza:auth_response_stanza([]),
+    ok = escalus_connection:send(Conn, ResponseStanza2),
+    wait_for_success(get_property(username, Props), Conn).
+
+auth_sasl_anon(Conn, Props) ->
+    Stanza = escalus_stanza:auth_stanza(<<"ANONYMOUS">>, []),
+    ok = escalus_connection:send(Conn, Stanza),
+    wait_for_success(get_property(username, Props), Conn).
+
+
+%%--------------------------------------------------------------------
+%% Helpers - implementation
+%%--------------------------------------------------------------------
+
+md5_digest_response(ChallengeData, Props) ->
+    %% Digest calculated via description at
+    %% http://web.archive.org/web/20050224191820/http://cataclysm.cx/wip/digest-hex_md5-crash.html
+    Username = get_property(username, Props),
+    Password = get_property(password, Props),
+    Server = get_property(server, Props),
+    Resource = get_property(resource, Props),
+    Nonce = get_property(<<"nonce">>, ChallengeData),
+    CNonce = base16:encode(crypto:rand_bytes(16)),
+    Realm = proplists:get_value(<<"realm">>, ChallengeData, <<>>),
+    QOP = get_property(<<"qop">>, ChallengeData),
+    NC = <<"00000001">>,
+    ServType = <<"xmpp">>,
+    DigestUri = <<"xmpp/", Server/binary>>,
+    FullJid = <<Username/binary, "@", Server/binary, "/", Resource/binary>>,
+
+    Y = crypto:md5([Username, $:, Realm, $:, Password]),
+    HA1 = hex_md5([Y, $:, Nonce, $:, CNonce, $:, FullJid]),
+    HA2 = hex_md5([<<"AUTHENTICATE:">>, DigestUri]),
+
+    %% Digest is the Z from the description above
+    Digest = hex_md5([HA1, $:, Nonce, $:, NC, $:, CNonce, $:, QOP, $:, HA2]),
+
+    base64_cdata(csvkv:format([
+        {<<"username">>, Username},
+        {<<"nonce">>, Nonce},
+        {<<"nc">>, NC},
+        {<<"cnonce">>, CNonce},
+        {<<"qop">>, QOP},
+        {<<"serv-type">>, ServType},
+        {<<"host">>, Server},
+        {<<"digest-uri">>, DigestUri},
+        {<<"response">>, Digest},
+        {<<"charset">>, <<"utf-8">>},
+        {<<"authzid">>, FullJid}
+    ])).
+
+hex_md5(Data) ->
+    base16:encode(crypto:md5(Data)).
+
+%%--------------------------------------------------------------------
+%% Helpers - actions
+%%--------------------------------------------------------------------
+
+get_challenge(Conn, Descr) ->
+    Challenge = escalus_connection:get_stanza(Conn, Descr),
+    case Challenge of
+        #xmlelement{name = <<"challenge">>, children=[CData]} ->
+            csvkv:parse(base64:decode(exml:unescape_cdata(CData)));
+        _ ->
+            throw({expected_challenge, got, Challenge})
+    end.
+
+wait_for_success(Username, Conn) ->
+    AuthReply = escalus_connection:get_stanza(Conn, auth_reply),
+    case AuthReply#xmlelement.name of
+        <<"success">> ->
+            ok;
+        <<"failure">> ->
+            throw({auth_failed, Username, AuthReply})
+    end.
+
+get_property(PropName, Proplist) ->
+    case lists:keyfind(PropName, 1, Proplist) of
+        {PropName, Value} ->
+            Value;
+        false ->
+            throw({missing_property, PropName})
+    end.
+
+%%--------------------------------------------------------------------
+%% Helpers
+%%--------------------------------------------------------------------
+
+base64_cdata(Payload) ->
+    #xmlcdata{content=base64:encode(Payload)}.