mod_mam: Send new preferences when they are set

If a client updates the archiving preferences, include the new
preferences with the IQ result (as mandated by XEP-0313).

2 files changed, 31 insertions, 23 deletions

diff --git a/src/mod_mam.erl b/src/mod_mam.erl
index e6f5ac40..38642c0c 100644
--- a/src/mod_mam.erl
+++ b/src/mod_mam.erl
@@ -461,11 +461,13 @@ process_iq(#jid{luser = LUser, lserver = LServer},
 		    (_, {A, N}) ->
 			{A, N}
 		end, {[], []}, SubEl#xmlel.children)} of
-	{Default, {Always, Never}} ->
-	    case write_prefs(LUser, LServer, LServer, Default,
-		    lists:usort(Always), lists:usort(Never)) of
+	{Default, {Always0, Never0}} ->
+	    Always = lists:usort(Always0),
+	    Never = lists:usort(Never0),
+	    case write_prefs(LUser, LServer, LServer, Default, Always, Never) of
 		ok ->
-		    IQ#iq{type = result, sub_el = []};
+		    NewPrefs = prefs_el(Default, Always, Never, IQ#iq.xmlns),
+		    IQ#iq{type = result, sub_el = [NewPrefs]};
 		_Err ->
 		    IQ#iq{type = error,
 			sub_el = [SubEl, ?ERR_INTERNAL_SERVER_ERROR]}
@@ -477,21 +479,11 @@ process_iq(#jid{luser = LUser, lserver = LServer},
 	   #jid{lserver = LServer},
 	   #iq{type = get, sub_el = #xmlel{name = <<"prefs">>}} = IQ) ->
     Prefs = get_prefs(LUser, LServer),
-    Default = jlib:atom_to_binary(Prefs#archive_prefs.default),
-    JFun = fun(L) ->
-		   [#xmlel{name = <<"jid">>,
-			   children = [{xmlcdata, jid:to_string(J)}]}
-		    || J <- L]
-	   end,
-    Always = #xmlel{name = <<"always">>,
-		    children = JFun(Prefs#archive_prefs.always)},
-    Never = #xmlel{name = <<"never">>,
-		   children = JFun(Prefs#archive_prefs.never)},
-    IQ#iq{type = result,
-	  sub_el = [#xmlel{name = <<"prefs">>,
-			   attrs = [{<<"xmlns">>, IQ#iq.xmlns},
-				    {<<"default">>, Default}],
-			   children = [Always, Never]}]};
+    PrefsEl = prefs_el(Prefs#archive_prefs.default,
+		       Prefs#archive_prefs.always,
+		       Prefs#archive_prefs.never,
+		       IQ#iq.xmlns),
+    IQ#iq{type = result, sub_el = [PrefsEl]};
 process_iq(_, _, #iq{sub_el = SubEl} = IQ) ->
     IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]}.
 
@@ -874,6 +866,22 @@ get_prefs(LUser, LServer, odbc) ->
 	    error
     end.
 
+prefs_el(Default, Always, Never, NS) ->
+    Default1 = jlib:atom_to_binary(Default),
+    JFun = fun(L) ->
+		   [#xmlel{name = <<"jid">>,
+			   children = [{xmlcdata, jid:to_string(J)}]}
+		    || J <- L]
+	   end,
+    Always1 = #xmlel{name = <<"always">>,
+		     children = JFun(Always)},
+    Never1 = #xmlel{name = <<"never">>,
+		    children = JFun(Never)},
+    #xmlel{name = <<"prefs">>,
+	   attrs = [{<<"xmlns">>, NS},
+		    {<<"default">>, Default1}],
+	   children = [Always1, Never1]}.
+
 maybe_activate_mam(LUser, LServer) ->
     ActivateOpt = gen_mod:get_module_opt(LServer, ?MODULE,
 					 request_activates_archiving,
diff --git a/test/ejabberd_SUITE.erl b/test/ejabberd_SUITE.erl
index 5054f098..c426213e 100644
--- a/test/ejabberd_SUITE.erl
+++ b/test/ejabberd_SUITE.erl
@@ -1713,7 +1713,7 @@ mam_master(Config, NS) ->
     ?recv1(#presence{}),
     wait_for_slave(Config),
     ?recv1(#presence{from = Peer}),
-    #iq{type = result, sub_els = []} =
+    #iq{type = result, sub_els = [#mam_prefs{xmlns = NS, default = roster}]} =
         send_recv(Config,
                   #iq{type = set,
                       sub_els = [#mam_prefs{xmlns = NS,
@@ -1747,7 +1747,7 @@ mam_master(Config, NS) ->
     mam_query_with(Config, Peer, NS),
     %% mam_query_with(Config, jlib:jid_remove_resource(Peer)),
     mam_query_rsm(Config, NS),
-    #iq{type = result, sub_els = []} =
+    #iq{type = result, sub_els = [#mam_prefs{xmlns = NS, default = never}]} =
         send_recv(Config, #iq{type = set,
                               sub_els = [#mam_prefs{xmlns = NS,
 						    default = never}]}),
@@ -1765,7 +1765,7 @@ mam_slave(Config, NS) ->
     wait_for_master(Config),
     send(Config, #presence{}),
     ?recv2(#presence{}, #presence{from = Peer}),
-    #iq{type = result, sub_els = []} =
+    #iq{type = result, sub_els = [#mam_prefs{xmlns = NS, default = always}]} =
         send_recv(Config,
                   #iq{type = set,
                       sub_els = [#mam_prefs{xmlns = NS, default = always}]}),
@@ -1776,7 +1776,7 @@ mam_slave(Config, NS) ->
 	      ?recv1(#message{from = Peer, body = [Text],
 			      sub_els = [#mam_archived{by = ServerJID}]})
       end, lists:seq(1, 5)),
-    #iq{type = result, sub_els = []} =
+    #iq{type = result, sub_els = [#mam_prefs{xmlns = NS, default = never}]} =
         send_recv(Config, #iq{type = set,
                               sub_els = [#mam_prefs{xmlns = NS, default = never}]}),
     disconnect(Config).