| 1 |
|
%%%---------------------------------------------------------------------- |
| 2 |
|
%%% File : cyrsasl_digest.erl |
| 3 |
|
%%% Author : Alexey Shchepin <alexey@sevcom.net> |
| 4 |
|
%%% Purpose : DIGEST-MD5 SASL mechanism |
| 5 |
|
%%% Created : 11 Mar 2003 by Alexey Shchepin <alexey@sevcom.net> |
| 6 |
|
%%% |
| 7 |
|
%%% |
| 8 |
|
%%% ejabberd, Copyright (C) 2002-2011 ProcessOne |
| 9 |
|
%%% |
| 10 |
|
%%% This program is free software; you can redistribute it and/or |
| 11 |
|
%%% modify it under the terms of the GNU General Public License as |
| 12 |
|
%%% published by the Free Software Foundation; either version 2 of the |
| 13 |
|
%%% License, or (at your option) any later version. |
| 14 |
|
%%% |
| 15 |
|
%%% This program is distributed in the hope that it will be useful, |
| 16 |
|
%%% but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 |
|
%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 18 |
|
%%% General Public License for more details. |
| 19 |
|
%%% |
| 20 |
|
%%% You should have received a copy of the GNU General Public License |
| 21 |
|
%%% along with this program; if not, write to the Free Software |
| 22 |
|
%%% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
| 23 |
|
%%% |
| 24 |
|
%%%---------------------------------------------------------------------- |
| 25 |
|
|
| 26 |
|
-module(cyrsasl_digest). |
| 27 |
|
-author('alexey@sevcom.net'). |
| 28 |
|
|
| 29 |
|
-export([mechanism/0, |
| 30 |
|
mech_new/3, |
| 31 |
|
mech_step/2]). |
| 32 |
|
|
| 33 |
|
-ignore_xref([mech_new/3]). |
| 34 |
|
|
| 35 |
|
-deprecated({'_', '_', next_major_release}). |
| 36 |
|
|
| 37 |
|
-include("mongoose.hrl"). |
| 38 |
|
|
| 39 |
|
-behaviour(cyrsasl). |
| 40 |
|
|
| 41 |
|
-record(state, {step :: integer(), |
| 42 |
|
nonce :: binary(), |
| 43 |
|
username :: jid:user() | undefined, |
| 44 |
|
authzid, |
| 45 |
|
auth_module :: ejabberd_auth:authmodule(), |
| 46 |
|
host :: jid:server(), |
| 47 |
|
creds :: mongoose_credentials:t() |
| 48 |
|
}). |
| 49 |
|
|
| 50 |
|
-type state() :: #state{}. |
| 51 |
|
|
| 52 |
|
-spec mechanism() -> cyrsasl:mechanism(). |
| 53 |
|
mechanism() -> |
| 54 |
:-( |
<<"DIGEST-MD5">>. |
| 55 |
|
|
| 56 |
|
-spec mech_new(Host :: jid:server(), |
| 57 |
|
Creds :: mongoose_credentials:t(), |
| 58 |
|
Socket :: term()) -> {ok, state()}. |
| 59 |
|
mech_new(Host, Creds, _Socket) -> |
| 60 |
:-( |
Text = <<"The DIGEST-MD5 authentication mechanism is deprecated and " |
| 61 |
|
" will be removed in the next release, please consider using" |
| 62 |
|
" any of the SCRAM-SHA methods or equivalent instead.">>, |
| 63 |
:-( |
mongoose_deprecations:log( |
| 64 |
|
{?MODULE, ?FUNCTION_NAME, ?FUNCTION_ARITY}, |
| 65 |
|
#{what => sasl_digest_md5_deprecated, text => Text}, |
| 66 |
|
[{log_level, warning}]), |
| 67 |
:-( |
{ok, #state{step = 1, |
| 68 |
|
nonce = mongoose_bin:gen_from_crypto(), |
| 69 |
|
host = Host, |
| 70 |
|
creds = Creds}}. |
| 71 |
|
|
| 72 |
|
-spec mech_step(State :: tuple(), ClientIn :: any()) -> R when |
| 73 |
|
R :: {ok, mongoose_credentials:t()} |
| 74 |
|
| cyrsasl:error(). |
| 75 |
|
mech_step(#state{step = 1, nonce = Nonce} = State, _) -> |
| 76 |
:-( |
{continue, |
| 77 |
|
<<"nonce=\"", Nonce/binary, "\",qop=\"auth\",charset=utf-8,algorithm=md5-sess">>, |
| 78 |
|
State#state{step = 3}}; |
| 79 |
|
mech_step(#state{step = 3, nonce = Nonce} = State, ClientIn) -> |
| 80 |
:-( |
case parse(ClientIn) of |
| 81 |
|
bad -> |
| 82 |
:-( |
{error, <<"bad-protocol">>}; |
| 83 |
|
KeyVals -> |
| 84 |
:-( |
authorize_if_uri_valid(State, KeyVals, Nonce) |
| 85 |
|
end; |
| 86 |
|
mech_step(#state{step = 5, |
| 87 |
|
auth_module = AuthModule, |
| 88 |
|
username = UserName, |
| 89 |
|
authzid = AuthzId, |
| 90 |
|
creds = Creds}, <<>>) -> |
| 91 |
:-( |
{ok, mongoose_credentials:extend(Creds, [{username, UserName}, |
| 92 |
|
{authzid, AuthzId}, |
| 93 |
|
{auth_module, AuthModule}])}; |
| 94 |
|
mech_step(State, Msg) -> |
| 95 |
:-( |
?LOG_DEBUG(#{what => sasl_digest_error_bad_protocol, sasl_state => State, message => Msg}), |
| 96 |
:-( |
{error, <<"bad-protocol">>}. |
| 97 |
|
|
| 98 |
|
|
| 99 |
|
authorize_if_uri_valid(State, KeyVals, Nonce) -> |
| 100 |
:-( |
UserName = xml:get_attr_s(<<"username">>, KeyVals), |
| 101 |
:-( |
DigestURI = xml:get_attr_s(<<"digest-uri">>, KeyVals), |
| 102 |
:-( |
case is_digesturi_valid(DigestURI, State#state.host) of |
| 103 |
|
false -> |
| 104 |
:-( |
?LOG_DEBUG(#{what => unauthorized_login, reason => invalid_digest_uri, |
| 105 |
:-( |
message => DigestURI, user => UserName}), |
| 106 |
:-( |
{error, <<"not-authorized">>, UserName}; |
| 107 |
|
true -> |
| 108 |
:-( |
maybe_authorize(UserName, KeyVals, Nonce, State) |
| 109 |
|
end. |
| 110 |
|
|
| 111 |
|
maybe_authorize(UserName, KeyVals, Nonce, State) -> |
| 112 |
:-( |
AuthzId = xml:get_attr_s(<<"authzid">>, KeyVals), |
| 113 |
:-( |
LServer = mongoose_credentials:lserver(State#state.creds), |
| 114 |
:-( |
HostType = mongoose_credentials:host_type(State#state.creds), |
| 115 |
:-( |
JID = jid:make_bare(UserName, LServer), |
| 116 |
:-( |
case ejabberd_auth:get_passterm_with_authmodule(HostType, JID) of |
| 117 |
|
false -> |
| 118 |
:-( |
{error, <<"not-authorized">>, UserName}; |
| 119 |
|
{Passwd, AuthModule} -> |
| 120 |
:-( |
DigestGen = fun(PW) -> response(KeyVals, UserName, PW, Nonce, AuthzId, |
| 121 |
|
<<"AUTHENTICATE">>) |
| 122 |
|
end, |
| 123 |
:-( |
ExtraCreds = [{username, UserName}, |
| 124 |
|
{password, <<>>}, |
| 125 |
|
{digest, xml:get_attr_s(<<"response">>, KeyVals)}, |
| 126 |
|
{digest_gen, DigestGen}], |
| 127 |
:-( |
Request = mongoose_credentials:extend(State#state.creds, ExtraCreds), |
| 128 |
:-( |
do_authorize(UserName, KeyVals, Nonce, Passwd, Request, AuthzId, AuthModule, State) |
| 129 |
|
end. |
| 130 |
|
|
| 131 |
|
do_authorize(UserName, KeyVals, Nonce, Passwd, Request, AuthzId, AuthModule, State) -> |
| 132 |
:-( |
case ejabberd_auth:authorize(Request) of |
| 133 |
|
{ok, Result} -> |
| 134 |
:-( |
RspAuth = response(KeyVals, |
| 135 |
|
UserName, Passwd, |
| 136 |
|
Nonce, AuthzId, <<>>), |
| 137 |
:-( |
{continue, |
| 138 |
|
list_to_binary([<<"rspauth=">>, RspAuth]), |
| 139 |
|
State#state{step = 5, |
| 140 |
|
auth_module = AuthModule, |
| 141 |
|
username = UserName, |
| 142 |
|
authzid = AuthzId, |
| 143 |
|
creds = Result}}; |
| 144 |
|
{error, not_authorized} -> |
| 145 |
:-( |
{error, <<"not-authorized">>, UserName} |
| 146 |
|
end. |
| 147 |
|
|
| 148 |
|
-spec parse(binary()) -> 'bad' | [{binary(), binary()}]. |
| 149 |
|
parse(S) -> |
| 150 |
:-( |
parse1(S, <<>>, []). |
| 151 |
|
|
| 152 |
|
parse1(<<$=, Cs/binary>>, S, Ts) -> |
| 153 |
:-( |
parse2(Cs, binary_reverse(S), <<>>, Ts); |
| 154 |
|
parse1(<<$,, Cs/binary>>, <<>>, Ts) -> |
| 155 |
:-( |
parse1(Cs, <<>>, Ts); |
| 156 |
|
parse1(<<$\s, Cs/binary>>, <<>>, Ts) -> |
| 157 |
:-( |
parse1(Cs, <<>>, Ts); |
| 158 |
|
parse1(<<C, Cs/binary>>, S, Ts) -> |
| 159 |
:-( |
parse1(Cs, <<C, S/binary>>, Ts); |
| 160 |
|
parse1(<<>>, <<>>, T) -> |
| 161 |
:-( |
lists:reverse(T); |
| 162 |
|
parse1(<<>>, _S, _T) -> |
| 163 |
:-( |
bad. |
| 164 |
|
|
| 165 |
|
parse2(<<$\", Cs/binary>>, Key, Val, Ts) -> |
| 166 |
:-( |
parse3(Cs, Key, Val, Ts); |
| 167 |
|
parse2(<<C, Cs/binary>>, Key, Val, Ts) -> |
| 168 |
:-( |
parse4(Cs, Key, <<C, Val/binary>>, Ts); |
| 169 |
|
parse2(<<>>, _, _, _) -> |
| 170 |
:-( |
bad. |
| 171 |
|
|
| 172 |
|
parse3(<<$\", Cs/binary>>, Key, Val, Ts) -> |
| 173 |
:-( |
parse4(Cs, Key, Val, Ts); |
| 174 |
|
parse3(<<$\\, C, Cs/binary>>, Key, Val, Ts) -> |
| 175 |
:-( |
parse3(Cs, Key, <<C, Val/binary>>, Ts); |
| 176 |
|
parse3(<<C, Cs/binary>>, Key, Val, Ts) -> |
| 177 |
:-( |
parse3(Cs, Key, <<C, Val/binary>>, Ts); |
| 178 |
|
parse3(<<>>, _, _, _) -> |
| 179 |
:-( |
bad. |
| 180 |
|
|
| 181 |
|
-spec parse4(binary(), |
| 182 |
|
Key :: binary(), |
| 183 |
|
Val :: binary(), |
| 184 |
|
Ts :: [{binary(), binary()}]) -> 'bad' | [{K :: binary(), V :: binary()}]. |
| 185 |
|
parse4(<<$,, Cs/binary>>, Key, Val, Ts) -> |
| 186 |
:-( |
parse1(Cs, <<>>, [{Key, binary_reverse(Val)} | Ts]); |
| 187 |
|
parse4(<<$\s, Cs/binary>>, Key, Val, Ts) -> |
| 188 |
:-( |
parse4(Cs, Key, Val, Ts); |
| 189 |
|
parse4(<<C, Cs/binary>>, Key, Val, Ts) -> |
| 190 |
:-( |
parse4(Cs, Key, <<C, Val/binary>>, Ts); |
| 191 |
|
parse4(<<>>, Key, Val, Ts) -> |
| 192 |
:-( |
parse1(<<>>, <<>>, [{Key, binary_reverse(Val)} | Ts]). |
| 193 |
|
|
| 194 |
|
binary_reverse(<<>>) -> |
| 195 |
:-( |
<<>>; |
| 196 |
|
binary_reverse(<<H, T/binary>>) -> |
| 197 |
:-( |
<<(binary_reverse(T))/binary, H>>. |
| 198 |
|
|
| 199 |
|
%% @doc Check if the digest-uri is valid. |
| 200 |
|
%% RFC-2831 allows to provide the IP address in Host, |
| 201 |
|
%% however ejabberd doesn't allow that. |
| 202 |
|
%% If the service (for example jabber.example.org) |
| 203 |
|
%% is provided by several hosts (being one of them server3.example.org), |
| 204 |
|
%% then digest-uri can be like xmpp/server3.example.org/jabber.example.org |
| 205 |
|
%% In that case, ejabberd only checks the service name, not the host. |
| 206 |
|
-spec is_digesturi_valid(DigestURICase :: binary(), |
| 207 |
|
JabberHost :: 'undefined' | jid:server()) -> boolean(). |
| 208 |
|
is_digesturi_valid(DigestURICase, JabberHost) -> |
| 209 |
:-( |
DigestURI = jid:str_tolower(DigestURICase), |
| 210 |
:-( |
case catch binary:split(DigestURI, <<"/">>) of |
| 211 |
|
[<<"xmpp">>, Host] when Host == JabberHost -> |
| 212 |
:-( |
true; |
| 213 |
|
[<<"xmpp">>, _Host, ServName] when ServName == JabberHost -> |
| 214 |
:-( |
true; |
| 215 |
|
_ -> |
| 216 |
:-( |
false |
| 217 |
|
end. |
| 218 |
|
|
| 219 |
|
|
| 220 |
|
-spec digit_to_xchar(byte()) -> char(). |
| 221 |
|
digit_to_xchar(D) when (D >= 0) and (D < 10) -> |
| 222 |
:-( |
D + 48; |
| 223 |
|
digit_to_xchar(D) -> |
| 224 |
:-( |
D + 87. |
| 225 |
|
|
| 226 |
|
-spec hex(binary()) -> binary(). |
| 227 |
|
hex(S) -> |
| 228 |
:-( |
hex(S, <<>>). |
| 229 |
|
|
| 230 |
|
-spec hex(binary(), binary()) -> binary(). |
| 231 |
|
hex(<<>>, Res) -> |
| 232 |
:-( |
binary_reverse(Res); |
| 233 |
|
hex(<<N, Ns/binary>>, Res) -> |
| 234 |
:-( |
D1 = digit_to_xchar(N rem 16), |
| 235 |
:-( |
D2 = digit_to_xchar(N div 16), |
| 236 |
:-( |
hex(Ns, <<D1, D2, Res/binary>>). |
| 237 |
|
|
| 238 |
|
|
| 239 |
|
-spec response(KeyVals :: [{binary(), binary()}], |
| 240 |
|
User :: jid:user(), |
| 241 |
|
Passwd :: binary(), |
| 242 |
|
Nonce :: binary(), |
| 243 |
|
AuthzId :: binary(), |
| 244 |
|
A2Prefix :: <<_:_*96>>) -> binary(). |
| 245 |
|
response(KeyVals, User, Passwd, Nonce, AuthzId, A2Prefix) -> |
| 246 |
:-( |
Realm = xml:get_attr_s(<<"realm">>, KeyVals), |
| 247 |
:-( |
CNonce = xml:get_attr_s(<<"cnonce">>, KeyVals), |
| 248 |
:-( |
DigestURI = xml:get_attr_s(<<"digest-uri">>, KeyVals), |
| 249 |
:-( |
NC = xml:get_attr_s(<<"nc">>, KeyVals), |
| 250 |
:-( |
QOP = xml:get_attr_s(<<"qop">>, KeyVals), |
| 251 |
:-( |
A1 = case AuthzId of |
| 252 |
|
<<>> -> |
| 253 |
:-( |
list_to_binary( |
| 254 |
|
[crypto:hash(md5, [User, <<":">>, Realm, <<":">>, Passwd]), |
| 255 |
|
<<":">>, Nonce, <<":">>, CNonce]); |
| 256 |
|
_ -> |
| 257 |
:-( |
list_to_binary( |
| 258 |
|
[crypto:hash(md5, [User, <<":">>, Realm, <<":">>, Passwd]), |
| 259 |
|
<<":">>, Nonce, <<":">>, CNonce, <<":">>, AuthzId]) |
| 260 |
|
end, |
| 261 |
:-( |
A2 = case QOP of |
| 262 |
|
<<"auth">> -> |
| 263 |
:-( |
[A2Prefix, <<":">>, DigestURI]; |
| 264 |
|
_ -> |
| 265 |
:-( |
[A2Prefix, <<":">>, DigestURI, |
| 266 |
|
<<":00000000000000000000000000000000">>] |
| 267 |
|
end, |
| 268 |
:-( |
T = [hex(crypto:hash(md5, A1)), <<":">>, Nonce, <<":">>, |
| 269 |
|
NC, <<":">>, CNonce, <<":">>, QOP, <<":">>, |
| 270 |
|
hex(crypto:hash(md5, A2))], |
| 271 |
:-( |
hex(crypto:hash(md5, T)). |