New SASL authentication method: SCRAM-SHA-1 (thanks to Stephen Röttger)(EJAB-1196)

17 files changed, 600 insertions, 40 deletions

diff --git a/src/cyrsasl.erl b/src/cyrsasl.erl
index 94df55fe0..fcfc2456a 100644
--- a/src/cyrsasl.erl
+++ b/src/cyrsasl.erl
@@ -43,7 +43,7 @@
 %%     Require_Plain = bool().
 %% Registry entry of a supported SASL mechanism.
 
--record(sasl_mechanism, {mechanism, module, require_plain_password}).
+-record(sasl_mechanism, {mechanism, module, password_type}).
 
 %% @type saslstate() = {sasl_state, Service, Myname, Realm, GetPassword, CheckPassword, CheckPasswordDigest, Mech_Mod, Mech_State}
 %%     Service = string()
@@ -76,6 +76,7 @@ start() ->
 			     {keypos, #sasl_mechanism.mechanism}]),
     cyrsasl_plain:start([]),
     cyrsasl_digest:start([]),
+    cyrsasl_scram:start([]),
     cyrsasl_anonymous:start([]),
     maybe_try_start_gssapi(),
     ok.
@@ -101,11 +102,11 @@ try_start_gssapi() ->
 %%     Module = atom()
 %%     Require_Plain = bool()
 
-register_mechanism(Mechanism, Module, RequirePlainPassword) ->
+register_mechanism(Mechanism, Module, PasswordType) ->
     ets:insert(sasl_mechanism,
 	       #sasl_mechanism{mechanism = Mechanism,
 			       module = Module,
-			       require_plain_password = RequirePlainPassword}).
+			       password_type = PasswordType}).
 
 % TODO use callbacks
 %-include("ejabberd.hrl").
@@ -153,17 +154,20 @@ check_credentials(_State, Props) ->
 %%     Mechanism = string()
 
 listmech(Host) ->
-    RequirePlainPassword = ejabberd_auth:plain_password_required(Host),
-
     Mechs = ets:select(sasl_mechanism,
 		       [{#sasl_mechanism{mechanism = '$1',
-					 require_plain_password = '$2',
+					 password_type = '$2',
 					 _ = '_'},
-			 if
-			     RequirePlainPassword ->
-				 [{'==', '$2', false}];
-			     true ->
-				 []
+			 case catch ejabberd_auth:store_type(Host) of
+			 external ->
+			      [{'==', '$2', plain}];
+			 scram ->
+			      [{'/=', '$2', digest}];
+			 {'EXIT',{undef,[{Module,store_type,[]} | _]}} ->
+			      ?WARNING_MSG("~p doesn't implement the function store_type/0", [Module]),
+			      [];
+			 _Else ->
+			      []
 			 end,
 			 ['$1']}]),
     filter_anonymous(Host, Mechs).
@@ -252,6 +256,13 @@ server_step(State, ClientIn) ->
 		{error, Error} ->
 		    {error, Error}
 	    end;
+	{ok, Props, ServerOut} ->
+	    case check_credentials(State, Props) of
+		ok ->
+		    {ok, Props, ServerOut};
+		{error, Error} ->
+		    {error, Error}
+	    end;
 	{continue, ServerOut, NewMechState} ->
 	    {continue, ServerOut,
 	     State#sasl_state{mech_state = NewMechState}};
diff --git a/src/cyrsasl_anonymous.erl b/src/cyrsasl_anonymous.erl
index 555ace892..e65cf2d31 100644
--- a/src/cyrsasl_anonymous.erl
+++ b/src/cyrsasl_anonymous.erl
@@ -42,7 +42,7 @@
 %%     Opts = term()
 
 start(_Opts) ->
-    cyrsasl:register_mechanism("ANONYMOUS", ?MODULE, false),
+    cyrsasl:register_mechanism("ANONYMOUS", ?MODULE, plain),
     ok.
 
 %% @spec () -> ok
diff --git a/src/cyrsasl_digest.erl b/src/cyrsasl_digest.erl
index 92658f554..e8f0488f2 100644
--- a/src/cyrsasl_digest.erl
+++ b/src/cyrsasl_digest.erl
@@ -53,7 +53,7 @@
 %%     Opts = term()
 
 start(_Opts) ->
-    cyrsasl:register_mechanism("DIGEST-MD5", ?MODULE, true).
+    cyrsasl:register_mechanism("DIGEST-MD5", ?MODULE, digest).
 
 %% @spec () -> ok
 
diff --git a/src/cyrsasl_plain.erl b/src/cyrsasl_plain.erl
index 7b529d210..4d5176dc0 100644
--- a/src/cyrsasl_plain.erl
+++ b/src/cyrsasl_plain.erl
@@ -42,7 +42,7 @@
 %%     Opts = term()
 
 start(_Opts) ->
-    cyrsasl:register_mechanism("PLAIN", ?MODULE, false),
+    cyrsasl:register_mechanism("PLAIN", ?MODULE, plain),
     ok.
 
 %% @spec () -> ok
diff --git a/src/cyrsasl_scram.erl b/src/cyrsasl_scram.erl
new file mode 100644
index 000000000..42f33d7e2
--- /dev/null
+++ b/src/cyrsasl_scram.erl
@@ -0,0 +1,197 @@
+%%%----------------------------------------------------------------------
+%%% File    : cyrsasl_scram.erl
+%%% Author  : Stephen Röttger <stephen.roettger@googlemail.com>
+%%% Purpose : SASL SCRAM authentication
+%%% Created : 7 Aug 2011 by Stephen Röttger <stephen.roettger@googlemail.com>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2011   ProcessOne
+%%%
+%%% This program is free software; you can redistribute it and/or
+%%% modify it under the terms of the GNU General Public License as
+%%% published by the Free Software Foundation; either version 2 of the
+%%% License, or (at your option) any later version.
+%%%
+%%% This program is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+%%% General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with this program; if not, write to the Free Software
+%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(cyrsasl_scram).
+-author('stephen.roettger@googlemail.com').
+
+-export([start/1,
+	 stop/0,
+	 mech_new/1,
+	 mech_step/2]).
+
+-include("ejabberd.hrl").
+-include("cyrsasl.hrl").
+
+-behaviour(cyrsasl).
+
+-record(state, {step, stored_key, server_key, username, get_password, check_password,
+		auth_message, client_nonce, server_nonce}).
+
+-define(SALT_LENGTH, 16).
+-define(NONCE_LENGTH, 16).
+
+start(_Opts) ->
+    cyrsasl:register_mechanism("SCRAM-SHA-1", ?MODULE, scram).
+
+stop() ->
+    ok.
+
+mech_new(#sasl_params{get_password=GetPassword}) ->
+    {ok, #state{step = 2, get_password = GetPassword}}.
+
+mech_step(#state{step = 2} = State, ClientIn) ->
+	case string:tokens(ClientIn, ",") of
+	[CBind, UserNameAttribute, ClientNonceAttribute] when (CBind == "y") or (CBind == "n") ->
+		case parse_attribute(UserNameAttribute) of
+		{error, Reason} ->
+			{error, Reason};
+		{_, EscapedUserName} ->
+			case unescape_username(EscapedUserName) of
+			error ->
+				{error, 'protocol-error-bad-username'};
+			UserName ->
+				case parse_attribute(ClientNonceAttribute) of
+				{$r, ClientNonce} ->
+					case (State#state.get_password)(UserName) of
+					{false, _} ->
+						{error, 'not-authorized', "", UserName};
+					{Ret, _AuthModule} ->
+						{StoredKey, ServerKey, Salt, IterationCount} = if
+						is_tuple(Ret) ->
+							Ret;
+						true ->
+							TempSalt = crypto:rand_bytes(?SALT_LENGTH),
+							SaltedPassword = scram:salted_password(Ret, TempSalt, ?SCRAM_DEFAULT_ITERATION_COUNT),
+							{scram:stored_key(scram:client_key(SaltedPassword)),
+							 scram:server_key(SaltedPassword), TempSalt, ?SCRAM_DEFAULT_ITERATION_COUNT}
+						end,
+						ClientFirstMessageBare = string:substr(ClientIn, string:str(ClientIn, "n=")),
+						ServerNonce = base64:encode_to_string(crypto:rand_bytes(?NONCE_LENGTH)),
+						ServerFirstMessage = "r=" ++ ClientNonce ++ ServerNonce ++ "," ++
+											"s=" ++ base64:encode_to_string(Salt) ++ "," ++
+											"i=" ++ integer_to_list(IterationCount),
+						{continue,
+						 ServerFirstMessage,
+						 State#state{step = 4, stored_key = StoredKey, server_key = ServerKey,
+									 auth_message = ClientFirstMessageBare ++ "," ++ ServerFirstMessage,
+									 client_nonce = ClientNonce, server_nonce = ServerNonce, username = UserName}}
+					end;
+				_Else ->
+					{error, 'not-supported'}
+				end
+			end;
+		_Else ->
+			{error, 'bad-protocol'}
+		end;
+	_Else ->
+	    {error, 'bad-protocol'}
+	end;
+mech_step(#state{step = 4} = State, ClientIn) ->
+	case string:tokens(ClientIn, ",") of
+	[GS2ChannelBindingAttribute, NonceAttribute, ClientProofAttribute] ->
+		case parse_attribute(GS2ChannelBindingAttribute) of
+		{$c, CVal} when (CVal == "biws") or (CVal == "eSws") ->
+		    %% biws is base64 for n,, => channelbinding not supported
+		    %% eSws is base64 for y,, => channelbinding supported by client only
+ 			Nonce = State#state.client_nonce ++ State#state.server_nonce,
+			case parse_attribute(NonceAttribute) of
+			{$r, CompareNonce} when CompareNonce == Nonce ->
+				case parse_attribute(ClientProofAttribute) of
+				{$p, ClientProofB64} ->
+					ClientProof = base64:decode(ClientProofB64),
+					AuthMessage = State#state.auth_message ++ "," ++ string:substr(ClientIn, 1, string:str(ClientIn, ",p=")-1),
+					ClientSignature = scram:client_signature(State#state.stored_key, AuthMessage),
+					ClientKey = scram:client_key(ClientProof, ClientSignature),
+					CompareStoredKey = scram:stored_key(ClientKey),
+					if CompareStoredKey == State#state.stored_key ->
+						ServerSignature = scram:server_signature(State#state.server_key, AuthMessage),
+						{ok, [{username, State#state.username}], "v=" ++ base64:encode_to_string(ServerSignature)};
+					true ->
+						{error, 'bad-auth'}
+					end;
+				_Else ->
+					{error, 'bad-protocol'}
+				end;
+			{$r, _} ->
+				{error, 'bad-nonce'};
+			_Else ->
+				{error, 'bad-protocol'}
+			end;
+		_Else ->
+	   		{error, 'bad-protocol'}
+		end;
+	_Else ->
+		{error, 'bad-protocol'}
+	end.
+
+parse_attribute(Attribute) ->
+	AttributeLen = string:len(Attribute),
+	if
+	AttributeLen > 3 ->
+		SecondChar = lists:nth(2, Attribute),
+		case is_alpha(lists:nth(1, Attribute)) of
+			true ->
+				if
+				SecondChar == $= ->
+					case string:substr(Attribute, 3) of
+					String when is_list(String) ->
+						{lists:nth(1, Attribute), String};
+					_Else ->
+						{error, 'bad-format failed'}
+					end;
+				true ->
+					{error, 'bad-format second char not equal sign'}
+				end;
+			_Else ->
+				{error, 'bad-format first char not a letter'}
+		end;
+	true -> 
+		{error, 'bad-format attribute too short'}
+	end.
+
+unescape_username("") ->
+	"";
+unescape_username(EscapedUsername) ->
+	Pos = string:str(EscapedUsername, "="),
+	if
+	Pos == 0 ->
+		EscapedUsername;
+	true ->
+		Start = string:substr(EscapedUsername, 1, Pos-1),
+		End = string:substr(EscapedUsername, Pos),
+		EndLen = string:len(End),
+		if
+		EndLen < 3 ->
+			error;
+		true ->
+			case string:substr(End, 1, 3) of
+			"=2C" ->
+				Start ++ "," ++ unescape_username(string:substr(End, 4));
+			"=3D" ->
+				Start ++ "=" ++ unescape_username(string:substr(End, 4));
+			_Else ->
+				error
+			end
+		end
+	end.
+
+is_alpha(Char) when Char >= $a, Char =< $z ->
+    true;
+is_alpha(Char) when Char >= $A, Char =< $Z -> 
+	true;
+is_alpha(_) ->
+	true.
+
diff --git a/src/ejabberd.app b/src/ejabberd.app
index 68e648919..0b524537e 100644
--- a/src/ejabberd.app
+++ b/src/ejabberd.app
@@ -8,6 +8,7 @@
 	     cyrsasl,
 	     cyrsasl_digest,
 	     cyrsasl_plain,
+	     cyrsasl_scram,
 	     ejabberd_admin,
 	     ejabberd_app,
 	     ejabberd_auth_anonymous,
diff --git a/src/ejabberd.cfg.example b/src/ejabberd.cfg.example
index 9f2415f63..d727bf716 100644
--- a/src/ejabberd.cfg.example
+++ b/src/ejabberd.cfg.example
@@ -295,6 +295,15 @@
 %%
 %%{host_config, "public.example.org", [{auth_method, [internal, anonymous]}]}.
 
+%%
+%% auth_password_format: Format of storing users passwords
+%% The default format is plain text.
+%% If you change to hashed scram, you can never go back to plain.
+%% This option is only supported by the 'storage' auth_method.
+%% 
+{auth_password_format, plain}.
+%%{auth_password_format, scram}.
+
 
 %%%.   ==============
 %%%'   DATABASE SETUP
diff --git a/src/ejabberd.hrl b/src/ejabberd.hrl
index 8c07db530..3c52b04f0 100644
--- a/src/ejabberd.hrl
+++ b/src/ejabberd.hrl
@@ -47,6 +47,9 @@
 
 %%-define(DBGFSM, true).
 
+-record(scram, {storedkey, serverkey, salt, iterationcount}).
+-define(SCRAM_DEFAULT_ITERATION_COUNT, 4096).
+
 %% ---------------------------------
 %% Logging mechanism
 
diff --git a/src/ejabberd_auth.erl b/src/ejabberd_auth.erl
index 38876302e..344232c86 100644
--- a/src/ejabberd_auth.erl
+++ b/src/ejabberd_auth.erl
@@ -50,6 +50,7 @@
 	 remove_user/2,
 	 remove_user/3,
 	 plain_password_required/1,
+	 store_type/1,
 	 entropy/1
 	]).
 
@@ -105,12 +106,31 @@ stop_methods(Host, Method) when is_atom(Method) ->
 %% @spec (Server) -> bool()
 %%     Server = string()
 
+%% This is only executed by ejabberd_c2s for non-SASL auth client
 plain_password_required(Server) when is_list(Server) ->
     lists:any(
       fun(M) ->
 	      M:plain_password_required()
       end, auth_modules(Server)).
 
+%% @spec (Server) -> bool()
+%%     Server = string()
+
+store_type(Server) ->
+    lists:foldl(
+      fun(_, external) ->
+	      external;
+	  (M, scram) ->
+	      case M:store_type() of
+		  external ->
+		      external;
+		  _Else ->
+		      scram
+		  end;
+	  (M, plain) ->
+	      M:store_type()
+      end, plain, auth_modules(Server)).
+
 %% @spec (User, Server, Password) -> bool()
 %%     User = string()
 %%     Server = string()
@@ -342,8 +362,10 @@ get_password_s(User, Server) when is_list(User), is_list(Server) ->
     case get_password(User, Server) of
 	false ->
 	    "";
-	Password ->
-	    Password
+	Password when is_list(Password) ->
+	    Password;
+	_ ->
+	    ""
     end.
 
 %% @spec (User, Server) -> {Password, AuthModule} | {false, none}
diff --git a/src/ejabberd_auth_anonymous.erl b/src/ejabberd_auth_anonymous.erl
index 1ea1ec672..2dcb597d5 100644
--- a/src/ejabberd_auth_anonymous.erl
+++ b/src/ejabberd_auth_anonymous.erl
@@ -52,6 +52,7 @@
 	 is_user_exists/2,
 	 remove_user/2,
 	 remove_user/3,
+	 store_type/0,
 	 plain_password_required/0]).
 
 -include_lib("exmpp/include/exmpp.hrl").
@@ -360,6 +361,9 @@ remove_user(_User, _Server, _Password) ->
 plain_password_required() ->
     false.
 
+store_type() ->
+	plain.
+
 update_tables() ->
     case catch mnesia:table_info(anonymous, local_content) of
 	false ->
diff --git a/src/ejabberd_auth_external.erl b/src/ejabberd_auth_external.erl
index 9a7af075c..d5ae7198a 100644
--- a/src/ejabberd_auth_external.erl
+++ b/src/ejabberd_auth_external.erl
@@ -44,6 +44,7 @@
 	 is_user_exists/2,
 	 remove_user/2,
 	 remove_user/3,
+	 store_type/0,
 	 plain_password_required/0
 	]).
 
@@ -99,6 +100,9 @@ plain_password_required() ->
 %%     Server = string()
 %%     Password = string()
 
+store_type() ->
+	external.
+
 check_password(User, Server, Password) ->
     case get_cache_option(Server) of
 	false -> check_password_extauth(User, Server, Password);
diff --git a/src/ejabberd_auth_ldap.erl b/src/ejabberd_auth_ldap.erl
index ceac2cb4f..61b2fa407 100644
--- a/src/ejabberd_auth_ldap.erl
+++ b/src/ejabberd_auth_ldap.erl
@@ -54,6 +54,7 @@
 	 is_user_exists/2,
 	 remove_user/2,
 	 remove_user/3,
+	 store_type/0,
 	 plain_password_required/0
 	]).
 
@@ -184,6 +185,9 @@ plain_password_required() ->
 %%     Server = string()
 %%     Password = string()
 
+store_type() ->
+	external.
+
 check_password(User, Server, Password) ->
     %% In LDAP spec: empty password means anonymous authentication.
     %% As ejabberd is providing other anonymous authentication mechanisms
diff --git a/src/ejabberd_auth_pam.erl b/src/ejabberd_auth_pam.erl
index 07657c9f1..97544695e 100644
--- a/src/ejabberd_auth_pam.erl
+++ b/src/ejabberd_auth_pam.erl
@@ -40,6 +40,7 @@
 	 is_user_exists/2,
 	 remove_user/2,
 	 remove_user/3,
+	 store_type/0,
 	 plain_password_required/0
 	]).
 
@@ -171,6 +172,9 @@ remove_user(_User, _Server, _Password) ->
 plain_password_required() ->
     true.
 
+store_type() ->
+	external.
+
 %%====================================================================
 %% Internal functions
 %%====================================================================
diff --git a/src/ejabberd_auth_storage.erl b/src/ejabberd_auth_storage.erl
index e9fc0b0cb..54a460823 100644
--- a/src/ejabberd_auth_storage.erl
+++ b/src/ejabberd_auth_storage.erl
@@ -44,10 +44,27 @@
 %%%  user_host = {Username::string(), Host::string()}
 %%%  password = string()
 %%%
+%%% 3.0.0-beta / mnesia / passwd
+%%%  user_host = {Username::string(), Host::string()}
+%%%  password = string()
+%%%  storedkey = base64 binary()
+%%%  serverkey = base64 binary()
+%%%  iterationcount = integer()
+%%%  salt = base64 binary()
+%%%
 %%% 3.0.0-alpha / odbc / passwd
 %%%  user = varchar150
 %%%  host = varchar150
 %%%  password = text
+%%%
+%%% 3.0.0-beta / odbc / passwd
+%%%  user = varchar150
+%%%  host = varchar150
+%%%  password = base64 text
+%%%  storedkey = base64 text
+%%%  serverkey = base64 text
+%%%  iterationcount = integer
+%%%  salt = base64 text
 
 -module(ejabberd_auth_storage).
 -author('alexey@process-one.net').
@@ -69,14 +86,17 @@
 	 is_user_exists/2,
 	 remove_user/2,
 	 remove_user/3,
+	 store_type/0,
 	 plain_password_required/0
 	]).
 
 -include("ejabberd.hrl").
 
--record(passwd, {user_host, password}).
+-record(passwd, {user_host, password, storedkey, serverkey, salt, iterationcount}).
 -record(reg_users_counter, {vhost, count}).
 
+-define(SALT_LENGTH, 16).
+
 %%%----------------------------------------------------------------------
 %%% API
 %%%----------------------------------------------------------------------
@@ -95,13 +115,19 @@ start(Host) ->
 			     [{odbc_host, Host},
 			      {disc_copies, [node()]},
 			      {attributes, record_info(fields, passwd)},
-			      {types, [{user_host, {text, text}}]}
+			      {types, [{user_host, {text, text}},
+			               {storedkey, binary},
+			               {serverkey, binary},
+			               {salt, binary},
+			               {iterationcount, int}]}
 			     ]),
     update_table(Host, Backend),
+    maybe_scram_passwords(Host),
     mnesia:create_table(reg_users_counter,
 			[{ram_copies, [node()]},
 			 {attributes, record_info(fields, reg_users_counter)}]),
     update_reg_users_counter_table(Host),
+    maybe_alert_password_scrammed_without_option(Host),
     ok.
 
 stop(_Host) ->
@@ -120,7 +146,16 @@ update_reg_users_counter_table(Server) ->
 %% @spec () -> bool()
 
 plain_password_required() ->
-    false.
+    case is_scrammed(?MYNAME) of
+	false -> false;
+	true -> true
+    end.
+
+store_type() ->
+    case is_scrammed(?MYNAME) of
+	false -> plain; %% allows: PLAIN DIGEST-MD5 SCRAM
+	true -> scram %% allows: PLAIN SCRAM
+    end.
 
 %% @spec (User, Server, Password) -> bool()
 %%     User = string()
@@ -132,6 +167,8 @@ check_password(User, Server, Password) ->
     LServer = exmpp_stringprep:nameprep(Server),
     US = {LUser, LServer},
     case catch gen_storage:dirty_read(LServer, {passwd, US}) of
+	[#passwd{password = ""} = Passwd] ->
+	    is_password_scram_valid(Password, Passwd);
 	[#passwd{password = Password}] ->
 	    Password /= "";
 	_ ->
@@ -150,6 +187,19 @@ check_password(User, Server, Password, Digest, DigestGen) ->
     LServer = exmpp_stringprep:nameprep(Server),
     US = {LUser, LServer},
     case catch gen_storage:dirty_read(LServer, {passwd, US}) of
+	[#passwd{password = ""} = Passwd] ->
+	    Passwd = base64:decode(Passwd#passwd.storedkey),
+	    DigRes = if
+			 Digest /= "" ->
+			     Digest == DigestGen(Passwd);
+			 true ->
+			     false
+		     end,
+	    if DigRes ->
+		    true;
+	       true ->
+		    (Passwd == Password) and (Password /= "")
+	    end;
 	[#passwd{password = Passwd}] ->
 	    DigRes = if
 			 Digest /= "" ->
@@ -182,9 +232,11 @@ set_password(User, Server, Password) ->
 	US ->
 	    %% TODO: why is this a transaction?
 	    F = fun() ->
-			gen_storage:write(LServer,
-					  #passwd{user_host = US,
-						  password = Password})
+			Passwd = case is_scrammed(LServer) and (Password /= "") of
+					true -> password_to_scram(Password, #passwd{user_host=US});
+					false -> #passwd{user_host = US, password = Password}
+				    end,
+			gen_storage:write(LServer, Passwd)
 		end,
 	    {atomic, ok} = gen_storage:transaction(LServer, passwd, F),
 	    ok
@@ -207,9 +259,11 @@ try_register(User, Server, Password) ->
 	    F = fun() ->
 			case gen_storage:read(LServer, {passwd, US}) of
 			    [] ->
-				gen_storage:write(LServer,
-						  #passwd{user_host = US,
-							  password = Password}),
+				Passwd = case is_scrammed(LServer) and (Password /= "") of
+						true -> password_to_scram(Password, #passwd{user_host=US});
+						false -> #passwd{user_host = US, password = Password}
+					    end,
+				gen_storage:write(LServer, Passwd),
 				mnesia:dirty_update_counter(
 						    reg_users_counter,
 						    exmpp_jid:prep_domain(exmpp_jid:parse(Server)), 1),
@@ -352,9 +406,14 @@ get_password(User, Server) ->
 	LServer = exmpp_stringprep:nameprep(Server),
 	US = {LUser, LServer},
         case catch gen_storage:dirty_read(LServer, passwd, US) of
-	    [#passwd{password = Password}] ->
+	[#passwd{password = ""} = Passwd] ->
+	    {base64:decode(Passwd#passwd.storedkey),
+	     base64:decode(Passwd#passwd.serverkey),
+	     base64:decode(Passwd#passwd.salt),
+	     Passwd#passwd.iterationcount};
+	[#passwd{password = Password}] ->
 		Password;
-	    _ ->
+	_ ->
 		false
 	end
     catch
@@ -373,8 +432,8 @@ get_password_s(User, Server) ->
 	LServer = exmpp_stringprep:nameprep(Server),
 	US = {LUser, LServer},
         case catch gen_storage:dirty_read(LServer, passwd, US) of
-	    [#passwd{password = Password}] ->
-		Password;
+	[#passwd{password = Password}] ->
+	    Password;
 	    _ ->
 		[]
 	end
@@ -441,13 +500,21 @@ remove_user(User, Server, Password) ->
 	US = {LUser, LServer},
 	F = fun() ->
 		    case gen_storage:read(LServer, {passwd, US}) of
+		    [#passwd{password = ""} = Passwd] ->
+			case is_password_scram_valid(Password, Passwd) of
+			    true ->
+				gen_storage:delete(LServer, {passwd, US}),
+				mnesia:dirty_update_counter(reg_users_counter,
+							    LServer, -1),
+				ok;
+			    false ->
+				not_allowed
+			end;
 			[#passwd{password = Password}] ->
 			    gen_storage:delete(LServer, {passwd, US}),
 			    mnesia:dirty_update_counter(reg_users_counter,
 							exmpp_jid:prep_domain(exmpp_jid:parse(Server)), -1),
 			    ok;
-			[_] ->
-			    not_allowed;
 			_ ->
 			    not_exists
 		    end
@@ -463,13 +530,120 @@ remove_user(User, Server, Password) ->
 	    bad_request
     end.
 
+%%%
+%%% SCRAM
+%%%
+
+%% The passwords are stored scrammed in the table either if the option says so,
+%% or if at least the first password is empty.
+is_scrammed(Host) ->
+    case action_password_format(Host) of
+	scram -> true;
+	must_scram -> true;
+	plain -> false;
+	forced_scram -> true
+    end.
+
+action_password_format(Host) ->
+    OptionScram = is_option_scram(),
+    case {OptionScram, get_format_first_element(Host)} of
+	{true, scram} -> scram;
+	{true, any} -> scram;
+	{true, plain} -> must_scram;
+	{false, plain} -> plain;
+	{false, any} -> plain;
+	{false, scram} -> forced_scram
+    end.
+
+get_format_first_element(Host) ->
+    case gen_storage:dirty_select(Host, passwd, []) of
+	[] -> any;
+	[#passwd{password = ""} | _] -> scram;
+	[#passwd{} | _] -> plain
+    end.
+
+is_option_scram() ->
+    scram == ejabberd_config:get_local_option({auth_password_format, ?MYNAME}).
+
+maybe_alert_password_scrammed_without_option(Host) ->
+    case is_scrammed(Host) andalso not is_option_scram() of
+	true ->
+	    ?ERROR_MSG("Some passwords were stored in the database as SCRAM, "
+		       "but 'auth_password_format' is not configured 'scram'. "
+		       "The option will now be considered to be 'scram'.", []);
+	false ->
+	    ok
+    end.
+
+maybe_scram_passwords(Host) ->
+    case action_password_format(Host) of
+	must_scram -> scram_passwords(Host);
+	_ -> ok
+    end.
+
+scram_passwords(Host) ->
+    Backend =
+        case ejabberd_config:get_local_option({auth_storage, Host}) of
+            undefined -> mnesia;
+            B -> B
+        end,
+    scram_passwords(Host, Backend).
+scram_passwords(Host, mnesia) ->
+    ?INFO_MSG("Converting the passwords stored in odbc for host ~p into SCRAM bits", [Host]),
+    gen_storage_migration:migrate_mnesia(
+      Host, passwd,
+      [{passwd, [user_host, password, storedkey, serverkey, iterationcount, salt],
+	fun(#passwd{password = Password} = Passwd) ->
+		password_to_scram(Password, Passwd)
+	end}]);
+scram_passwords(Host, odbc) ->
+    ?INFO_MSG("Converting the passwords stored in odbc for host ~p into SCRAM bits", [Host]),
+    gen_storage_migration:migrate_odbc(
+      Host, [passwd],
+      [{"passwd", ["user", "host", "password", "storedkey", "serverkey", "iterationcount", "salt"],
+	fun(_, User, Host2, Password, _Storedkey, _Serverkey, _Iterationcount, _Salt) ->
+		password_to_scram(Password, #passwd{user_host = {User, Host2}})
+	end}]).
+
+password_to_scram(Password, Passwd) ->
+    password_to_scram(Password, Passwd, ?SCRAM_DEFAULT_ITERATION_COUNT).
+
+password_to_scram(Password, Passwd, IterationCount) ->
+    Salt = crypto:rand_bytes(?SALT_LENGTH),
+    SaltedPassword = scram:salted_password(Password, Salt, IterationCount),
+    StoredKey = scram:stored_key(scram:client_key(SaltedPassword)),
+    ServerKey = scram:server_key(SaltedPassword),
+    Passwd#passwd{password = "",
+	   storedkey = base64:encode(StoredKey),
+	   salt = base64:encode(Salt),
+	   iterationcount = IterationCount,
+	   serverkey = base64:encode(ServerKey)}.
+
+is_password_scram_valid(Password, Passwd) ->
+    IterationCount = Passwd#passwd.iterationcount,
+    Salt = base64:decode(Passwd#passwd.salt),
+    SaltedPassword = scram:salted_password(Password, Salt, IterationCount),
+    StoredKey = scram:stored_key(scram:client_key(SaltedPassword)),
+    (base64:decode(Passwd#passwd.storedkey) == StoredKey).
+
+
 update_table(Host, mnesia) ->
     gen_storage_migration:migrate_mnesia(
       Host, passwd,
       [{passwd, [us, password],
 	fun({passwd, {User, _Host}, Password}) ->
-		#passwd{user_host = {User, Host},
-			password = Password}
+		case is_list(Password) of
+		    true ->
+			#passwd{user_host = {User, Host},
+				password = Password};
+		    false ->
+			#passwd{user_host = {User, Host},
+				password = "",
+				storedkey = Password#scram.storedkey,
+				serverkey = Password#scram.serverkey,
+				salt = Password#scram.salt,
+				iterationcount = Password#scram.iterationcount}
+		end
 	end}]);
 update_table(Host, odbc) ->
     gen_storage_migration:migrate_odbc(
diff --git a/src/ejabberd_c2s.erl b/src/ejabberd_c2s.erl
index e8234195f..7c2872e65 100644
--- a/src/ejabberd_c2s.erl
+++ b/src/ejabberd_c2s.erl
@@ -853,6 +853,21 @@ wait_for_sasl_response({xmlstreamelement, #xmlel{ns = NS, name = Name} = El},
 				     authenticated = true,
 				     auth_module = AuthModule,
 				     user = list_to_binary(U)});
+		{ok, Props, ServerOut} ->
+		    catch (StateData#state.sockmod):reset_stream(
+		      StateData#state.socket),
+		    send_element(StateData, exmpp_server_sasl:success(ServerOut)),
+		    U = proplists:get_value(username, Props),
+
+		    AuthModule = proplists:get_value(auth_module, Props),
+		    ?INFO_MSG("(~w) Accepted authentication for ~s by ~s",
+			      [StateData#state.socket, U, AuthModule]),
+		    fsm_next_state(wait_for_stream,
+				   StateData#state{
+				     streamid = new_id(),
+				     authenticated = true,
+				     auth_module = AuthModule,
+				     user = list_to_binary(U)});
 		{continue, ServerOut, NewSASLState} ->
 		    send_element(StateData,
 		      exmpp_server_sasl:challenge(ServerOut)),
diff --git a/src/ejabberd_piefxis.erl b/src/ejabberd_piefxis.erl
index 50a5834b0..cea7f7c0d 100644
--- a/src/ejabberd_piefxis.erl
+++ b/src/ejabberd_piefxis.erl
@@ -159,21 +159,24 @@ process_element(El,State) ->
 
 add_user(El, Domain) ->
     User = exmpp_xml:get_attribute(El,<<"name">>,none),
+    PasswordFormat = exmpp_xml:get_attribute(El,<<"password-format">>,none),
     Password = exmpp_xml:get_attribute(El,<<"password">>,none),
-    add_user(El, Domain, User, Password).
+    add_user(El, Domain, User, PasswordFormat, Password).
 
-%% @spec (El::xmlel(), Domain::string(), User::binary(), Password::binary() | none)
+%% @spec (El::xmlel(), Domain::string(), User::binary(), PasswordFormat, Password::binary() | none)
 %%       -> ok | {error, ErrorText::string()}
+%% PasswordFormat = <<"plaintext">> | <<"scram">>
 %% @doc Add a new user to the database.
 %% If user already exists, it will be only updated.
-add_user(El, Domain, User, none) ->
+add_user(El, Domain, User, <<"plaintext">>, none) ->
     io:format("Account ~s@~s will not be created, updating it...~n",
 	      [User, Domain]),
     io:format(""),
     populate_user_with_elements(El, Domain, User),
     ok;
-add_user(El, Domain, User, Password) ->
-    case create_user(User,Password,Domain) of
+add_user(El, Domain, User, PasswordFormat, Password) ->
+    Password2 = prepare_password(PasswordFormat, Password, El),
+    case create_user(User,Password2,Domain) of
 	ok ->
 	    populate_user_with_elements(El, Domain, User),
 	    ok;
@@ -188,6 +191,21 @@ add_user(El, Domain, User, Password) ->
 	    {error, Other}
     end.
 
+prepare_password(<<"plaintext">>, PasswordBinary, _El) ->
+    ?BTL(PasswordBinary);
+prepare_password(<<"scram">>, none, El) ->
+    ScramEl = exmpp_xml:get_element(El, 'scram-hash'),
+    #scram{storedkey = base64:decode(exmpp_xml:get_attribute(
+					ScramEl, <<"stored-key">>, none)),
+	   serverkey = base64:decode(exmpp_xml:get_attribute(
+					ScramEl, <<"server-key">>, none)),
+	   salt = base64:decode(exmpp_xml:get_attribute(
+				  ScramEl, <<"salt">>, none)),
+	   iterationcount = list_to_integer(exmpp_xml:get_attribute_as_list(
+					       ScramEl, <<"iteration-count">>,
+					       ?SCRAM_DEFAULT_ITERATION_COUNT))
+	  }.
+
 populate_user_with_elements(El, Domain, User) ->
     exmpp_xml:foreach(
       fun (_,Child) ->
@@ -482,10 +500,23 @@ export_user(Fd, Username, Host) ->
 
 %% @spec (Username::string(), Host::string()) -> string()
 extract_user(Username, Host) ->
-    Password = ejabberd_auth:get_password_s(Username, Host),
+    Password = ejabberd_auth:get_password(Username, Host),
+    PasswordStr = build_password_string(Password),
     UserInfo = [extract_user_info(InfoName, Username, Host) || InfoName <- [roster, offline, private, vcard]],
     UserInfoString = lists:flatten(UserInfo),
-    io_lib:format("<user name='~s' password='~s'>~s</user>", [Username, Password, UserInfoString]).
+    io_lib:format("<user name='~s' ~s ~s</user>",
+		  [Username, PasswordStr, UserInfoString]).
+
+build_password_string({StoredKey, ServerKey, Salt, IterationCount}) ->
+    io_lib:format("password-format='scram'>"
+		  "<scram-hash stored-key='~s' server-key='~s' "
+		  "salt='~s' iteration-count='~w'/> ",
+		  [base64:encode_to_string(StoredKey),
+		   base64:encode_to_string(ServerKey),
+		   base64:encode_to_string(Salt),
+		   IterationCount]);
+build_password_string(Password) when is_list(Password) ->
+    io_lib:format("password-format='plaintext' password='~s'>", [Password]).
 
 %% @spec (InfoName::atom(), Username::string(), Host::string()) -> string()
 extract_user_info(roster, Username, Host) ->
diff --git a/src/scram.erl b/src/scram.erl
new file mode 100644
index 000000000..30bd6bb27
--- /dev/null
+++ b/src/scram.erl
@@ -0,0 +1,81 @@
+%%%----------------------------------------------------------------------
+%%% File    : scram.erl
+%%% Author  : Stephen Röttger <stephen.roettger@googlemail.com>
+%%% Purpose : SCRAM (RFC 5802)
+%%% Created : 7 Aug 2011 by Stephen Röttger <stephen.roettger@googlemail.com>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2011   ProcessOne
+%%%
+%%% This program is free software; you can redistribute it and/or
+%%% modify it under the terms of the GNU General Public License as
+%%% published by the Free Software Foundation; either version 2 of the
+%%% License, or (at your option) any later version.
+%%%
+%%% This program is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+%%% General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with this program; if not, write to the Free Software
+%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(scram).
+-author('stephen.roettger@googlemail.com').
+
+%% External exports
+-export([salted_password/3,
+	 stored_key/1,
+	 server_key/1,
+	 server_signature/2,
+	 client_signature/2,
+	 client_key/1,
+	 client_key/2
+	]).
+
+salted_password(Password, Salt, IterationCount) ->
+	hi(jlib:nameprep(Password), Salt, IterationCount).
+
+client_key(SaltedPassword) ->
+	crypto:sha_mac(SaltedPassword, "Client Key").
+
+stored_key(ClientKey) ->
+	crypto:sha(ClientKey).
+
+server_key(SaltedPassword) ->
+	crypto:sha_mac(SaltedPassword, "Server Key").
+
+client_signature(StoredKey, AuthMessage) ->
+	crypto:sha_mac(StoredKey, AuthMessage).
+
+client_key(ClientProof, ClientSignature) ->
+	binary:list_to_bin(lists:zipwith(fun(X, Y) ->
+					X bxor Y
+				  end,
+				  binary:bin_to_list(ClientProof),
+				  binary:bin_to_list(ClientSignature))).
+
+server_signature(ServerKey, AuthMessage) ->
+	crypto:sha_mac(ServerKey, AuthMessage).
+
+hi(Password, Salt, IterationCount) ->
+	U1 = crypto:sha_mac(Password, string:concat(binary:bin_to_list(Salt), [0,0,0,1])),
+	binary:list_to_bin(lists:zipwith(fun(X, Y) ->
+					X bxor Y
+				  end,
+				  binary:bin_to_list(U1),
+				  binary:bin_to_list(hi_round(Password, U1, IterationCount-1)))).
+
+hi_round(Password, UPrev, 1) ->
+	crypto:sha_mac(Password, UPrev);
+hi_round(Password, UPrev, IterationCount) ->
+	U = crypto:sha_mac(Password, UPrev),
+	binary:list_to_bin(lists:zipwith(fun(X, Y) ->
+					X bxor Y
+				  end,
+				  binary:bin_to_list(U),
+				  binary:bin_to_list(hi_round(Password, U, IterationCount-1)))).