Add support for scram upgrade tasks

src/ejabberd_c2s.erl

@@ -44,7 +44,7 @@
 	 handle_auth_failure/4, handle_send/3, handle_recv/3, handle_cdata/2,
 	 handle_unbinded_packet/2, inline_stream_features/1,
 	 handle_sasl2_inline/2, handle_sasl2_inline_post/3,
-	 handle_bind2_inline/2, handle_bind2_inline_post/3, sasl_options/1]).
+	 handle_bind2_inline/2, handle_bind2_inline_post/3, sasl_options/1, handle_sasl2_task_next/4, handle_sasl2_task_data/3]).
 %% Hooks
 -export([handle_unexpected_cast/2, handle_unexpected_call/3,
 	 process_auth_result/3, reject_unauthenticated_packet/2,
@@ -83,7 +83,7 @@ accept(Ref) ->
 %%%===================================================================
 %%% Common API
 %%%===================================================================
--spec call(pid(), term(), non_neg_integer() | infinity) -> term().
+-spec call(pid(), term(), non_neg_integer() | infinity) -> dynamic().
 call(Ref, Msg, Timeout) ->
     xmpp_stream_in:call(Ref, Msg, Timeout).
 
@@ -255,7 +255,7 @@ process_info(#{lserver := LServer} = State, {route, Packet}) ->
 process_info(State, reset_vcard_xupdate_resend_presence) ->
     case maps:get(pres_last, State, error) of
 	error -> State;
-	Pres ->
+	#presence{} = Pres ->
 	    Pres2 = xmpp:remove_subtag(Pres, #vcard_xupdate{}),
 	    process_self_presence(State#{pres_last => Pres2}, Pres2)
     end;
@@ -407,7 +407,7 @@ authenticated_stream_features(#{lserver := LServer}) ->
     ejabberd_hooks:run_fold(c2s_post_auth_features, LServer, [], [LServer]).
 
 inline_stream_features(#{lserver := LServer}) ->
-    ejabberd_hooks:run_fold(c2s_inline_features, LServer, {[], []}, [LServer]).
+    ejabberd_hooks:run_fold(c2s_inline_features, LServer, {[], [], []}, [LServer]).
 
 sasl_mechanisms(Mechs, #{lserver := LServer, stream_encrypted := Encrypted} = State) ->
     Type = ejabberd_auth:store_type(LServer),
@@ -473,7 +473,7 @@ bind(R, #{user := U, server := S, access := Access, lang := Lang,
 	closenew ->
 	    {error, xmpp:err_conflict(), State};
 	{accept_resource, Resource} ->
-	    JID = jid:make(U, S, Resource),
+	    JID = #jid{} = jid:make(U, S, Resource),
 	    case acl:match_rule(LServer, Access,
 				#{usr => jid:split(JID), ip => IP}) of
 		allow ->
@@ -583,6 +583,14 @@ handle_bind2_inline_post(Els, Results, #{lserver := LServer} = State) ->
     ejabberd_hooks:run_fold(c2s_handle_bind2_inline_post, LServer,
 			    State, [Els, Results]).
 
+handle_sasl2_task_next(Task, Els, InlineEls, #{lserver := LServer} = State) ->
+    ejabberd_hooks:run_fold(c2s_handle_sasl2_task_next, LServer,
+			    {abort, State}, [Task, Els, InlineEls]).
+
+handle_sasl2_task_data(Els, InlineEls, #{lserver := LServer} = State) ->
+    ejabberd_hooks:run_fold(c2s_handle_sasl2_task_data, LServer,
+			    {abort, State}, [Els, InlineEls]).
+
 handle_recv(El, Pkt, #{lserver := LServer} = State) ->
     ejabberd_hooks:run_fold(c2s_handle_recv, LServer, State, [El, Pkt]).
 
@@ -692,7 +700,7 @@ process_message_in(State, #message{type = T} = Msg) ->
 
 -spec process_presence_in(state(), presence()) -> {boolean(), state()}.
 process_presence_in(#{lserver := LServer, pres_a := PresA} = State0,
-		    #presence{from = From, type = T} = Pres) ->
+		    #presence{from = #jid{} = From, type = T} = Pres) ->
     State = ejabberd_hooks:run_fold(c2s_presence_in, LServer, State0, [Pres]),
     case T of
 	probe ->
@@ -742,7 +750,8 @@ route_probe_reply(_, _) ->
 -spec process_presence_out(state(), presence()) -> state().
 process_presence_out(#{lserver := LServer, jid := JID,
 		       lang := Lang, pres_a := PresA} = State0,
-		     #presence{from = From, to = To, type = Type} = Pres) ->
+		     #presence{from = #jid{} = From, to = #jid{} = To, type = Type} = Pres) ->
+			#jid{} = From,
     State1 =
 	if Type == subscribe; Type == subscribed;
 	   Type == unsubscribe; Type == unsubscribed ->
@@ -850,7 +859,7 @@ broadcast_presence_unavailable(#{jid := JID, pres_a := PresA} = State, Pres,
 
     JIDs = lists:filtermap(
 	fun(LJid) ->
-	    To = jid:make(LJid),
+	    To = #jid{} = jid:make(LJid),
 	    P = xmpp:set_to(Pres, To),
 	    case privacy_check_packet(State, P, out) of
 		allow -> {true, To};
@@ -938,7 +947,7 @@ get_priority_from_presence(#presence{priority = Prio}) ->
 
 -spec route_multiple(state(), [jid()], stanza()) -> ok.
 route_multiple(#{lserver := LServer}, JIDs, Pkt) ->
-    From = xmpp:get_from(Pkt),
+    From = #jid{} = xmpp:get_from(Pkt),
     ejabberd_router_multicast:route_multicast(From, LServer, JIDs, Pkt, false).
 
 get_subscription(#jid{luser = LUser, lserver = LServer}, JID) ->
@@ -1007,7 +1016,7 @@ get_conn_type(State) ->
 	websocket -> websocket
     end.
 
--spec fix_from_to(xmpp_element(), state()) -> stanza().
+-spec fix_from_to(xmpp_element(), state()) -> stanza() | xmpp_element().
 fix_from_to(Pkt, #{jid := JID}) when ?is_stanza(Pkt) ->
     #jid{luser = U, lserver = S, lresource = R} = JID,
     case xmpp:get_from(Pkt) of

src/mod_carboncopy.erl

@@ -145,10 +145,10 @@ c2s_session_resumed(State) ->
 c2s_session_opened(State) ->
     maps:remove(carboncopy, State).
 
-c2s_inline_features({Sasl, Bind} = Acc, Host) ->
+c2s_inline_features({Sasl, Bind, Extra} = Acc, Host) ->
     case gen_mod:is_loaded(Host, ?MODULE) of
 	true ->
-	    {Sasl, [#bind2_feature{var = ?NS_CARBONS_2} | Bind]};
+	    {Sasl, [#bind2_feature{var = ?NS_CARBONS_2} | Bind], Extra};
 	false ->
 	    Acc
     end.

src/mod_scram_upgrade.erl

@@ -0,0 +1,120 @@
+%%%-------------------------------------------------------------------
+%%% Created : 20 Oct 2024 by Pawel Chmielowski <pawel@process-one.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2024   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.,
+%%% 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+%%%
+%%%-------------------------------------------------------------------
+-module(mod_scram_upgrade).
+-behaviour(gen_mod).
+-protocol({xep, 480, '0.1'}).
+
+%% gen_mod API
+-export([start/2, stop/1, reload/3, depends/2, mod_options/1, mod_opt_type/1]).
+-export([mod_doc/0]).
+%% Hooks
+-export([c2s_inline_features/2, c2s_handle_sasl2_inline/1,
+	 c2s_handle_sasl2_task_next/4, c2s_handle_sasl2_task_data/3]).
+
+-include_lib("xmpp/include/xmpp.hrl").
+-include_lib("xmpp/include/scram.hrl").
+-include("logger.hrl").
+-include("translate.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+start(_Host, _Opts) ->
+    {ok, [{hook, c2s_inline_features, c2s_inline_features, 50},
+	  {hook, c2s_handle_sasl2_inline, c2s_handle_sasl2_inline, 10},
+	  {hook, c2s_handle_sasl2_task_next, c2s_handle_sasl2_task_next, 10},
+	  {hook, c2s_handle_sasl2_task_data, c2s_handle_sasl2_task_data, 10}]}.
+
+stop(_Host) ->
+    ok.
+
+reload(_Host, _NewOpts, _OldOpts) ->
+    ok.
+
+depends(_Host, _Opts) ->
+    [].
+
+mod_opt_type(offered_upgrades) ->
+    econf:list(econf:enum([sha256, sha512])).
+
+mod_options(_Host) ->
+    [{offered_upgrades, [sha256, sha512]}].
+
+mod_doc() ->
+    #{desc =>
+      [?T("The module adds support for "
+	  "https://xmpp.org/extensions/xep-0480.html"
+	  "[XEP-0480: SASL Upgrade Tasks] that allows users to upgrade "
+	  "passwords to more secure representation.")],
+      opts => [{offered_upgrades,
+		#{value => "list(sha256, sha512)",
+		  desc => ?T("List with upgrade types that should be offered")}}],
+      example =>
+      ["modules:",
+       "  mod_scram_upgrade:",
+       "    offered_upgrades:",
+       "      - sha256",
+       "      - sha512"]}.
+
+c2s_inline_features({Sasl, Bind, Extra}, Host) ->
+    Methods = lists:map(
+	fun(sha256) -> #sasl_upgrade{cdata = <<"UPGR-SCRAM-SHA-256">>};
+	   (sha512) -> #sasl_upgrade{cdata = <<"UPGR-SCRAM-SHA-512">>}
+	end, mod_scram_upgrade_opt:offered_upgrades(Host)),
+    {Sasl, Bind, Methods ++ Extra}.
+
+c2s_handle_sasl2_inline({State, Els, _Results} = Acc) ->
+    case lists:keyfind(sasl_upgrade, 1, Els) of
+	false ->
+	    Acc;
+	#sasl_upgrade{cdata = Type} ->
+	    {stop, {State, {continue, [Type]}, []}}
+    end.
+
+c2s_handle_sasl2_task_next({_, State}, Task, _Els, _InlineEls) ->
+    Algo = case Task of
+	       <<"UPGR-SCRAM-SHA-256">> -> sha256;
+	       <<"UPGR-SCRAM-SHA-512">> -> sha512
+	   end,
+    Salt = p1_rand:bytes(16),
+    {task_data, [#scram_upgrade_salt{cdata = Salt, iterations = 4096}],
+     State#{scram_upgrade => {Algo, Salt, 4096}}}.
+
+c2s_handle_sasl2_task_data({_, #{user := User, server := Server,
+				 scram_upgrade := {Algo, Salt, Iter}} = State},
+			   Els, InlineEls) ->
+    case xmpp:get_subtag(#sasl2_task_data{sub_els = Els}, #scram_upgrade_hash{}) of
+	#scram_upgrade_hash{data = SaltedPassword} ->
+	    StoredKey = scram:stored_key(Algo, scram:client_key(Algo, SaltedPassword)),
+	    ServerKey = scram:server_key(Algo, SaltedPassword),
+	    ejabberd_auth:set_password(User, Server,
+				       #scram{hash = Algo, iterationcount = Iter, salt = Salt,
+					      serverkey = ServerKey, storedkey = StoredKey}),
+	    State2 = maps:remove(scram_upgrade, State),
+	    InlineEls = lists:keydelete(sasl_upgrade, 1, InlineEls),
+	    case ejabberd_c2s:handle_sasl2_inline(InlineEls, State2) of
+		{State3, NewEls, Results} ->
+		    {success, NewEls, Results, State3}
+	    end;
+	_ ->
+	    {abort, State}
+    end.

src/mod_scram_upgrade_opt.erl

@@ -0,0 +1,13 @@
+%% Generated automatically
+%% DO NOT EDIT: run `make options` instead
+
+-module(mod_scram_upgrade_opt).
+
+-export([offered_upgrades/1]).
+
+-spec offered_upgrades(gen_mod:opts() | global | binary()) -> any().
+offered_upgrades(Opts) when is_map(Opts) ->
+    gen_mod:get_opt(offered_upgrades, Opts);
+offered_upgrades(Host) ->
+    gen_mod:get_module_opt(Host, mod_scram_upgrade, offered_upgrades).
+

src/mod_stream_mgmt.erl

@@ -122,11 +122,12 @@ c2s_stream_features(Acc, Host) ->
 	    Acc
     end.
 
-c2s_inline_features({Sasl, Bind} = Acc, Host) ->
+c2s_inline_features({Sasl, Bind, Extra} = Acc, Host) ->
     case gen_mod:is_loaded(Host, ?MODULE) of
 	true ->
 	    {[#feature_sm{xmlns = ?NS_STREAM_MGMT_3} | Sasl],
-	     [#bind2_feature{var = ?NS_STREAM_MGMT_3} | Bind]};
+	     [#bind2_feature{var = ?NS_STREAM_MGMT_3} | Bind],
+	     Extra};
 	false ->
 	    Acc
     end.