Make common tests working again

include/mam_query.hrl

@@ -0,0 +1,13 @@
+%% Created automatically by xdata generator (xdata_codec.erl)
+%% Source: mam_query.xdata
+%% Form type: urn:xmpp:mam:1
+%% Document: XEP-0313
+
+
+-type property() :: {'with', jid:jid()} |
+                    {'start', erlang:timestamp()} |
+                    {'end', erlang:timestamp()} |
+                    {'withtext', binary()}.
+-type result() :: [property()].
+
+-type form() :: [property() | xdata_field()].

specs/mam_query.cfg

@@ -0,0 +1,9 @@
+[{decode, [{<<"start">>, {xmpp_util, decode_timestamp, []}},
+	   {<<"end">>, {xmpp_util, decode_timestamp, []}}]},
+ {specs, [{<<"start">>, "erlang:timestamp()"},
+	  {<<"end">>, "erlang:timestamp()"}]}].
+
+%% Local Variables:
+%% mode: erlang
+%% End:
+%% vim: set filetype=erlang tabstop=8:

specs/mam_query.xdata

@@ -0,0 +1,23 @@
+<form_type>
+  <name>urn:xmpp:mam:1</name>
+  <doc>XEP-0313</doc>
+  <desc>Form to query message archives</desc>
+  <field var='with'
+         type='jid-single'
+         label='User JID'/>
+  <field var='start'
+	 type='text-single'
+	 label='Search from the date'/>
+  <field var='end'
+	 type='text-single'
+	 label='Search until the date'/>
+  <field var='withtext'
+	 type='text-single'
+	 label='Search the text'/>
+</form_type>
+
+<!--
+Local Variables:
+mode: xml
+End:
+-->

src/ejabberd_local.erl

@@ -177,15 +177,19 @@ unregister_iq_handler(Host, XMLNS) ->
 refresh_iq_handlers() ->
     ejabberd_local ! refresh_iq_handlers.
 
--spec bounce_resource_packet(jid(), jid(), stanza()) -> ok.
+-spec bounce_resource_packet(jid(), jid(), stanza()) -> stop.
-bounce_resource_packet(_From, _To, #presence{}) ->
+bounce_resource_packet(_From, #jid{lresource = <<"">>}, #presence{}) ->
+    ok;
+bounce_resource_packet(_From, #jid{lresource = <<"">>},
+		       #message{type = headline}) ->
     ok;
 bounce_resource_packet(From, To, Packet) ->
     Lang = xmpp:get_lang(Packet),
     Txt = <<"No available resource found">>,
     Err = xmpp:make_error(Packet,
 			  xmpp:err_item_not_found(Txt, Lang)),
-    ejabberd_router:route(To, From, Err).
+    ejabberd_router:route(To, From, Err),
+    stop.
 
 %%====================================================================
 %% gen_server callbacks
@@ -283,7 +287,7 @@ do_route(From, To, Packet) ->
 	    ejabberd_sm:route(From, To, Packet);
        is_record(Packet, iq), To#jid.lresource == <<"">> ->
 	    process_iq(From, To, Packet);
-       Type == result; Type == error; Type == headline ->
+       Type == result; Type == error ->
 	    ok;
        true ->
 	    ejabberd_hooks:run(local_send_to_resource_hook,

src/flex_offline.erl

@@ -12,7 +12,7 @@
 
 -include("flex_offline.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_int(Val, Min, Max) ->
     case list_to_integer(binary_to_list(Val)) of

src/mam_query.erl

@@ -0,0 +1,220 @@
+%% Created automatically by xdata generator (xdata_codec.erl)
+%% Source: mam_query.xdata
+%% Form type: urn:xmpp:mam:1
+%% Document: XEP-0313
+
+-module(mam_query).
+
+-export([decode/1, decode/2, encode/1, encode/2,
+	 format_error/1]).
+
+-include("xmpp_codec.hrl").
+
+-include("mam_query.hrl").
+
+-export_type([property/0, result/0, form/0]).
+
+enc_jid(J) -> jid:to_string(J).
+
+dec_jid(Val) ->
+    case jid:from_string(Val) of
+      error -> erlang:error(badarg);
+      J -> J
+    end.
+
+format_error({form_type_mismatch, Type}) ->
+    <<"FORM_TYPE doesn't match '", Type/binary, "'">>;
+format_error({bad_var_value, Var, Type}) ->
+    <<"Bad value of field '", Var/binary, "' of type '",
+      Type/binary, "'">>;
+format_error({missing_value, Var, Type}) ->
+    <<"Missing value of field '", Var/binary, "' of type '",
+      Type/binary, "'">>;
+format_error({too_many_values, Var, Type}) ->
+    <<"Too many values for field '", Var/binary,
+      "' of type '", Type/binary, "'">>;
+format_error({unknown_var, Var, Type}) ->
+    <<"Unknown field '", Var/binary, "' of type '",
+      Type/binary, "'">>;
+format_error({missing_required_var, Var, Type}) ->
+    <<"Missing required field '", Var/binary, "' of type '",
+      Type/binary, "'">>.
+
+decode(Fs) -> decode(Fs, []).
+
+decode(Fs, Acc) ->
+    case lists:keyfind(<<"FORM_TYPE">>, #xdata_field.var,
+		       Fs)
+	of
+      false -> decode(Fs, Acc, []);
+      #xdata_field{values = [<<"urn:xmpp:mam:1">>]} ->
+	  decode(Fs, Acc, []);
+      _ ->
+	  erlang:error({?MODULE,
+			{form_type_mismatch, <<"urn:xmpp:mam:1">>}})
+    end.
+
+encode(Cfg) -> encode(Cfg, fun (Text) -> Text end).
+
+encode(List, Translate) when is_list(List) ->
+    Fs = [case Opt of
+	    {with, Val} -> [encode_with(Val, Translate)];
+	    {with, _, _} -> erlang:error({badarg, Opt});
+	    {start, Val} -> [encode_start(Val, Translate)];
+	    {start, _, _} -> erlang:error({badarg, Opt});
+	    {'end', Val} -> [encode_end(Val, Translate)];
+	    {'end', _, _} -> erlang:error({badarg, Opt});
+	    {withtext, Val} -> [encode_withtext(Val, Translate)];
+	    {withtext, _, _} -> erlang:error({badarg, Opt});
+	    #xdata_field{} -> [Opt];
+	    _ -> []
+	  end
+	  || Opt <- List],
+    FormType = #xdata_field{var = <<"FORM_TYPE">>,
+			    type = hidden, values = [<<"urn:xmpp:mam:1">>]},
+    [FormType | lists:flatten(Fs)].
+
+decode([#xdata_field{var = <<"with">>, values = [Value]}
+	| Fs],
+       Acc, Required) ->
+    try dec_jid(Value) of
+      Result ->
+	  decode(Fs, [{with, Result} | Acc],
+		 lists:delete(<<"with">>, Required))
+    catch
+      _:_ ->
+	  erlang:error({?MODULE,
+			{bad_var_value, <<"with">>, <<"urn:xmpp:mam:1">>}})
+    end;
+decode([#xdata_field{var = <<"with">>, values = []} = F
+	| Fs],
+       Acc, Required) ->
+    decode([F#xdata_field{var = <<"with">>, values = [<<>>]}
+	    | Fs],
+	   Acc, Required);
+decode([#xdata_field{var = <<"with">>} | _], _, _) ->
+    erlang:error({?MODULE,
+		  {too_many_values, <<"with">>, <<"urn:xmpp:mam:1">>}});
+decode([#xdata_field{var = <<"start">>,
+		     values = [Value]}
+	| Fs],
+       Acc, Required) ->
+    try xmpp_util:decode_timestamp(Value) of
+      Result ->
+	  decode(Fs, [{start, Result} | Acc],
+		 lists:delete(<<"start">>, Required))
+    catch
+      _:_ ->
+	  erlang:error({?MODULE,
+			{bad_var_value, <<"start">>, <<"urn:xmpp:mam:1">>}})
+    end;
+decode([#xdata_field{var = <<"start">>, values = []} = F
+	| Fs],
+       Acc, Required) ->
+    decode([F#xdata_field{var = <<"start">>,
+			  values = [<<>>]}
+	    | Fs],
+	   Acc, Required);
+decode([#xdata_field{var = <<"start">>} | _], _, _) ->
+    erlang:error({?MODULE,
+		  {too_many_values, <<"start">>, <<"urn:xmpp:mam:1">>}});
+decode([#xdata_field{var = <<"end">>, values = [Value]}
+	| Fs],
+       Acc, Required) ->
+    try xmpp_util:decode_timestamp(Value) of
+      Result ->
+	  decode(Fs, [{'end', Result} | Acc],
+		 lists:delete(<<"end">>, Required))
+    catch
+      _:_ ->
+	  erlang:error({?MODULE,
+			{bad_var_value, <<"end">>, <<"urn:xmpp:mam:1">>}})
+    end;
+decode([#xdata_field{var = <<"end">>, values = []} = F
+	| Fs],
+       Acc, Required) ->
+    decode([F#xdata_field{var = <<"end">>, values = [<<>>]}
+	    | Fs],
+	   Acc, Required);
+decode([#xdata_field{var = <<"end">>} | _], _, _) ->
+    erlang:error({?MODULE,
+		  {too_many_values, <<"end">>, <<"urn:xmpp:mam:1">>}});
+decode([#xdata_field{var = <<"withtext">>,
+		     values = [Value]}
+	| Fs],
+       Acc, Required) ->
+    try Value of
+      Result ->
+	  decode(Fs, [{withtext, Result} | Acc],
+		 lists:delete(<<"withtext">>, Required))
+    catch
+      _:_ ->
+	  erlang:error({?MODULE,
+			{bad_var_value, <<"withtext">>, <<"urn:xmpp:mam:1">>}})
+    end;
+decode([#xdata_field{var = <<"withtext">>,
+		     values = []} =
+	    F
+	| Fs],
+       Acc, Required) ->
+    decode([F#xdata_field{var = <<"withtext">>,
+			  values = [<<>>]}
+	    | Fs],
+	   Acc, Required);
+decode([#xdata_field{var = <<"withtext">>} | _], _,
+       _) ->
+    erlang:error({?MODULE,
+		  {too_many_values, <<"withtext">>,
+		   <<"urn:xmpp:mam:1">>}});
+decode([#xdata_field{var = Var} | Fs], Acc, Required) ->
+    if Var /= <<"FORM_TYPE">> ->
+	   erlang:error({?MODULE,
+			 {unknown_var, Var, <<"urn:xmpp:mam:1">>}});
+       true -> decode(Fs, Acc, Required)
+    end;
+decode([], _, [Var | _]) ->
+    erlang:error({?MODULE,
+		  {missing_required_var, Var, <<"urn:xmpp:mam:1">>}});
+decode([], Acc, []) -> Acc.
+
+encode_with(Value, Translate) ->
+    Values = case Value of
+	       undefined -> [];
+	       Value -> [enc_jid(Value)]
+	     end,
+    Opts = [],
+    #xdata_field{var = <<"with">>, values = Values,
+		 required = false, type = 'jid-single', options = Opts,
+		 desc = <<>>, label = Translate(<<"User JID">>)}.
+
+encode_start(Value, Translate) ->
+    Values = case Value of
+	       undefined -> [];
+	       Value -> [Value]
+	     end,
+    Opts = [],
+    #xdata_field{var = <<"start">>, values = Values,
+		 required = false, type = 'text-single', options = Opts,
+		 desc = <<>>,
+		 label = Translate(<<"Search from the date">>)}.
+
+encode_end(Value, Translate) ->
+    Values = case Value of
+	       undefined -> [];
+	       Value -> [Value]
+	     end,
+    Opts = [],
+    #xdata_field{var = <<"end">>, values = Values,
+		 required = false, type = 'text-single', options = Opts,
+		 desc = <<>>,
+		 label = Translate(<<"Search until the date">>)}.
+
+encode_withtext(Value, Translate) ->
+    Values = case Value of
+	       <<>> -> [];
+	       Value -> [Value]
+	     end,
+    Opts = [],
+    #xdata_field{var = <<"withtext">>, values = Values,
+		 required = false, type = 'text-single', options = Opts,
+		 desc = <<>>, label = Translate(<<"Search the text">>)}.

src/mod_carboncopy.erl

@@ -228,8 +228,8 @@ complete_packet(_From, Msg, _Direction) ->
 -spec is_chat_message(stanza()) -> boolean().
 is_chat_message(#message{type = chat}) ->
     true;
-is_chat_message(#message{type = normal, body = Body}) ->
+is_chat_message(#message{type = normal, body = [_|_]}) ->
-    xmpp:get_text(Body) /= <<"">>;
+    true;
 is_chat_message(_) ->
     false.
 

src/mod_mam.erl

@@ -54,12 +54,13 @@
 -callback delete_old_messages(binary() | global,
 			      erlang:timestamp(),
 			      all | chat | groupchat) -> any().
--callback extended_fields() -> [xdata_field()].
+-callback extended_fields() -> [mam_query:property() | #xdata_field{}].
 -callback store(xmlel(), binary(), {binary(), binary()}, chat | groupchat,
 		jid(), binary(), recv | send) -> {ok, binary()} | any().
 -callback write_prefs(binary(), binary(), #archive_prefs{}, binary()) -> ok | any().
 -callback get_prefs(binary(), binary()) -> {ok, #archive_prefs{}} | error.
--callback select(binary(), jid(), jid(), mam_query(), chat | groupchat) ->
+-callback select(binary(), jid(), jid(), mam_query:result(),
+		 #rsm_set{} | undefined, chat | groupchat) ->
     {[{binary(), non_neg_integer(), xmlel()}], boolean(), non_neg_integer()}.
 
 %%%===================================================================
@@ -259,8 +260,9 @@ muc_filter_message(Pkt, #state{config = Config} = MUCState,
     end.
 
 set_stanza_id(Pkt, JID, ID) ->
-    Archived = #mam_archived{by = JID, id = ID},
+    BareJID = jid:remove_resource(JID),
-    StanzaID = #stanza_id{by = JID, id = ID},
+    Archived = #mam_archived{by = BareJID, id = ID},
+    StanzaID = #stanza_id{by = BareJID, id = ID},
     NewEls = [Archived, StanzaID|xmpp:get_els(Pkt)],
     xmpp:set_els(Pkt, NewEls).
 
@@ -308,43 +310,24 @@ muc_process_iq(#iq{type = get,
 muc_process_iq(IQ, _MUCState) ->
     IQ.
 
-parse_query(#mam_query{xdata = #xdata{fields = Fs}} = Query, Lang) ->
+parse_query(#mam_query{xmlns = ?NS_MAM_TMP,
-    try
+		       start = Start, 'end' = End,
-	lists:foldl(
+		       with = With, withtext = Text}, _Lang) ->
-	  fun(#xdata_field{var = <<"start">>, values = [Data|_]}, Q) ->
+    {ok, [{start, Start}, {'end', End},
-		  try xmpp_util:decode_timestamp(Data) of
+	  {with, With}, {withtext, Text}]};
-		      {_, _, _} = TS -> Q#mam_query{start = TS}
+parse_query(#mam_query{xdata = #xdata{}} = Query, Lang) ->
-		  catch _:{bad_timestamp, _} -> throw({error, <<"start">>})
+    X = xmpp_util:set_xdata_field(
+	  #xdata_field{var = <<"FORM_TYPE">>,
+		       type = hidden, values = [?NS_MAM_1]},
+	  Query#mam_query.xdata),
+    try	mam_query:decode(X#xdata.fields) of
+	Form -> {ok, Form}
+    catch _:{mam_query, Why} ->
+	    Txt = mam_query:format_error(Why),
+	    {error, xmpp:err_bad_request(Txt, Lang)}
     end;
-	     (#xdata_field{var = <<"end">>, values = [Data|_]}, Q) ->
+parse_query(#mam_query{}, _Lang) ->
-		  try xmpp_util:decode_timestamp(Data) of
+    {ok, []}.
-		      {_, _, _} = TS -> Q#mam_query{start = TS}
-		  catch _:{bad_timestamp, _} -> throw({error, <<"end">>})
-		  end;
-	     (#xdata_field{var = <<"with">>, values = [Data|_]}, Q) ->
-		  case jid:from_string(Data) of
-		      error -> throw({error, <<"with">>});
-		      J -> Q#mam_query{with = J}
-		  end;
-	     (#xdata_field{var = <<"withtext">>, values = [Data|_]}, Q) ->
-		  case Data of
-		      <<"">> -> throw({error, <<"withtext">>});
-		      _ -> Q#mam_query{withtext = Data}
-	      end;
-	     (#xdata_field{var = <<"FORM_TYPE">>, values = [NS|_]}, Q) ->
-		  case Query#mam_query.xmlns of
-		      NS -> Q;
-		      _ -> throw({error, <<"FORM_TYPE">>})
-		  end;
-	     (#xdata_field{}, Acc) ->
-		  Acc
-	  end, Query, Fs)
-    catch throw:{error, Var} ->
-	    Txt = io_lib:format("Incorrect value of field '~s'", [Var]),
-	    {error, xmpp:err_bad_request(iolist_to_binary(Txt), Lang)}
-    end;
-parse_query(Query, _Lang) ->
-    Query.
 
 disco_sm_features(empty, From, To, Node, Lang) ->
     disco_sm_features({result, []}, From, To, Node, Lang);
@@ -402,17 +385,16 @@ delete_old_messages(_TypeBin, _Days) ->
 %%%===================================================================
 
 process_iq(LServer, #iq{sub_els = [#mam_query{xmlns = NS}]} = IQ) ->
-    CommonFields = [#xdata_field{type = hidden,
-				 var = <<"FORM_TYPE">>,
-				 values = [NS]},
-		    #xdata_field{type = 'jid-single', var = <<"with">>},
-		    #xdata_field{type = 'text-single', var = <<"start">>},
-		    #xdata_field{type = 'text-single', var = <<"end">>}],
     Mod = gen_mod:db_mod(LServer, ?MODULE),
+    CommonFields = [{with, undefined},
+		    {start, undefined},
+		    {'end', undefined}],
     ExtendedFields = Mod:extended_fields(),
-    Fields = CommonFields ++ ExtendedFields,
+    Fields = mam_query:encode(CommonFields ++ ExtendedFields),
-    Form = #xdata{type = form, fields = Fields},
+    X = xmpp_util:set_xdata_field(
-    xmpp:make_iq_result(IQ, #mam_query{xmlns = NS, xdata = Form}).
+	  #xdata_field{var = <<"FORM_TYPE">>, type = hidden, values = [NS]},
+	  #xdata{type = form, fields = Fields}),
+    xmpp:make_iq_result(IQ, #mam_query{xmlns = NS, xdata = X}).
 
 % Preference setting (both v0.2 & v0.3)
 process_iq(#iq{type = set, lang = Lang,
@@ -457,15 +439,17 @@ process_iq(LServer, #iq{from = #jid{luser = LUser}, lang = Lang,
 	{groupchat, _Role, _MUCState} ->
 	    ok
     end,
-    case parse_query(SubEl, Lang) of
+    case SubEl of
 	#mam_query{rsm = #rsm_set{index = I}} when is_integer(I) ->
 	    xmpp:make_error(IQ, xmpp:err_feature_not_implemented());
-	#mam_query{rsm = RSM, xmlns = NS} = Query ->
+	#mam_query{rsm = RSM, xmlns = NS} ->
+	    case parse_query(SubEl, Lang) of
+		{ok, Query} ->
 		    NewRSM = limit_max(RSM, NS),
-	    NewQuery = Query#mam_query{rsm = NewRSM},
+		    select_and_send(LServer, Query, NewRSM, IQ, MsgType);
-	    select_and_send(LServer, NewQuery, IQ, MsgType);
 		{error, Err} ->
 		    xmpp:make_error(IQ, Err)
+	    end
     end.
 
 should_archive(#message{type = error}, _LServer) ->
@@ -493,57 +477,57 @@ should_archive(_, _LServer) ->
 
 -spec strip_my_archived_tag(stanza(), binary()) -> stanza().
 strip_my_archived_tag(Pkt, LServer) ->
-    NewPkt = xmpp:decode_els(
+    Els = xmpp:get_els(Pkt),
-	       Pkt, ?NS_CLIENT,
-	       fun(El) ->
-		       case xmpp:get_name(El) of
-			   <<"archived">> ->
-			       xmpp:get_ns(El) == ?NS_MAM_TMP;
-			   <<"stanza-id">> ->
-			       xmpp:get_ns(El) == ?NS_SID_0;
-			   _ ->
-			       false
-		       end
-	       end),
     NewEls = lists:filter(
-	       fun(#mam_archived{by = By}) ->
+	       fun(El) ->
+		       Name = xmpp:get_name(El),
+		       NS = xmpp:get_ns(El),
+		       if (Name == <<"archived">> andalso NS == ?NS_MAM_TMP);
+			  (Name == <<"stanza-id">> andalso NS == ?NS_SID_0) ->
+			       try xmpp:decode(El) of
+				   #mam_archived{by = By} ->
 				       By#jid.lserver /= LServer;
-		  (#stanza_id{by = By}) ->
+				   #stanza_id{by = By} ->
-		       By#jid.lserver /= LServer;
+				       By#jid.lserver /= LServer
-		  (_) ->
+			       catch _:{xmpp_codec, _} ->
+				       false
+			       end;
+			  true ->
 			       true
-	       end, xmpp:get_els(NewPkt)),
+		       end
-    xmpp:set_els(NewPkt, NewEls).
+	       end, Els),
+    xmpp:set_els(Pkt, NewEls).
 
+-spec strip_x_jid_tags(stanza()) -> stanza().
 strip_x_jid_tags(Pkt) ->
-    NewPkt = xmpp:decode_els(
+    Els = xmpp:get_els(Pkt),
-	       Pkt, ?NS_CLIENT,
+    NewEls = lists:filter(
 	       fun(El) ->
 		       case xmpp:get_name(El) of
 			   <<"x">> ->
-			       case xmpp:get_ns(El) of
+			       NS = xmpp:get_ns(El),
-				   ?NS_MUC_USER -> true;
+			       Items = if NS == ?NS_MUC_USER;
-				   ?NS_MUC_ADMIN -> true;
+					  NS == ?NS_MUC_ADMIN;
-				   ?NS_MUC_OWNER -> true;
+					  NS == ?NS_MUC_OWNER ->
-				   _ -> false
+					       try xmpp:decode(El) of
-			       end;
-			   _ ->
-			       false
-		       end
-	       end),
-    NewEls = lists:filter(
-	       fun(El) ->
-		       Items = case El of
 						   #muc_user{items = Is} -> Is;
 						   #muc_admin{items = Is} -> Is;
-				   #muc_owner{items = Is} -> Is;
+						   #muc_owner{items = Is} -> Is
-				   _ -> []
+					       catch _:{xmpp_codec, _} ->
+						       []
+					       end;
+					  true ->
+					       []
 				       end,
-		       not lists:any(fun(#muc_item{jid = JID}) ->
+			       not lists:any(
+				     fun(#muc_item{jid = JID}) ->
 					     JID /= undefined
-				     end, Items)
+				     end, Items);
-	       end, xmpp:get_els(NewPkt)),
+			   _ ->
-    xmpp:set_els(NewPkt, NewEls).
+			       true
+		       end
+	       end, Els),
+    xmpp:set_els(Pkt, NewEls).
 
 should_archive_peer(C2SState,
 		    #archive_prefs{default = Default,
@@ -625,7 +609,7 @@ has_no_store_hint(Message) ->
 -spec is_resent(message(), binary()) -> boolean().
 is_resent(Pkt, LServer) ->
     case xmpp:get_subtag(Pkt, #stanza_id{}) of
-	#stanza_id{by = #jid{luser = <<>>, lserver = LServer}} ->
+	#stanza_id{by = #jid{lserver = LServer}} ->
 	    true;
 	_ ->
 	    false
@@ -741,21 +725,22 @@ maybe_activate_mam(LUser, LServer) ->
 	    ok
     end.
 
-select_and_send(LServer, Query, #iq{from = From, to = To} = IQ, MsgType) ->
+select_and_send(LServer, Query, RSM, #iq{from = From, to = To} = IQ, MsgType) ->
     {Msgs, IsComplete, Count} =
 	case MsgType of
 	    chat ->
-		select(LServer, From, From, Query, MsgType);
+		select(LServer, From, From, Query, RSM, MsgType);
 	    {groupchat, _Role, _MUCState} ->
-		select(LServer, From, To, Query, MsgType)
+		select(LServer, From, To, Query, RSM, MsgType)
 	end,
     SortedMsgs = lists:keysort(2, Msgs),
     send(SortedMsgs, Count, IsComplete, IQ).
 
-select(_LServer, JidRequestor, JidArchive,
+select(_LServer, JidRequestor, JidArchive, Query, RSM,
-       #mam_query{start = Start, 'end' = End, rsm = RSM},
        {groupchat, _Role, #state{config = #config{mam = false},
 				 history = History}} = MsgType) ->
+    Start = proplists:get_value(start, Query),
+    End = proplists:get_value('end', Query),
     #lqueue{len = L, queue = Q} = History,
     Msgs =
 	lists:flatmap(
@@ -786,9 +771,9 @@ select(_LServer, JidRequestor, JidArchive,
 	_ ->
 	    {Msgs, true, L}
     end;
-select(LServer, JidRequestor, JidArchive, Query, MsgType) ->
+select(LServer, JidRequestor, JidArchive, Query, RSM, MsgType) ->
     Mod = gen_mod:db_mod(LServer, ?MODULE),
-    Mod:select(LServer, JidRequestor, JidArchive, Query, MsgType).
+    Mod:select(LServer, JidRequestor, JidArchive, Query, RSM, MsgType).
 
 msg_to_el(#archive_msg{timestamp = TS, packet = Pkt1, nick = Nick, peer = Peer},
 	  MsgType, JidRequestor, #jid{lserver = LServer} = JidArchive) ->

src/mod_mam_mnesia.erl

@@ -12,7 +12,7 @@
 
 %% API
 -export([init/2, remove_user/2, remove_room/3, delete_old_messages/3,
-	 extended_fields/0, store/7, write_prefs/4, get_prefs/2, select/5]).
+	 extended_fields/0, store/7, write_prefs/4, get_prefs/2, select/6]).
 
 -include_lib("stdlib/include/ms_transform.hrl").
 -include("xmpp.hrl").
@@ -132,8 +132,10 @@ get_prefs(LUser, LServer) ->
 
 select(_LServer, JidRequestor,
        #jid{luser = LUser, lserver = LServer} = JidArchive,
-       #mam_query{start = Start, 'end' = End,
+       Query, RSM, MsgType) ->
-		  with = With, rsm = RSM}, MsgType) ->
+    Start = proplists:get_value(start, Query),
+    End = proplists:get_value('end', Query),
+    With = proplists:get_value(with, Query),
     LWith = if With /= undefined -> jid:tolower(With);
 	       true -> undefined
 	    end,

src/mod_mam_sql.erl

@@ -14,7 +14,7 @@
 
 %% API
 -export([init/2, remove_user/2, remove_room/3, delete_old_messages/3,
-	 extended_fields/0, store/7, write_prefs/4, get_prefs/2, select/5]).
+	 extended_fields/0, store/7, write_prefs/4, get_prefs/2, select/6]).
 
 -include_lib("stdlib/include/ms_transform.hrl").
 -include("xmpp.hrl").
@@ -51,7 +51,7 @@ delete_old_messages(ServerHost, TimeStamp, Type) ->
     ok.
 
 extended_fields() ->
-    [#xdata_field{type = 'text-single', var = <<"withtext">>}].
+    [{withtext, <<"">>}].
 
 store(Pkt, LServer, {LUser, LHost}, Type, Peer, Nick, _Dir) ->
     TSinteger = p1_time_compat:system_time(micro_seconds),
@@ -124,12 +124,12 @@ get_prefs(LUser, LServer) ->
     end.
 
 select(LServer, JidRequestor, #jid{luser = LUser} = JidArchive,
-       MAMQuery, MsgType) ->
+       MAMQuery, RSM, MsgType) ->
     User = case MsgType of
 	       chat -> LUser;
 	       {groupchat, _Role, _MUCState} -> jid:to_string(JidArchive)
 	   end,
-    {Query, CountQuery} = make_sql_query(User, LServer, MAMQuery),
+    {Query, CountQuery} = make_sql_query(User, LServer, MAMQuery, RSM),
     % TODO from XEP-0313 v0.2: "To conserve resources, a server MAY place a
     % reasonable limit on how many stanzas may be pushed to a client in one
     % request. If a query returns a number of stanzas greater than this limit
@@ -139,7 +139,7 @@ select(LServer, JidRequestor, #jid{luser = LUser} = JidArchive,
     case {ejabberd_sql:sql_query(LServer, Query),
 	  ejabberd_sql:sql_query(LServer, CountQuery)} of
 	{{selected, _, Res}, {selected, _, [[Count]]}} ->
-	    {Max, Direction, _} = get_max_direction_id(MAMQuery#mam_query.rsm),
+	    {Max, Direction, _} = get_max_direction_id(RSM),
 	    {Res1, IsComplete} =
 		if Max >= 0 andalso Max /= undefined andalso length(Res) > Max ->
 			if Direction == before ->
@@ -194,9 +194,11 @@ usec_to_now(Int) ->
     Sec = Secs rem 1000000,
     {MSec, Sec, USec}.
 
-make_sql_query(User, LServer,
+make_sql_query(User, LServer, MAMQuery, RSM) ->
-	       #mam_query{start = Start, 'end' = End, with = With,
+    Start = proplists:get_value(start, MAMQuery),
-			  withtext = WithText, rsm = RSM}) ->
+    End = proplists:get_value('end', MAMQuery),
+    With = proplists:get_value(with, MAMQuery),
+    WithText = proplists:get_value(withtext, MAMQuery),
     {Max, Direction, ID} = get_max_direction_id(RSM),
     ODBCType = ejabberd_config:get_option(
 		 {sql_type, LServer},

src/mod_offline.erl

@@ -99,7 +99,8 @@
 -callback remove_expired_messages(binary()) -> {atomic, any()}.
 -callback remove_old_messages(non_neg_integer(), binary()) -> {atomic, any()}.
 -callback remove_user(binary(), binary()) -> {atomic, any()}.
--callback read_message_headers(binary(), binary()) -> any().
+-callback read_message_headers(binary(), binary()) ->
+    [{non_neg_integer(), jid(), jid(), undefined | erlang:timestamp(), xmlel()}].
 -callback read_message(binary(), binary(), non_neg_integer()) ->
     {ok, #offline_msg{}} | error.
 -callback remove_message(binary(), binary(), non_neg_integer()) -> ok | {error, any()}.

src/mod_offline_riak.erl

@@ -88,7 +88,7 @@ read_message_headers(LUser, LServer) ->
 		     fun(#offline_msg{from = From, to = To, packet = Pkt,
 				      timestamp = TS}) ->
 			     Seq = now_to_integer(TS),
-			     {Seq, From, To, Pkt}
+			     {Seq, From, To, TS, Pkt}
 		     end, Rs),
 	    lists:keysort(1, Hdrs);
 	_Err ->

src/mod_offline_sql.erl

@@ -103,8 +103,9 @@ read_message_headers(LUser, LServer) ->
 		      case xml_to_offline_msg(XML) of
 			  {ok, #offline_msg{from = From,
 					    to = To,
+					    timestamp = TS,
 					    packet = El}} ->
-			      [{Seq, From, To, El}];
+			      [{Seq, From, To, TS, El}];
 			  _ ->
 			      []
 		      end

src/mod_roster.erl

@@ -330,7 +330,7 @@ set_roster(#roster{us = {LUser, LServer}, jid = LJID} = Item) ->
     transaction(
       LServer,
       fun() ->
-	      roster_subscribe_t(LUser, LServer, LJID, Item)
+	      update_roster_t(LUser, LServer, LJID, Item)
       end).
 
 del_roster(LUser, LServer, LJID) ->

src/muc_register.erl

@@ -12,7 +12,7 @@
 
 -include("muc_register.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_bool(<<"1">>) -> true;
 dec_bool(<<"0">>) -> false;

src/muc_request.erl

@@ -12,7 +12,7 @@
 
 -include("muc_request.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_enum(Val, Enums) ->
     AtomVal = erlang:binary_to_existing_atom(Val, utf8),

src/muc_roomconfig.erl

@@ -12,7 +12,7 @@
 
 -include("muc_roomconfig.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_int(Val, Min, Max) ->
     case list_to_integer(binary_to_list(Val)) of

src/muc_roominfo.erl

@@ -12,7 +12,7 @@
 
 -include("muc_roominfo.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_int(Val, Min, Max) ->
     case list_to_integer(binary_to_list(Val)) of

src/pubsub_get_pending.erl

@@ -12,7 +12,7 @@
 
 -include("pubsub_get_pending.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 format_error({form_type_mismatch, Type}) ->
     <<"FORM_TYPE doesn't match '", Type/binary, "'">>;

src/pubsub_node_config.erl

@@ -12,7 +12,7 @@
 
 -include("pubsub_node_config.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_int(Val, Min, Max) ->
     case list_to_integer(binary_to_list(Val)) of

src/pubsub_publish_options.erl

@@ -12,7 +12,7 @@
 
 -include("pubsub_publish_options.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_enum(Val, Enums) ->
     AtomVal = erlang:binary_to_existing_atom(Val, utf8),

src/pubsub_subscribe_authorization.erl

@@ -12,7 +12,7 @@
 
 -include("pubsub_subscribe_authorization.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_bool(<<"1">>) -> true;
 dec_bool(<<"0">>) -> false;

src/pubsub_subscribe_options.erl

@@ -12,7 +12,7 @@
 
 -include("pubsub_subscribe_options.hrl").
 
--export_type([{property, 0}, {result, 0}, {form, 0}]).
+-export_type([property/0, result/0, form/0]).
 
 dec_enum(Val, Enums) ->
     AtomVal = erlang:binary_to_existing_atom(Val, utf8),

src/xmpp_util.erl

@@ -11,7 +11,8 @@
 %% API
 -export([add_delay_info/3, add_delay_info/4, unwrap_carbon/1,
 	 is_standalone_chat_state/1, get_xdata_values/2,
-	 has_xdata_var/2, make_adhoc_response/1, make_adhoc_response/2,
+	 set_xdata_field/2, has_xdata_var/2,
+	 make_adhoc_response/1, make_adhoc_response/2,
 	 decode_timestamp/1, encode_timestamp/1]).
 
 -include("xmpp.hrl").
@@ -78,6 +79,12 @@ get_xdata_values(Var, #xdata{fields = Fields}) ->
 	false -> []
     end.
 
+-spec set_xdata_field(xdata_field(), xdata()) -> xdata().
+set_xdata_field(Field, #xdata{fields = Fields} = X) ->
+    NewFields = lists:keystore(Field#xdata_field.var, #xdata_field.var,
+			       Fields, Field),
+    X#xdata{fields = NewFields}.
+
 -spec has_xdata_var(binary(), xdata()) -> boolean().
 has_xdata_var(Var, #xdata{fields = Fields}) ->
     lists:keymember(Var, #xdata_field.var, Fields).

test/announce_tests.erl

@@ -0,0 +1,61 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(announce_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [server_jid/1, send_recv/2, recv_message/1, disconnect/1,
+		send/2, wait_for_master/1, wait_for_slave/1]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {announce_single, [sequence], []}.
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {announce_master_slave, [sequence],
+     [master_slave_test(set_motd)]}.
+
+set_motd_master(Config) ->
+    ServerJID = server_jid(Config),
+    MotdJID = jid:replace_resource(ServerJID, <<"announce/motd">>),
+    Body = xmpp:mk_text(<<"motd">>),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_slave(Config),
+    send(Config, #message{to = MotdJID, body = Body}),
+    #message{from = ServerJID, body = Body} = recv_message(Config),
+    disconnect(Config).
+
+set_motd_slave(Config) ->
+    ServerJID = server_jid(Config),
+    Body = xmpp:mk_text(<<"motd">>),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    #message{from = ServerJID, body = Body} = recv_message(Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("announce_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("announce_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("announce_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("announce_" ++ atom_to_list(T) ++ "_slave")]}.

test/carbons_tests.erl

@@ -0,0 +1,202 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(carbons_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [is_feature_advertised/2, disconnect/1, send_recv/2,
+		recv_presence/1, send/2, get_event/1, recv_message/1,
+		my_jid/1, wait_for_slave/1, wait_for_master/1,
+		put_event/2]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {carbons_single, [sequence],
+     [single_test(feature_enabled),
+      single_test(unsupported_iq)]}.
+
+feature_enabled(Config) ->
+    true = is_feature_advertised(Config, ?NS_CARBONS_2),
+    disconnect(Config).
+
+unsupported_iq(Config) ->
+    lists:foreach(
+      fun({Type, SubEl}) ->
+	      #iq{type = error} =
+		  send_recv(Config, #iq{type = Type, sub_els = [SubEl]})
+      end, [{Type, SubEl} ||
+	       Type <- [get, set],
+	       SubEl <- [#carbons_sent{forwarded = #forwarded{}},
+			 #carbons_received{forwarded = #forwarded{}},
+			 #carbons_private{}]] ++
+	  [{get, SubEl} || SubEl <- [#carbons_enable{}, #carbons_disable{}]]),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {carbons_master_slave, [sequence],
+     [master_slave_test(send_recv),
+      master_slave_test(enable_disable)]}.
+
+send_recv_master(Config) ->
+    Peer = ?config(peer, Config),
+    prepare_master(Config),
+    ct:comment("Waiting for the peer to be ready"),
+    ready = get_event(Config),
+    send_messages(Config),
+    ct:comment("Waiting for the peer to disconnect"),
+    #presence{from = Peer, type = unavailable} = recv_presence(Config),
+    disconnect(Config).
+
+send_recv_slave(Config) ->
+    prepare_slave(Config),
+    ok = enable(Config),
+    put_event(Config, ready),
+    recv_carbons(Config),
+    disconnect(Config).
+
+enable_disable_master(Config) ->
+    prepare_master(Config),
+    ct:comment("Waiting for the peer to be ready"),
+    ready = get_event(Config),
+    send_messages(Config),
+    disconnect(Config).
+
+enable_disable_slave(Config) ->
+    Peer = ?config(peer, Config),
+    prepare_slave(Config),
+    ok = enable(Config),
+    ok = disable(Config),
+    put_event(Config, ready),
+    ct:comment("Waiting for the peer to disconnect"),
+    #presence{from = Peer, type = unavailable} = recv_presence(Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("carbons_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("carbons_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("carbons_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("carbons_" ++ atom_to_list(T) ++ "_slave")]}.
+
+prepare_master(Config) ->
+    MyJID = my_jid(Config),
+    Peer = ?config(peer, Config),
+    #presence{from = MyJID} = send_recv(Config, #presence{priority = 10}),
+    wait_for_slave(Config),
+    ct:comment("Receiving initial presence from the peer"),
+    #presence{from = Peer} = recv_presence(Config),
+    Config.
+
+prepare_slave(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = enable(Config),
+    wait_for_master(Config),
+    #presence{from = MyJID} = send_recv(Config, #presence{priority = 5}),
+    ct:comment("Receiving initial presence from the peer"),
+    #presence{from = Peer} = recv_presence(Config),
+    Config.
+
+send_messages(Config) ->
+    Server = ?config(server, Config),
+    MyJID = my_jid(Config),
+    JID = jid:make(randoms:get_string(), Server),
+    lists:foreach(
+      fun({send, #message{type = Type} = Msg}) ->
+	      I = send(Config, Msg#message{to = JID}),
+	      if Type /= error ->
+		      #message{id = I, type = error} = recv_message(Config);
+		 true ->
+		      ok
+	      end;
+	 ({recv, #message{} = Msg}) ->
+	      ejabberd_router:route(
+		JID, MyJID, Msg#message{from = JID, to = MyJID}),
+	      ct:comment("Receiving message ~s", [xmpp:pp(Msg)]),
+	      #message{} = recv_message(Config)
+      end, message_iterator(Config)).
+
+recv_carbons(Config) ->
+    Peer = ?config(peer, Config),
+    BarePeer = jid:remove_resource(Peer),
+    MyJID = my_jid(Config),
+    lists:foreach(
+      fun({_, #message{sub_els = [#hint{type = 'no-copy'}]}}) ->
+	      ok;
+	 ({_, #message{sub_els = [#carbons_private{}]}}) ->
+	      ok;
+	 ({_, #message{sub_els = [#carbons_sent{}]}}) ->
+	      ok;
+	 ({_, #message{sub_els = [#carbons_received{}]}}) ->
+	      ok;
+	 ({_, #message{type = T}}) when T /= normal, T /= chat ->
+	      ok;
+	 ({Dir, #message{type = T, body = Body} = M})
+	    when (T == chat) or (T == normal andalso Body /= []) ->
+	      ct:comment("Receiving carbon ~s", [xmpp:pp(M)]),
+	      #message{from = BarePeer, to = MyJID} = CarbonMsg =
+		  recv_message(Config),
+	      case Dir of
+		  send ->
+		      #carbons_sent{forwarded = #forwarded{xml_els = [El]}} =
+			  xmpp:get_subtag(CarbonMsg, #carbons_sent{}),
+		      #message{body = Body} = xmpp:decode(El);
+		  recv ->
+		      #carbons_received{forwarded = #forwarded{xml_els = [El]}}=
+			  xmpp:get_subtag(CarbonMsg, #carbons_received{}),
+		      #message{body = Body} = xmpp:decode(El)
+	      end;
+	 (_) ->
+	      false
+      end, message_iterator(Config)).
+
+enable(Config) ->
+    case send_recv(
+	   Config, #iq{type = set,
+		       sub_els = [#carbons_enable{}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = Err ->
+	    xmpp:get_error(Err)
+    end.
+
+disable(Config) ->
+    case send_recv(
+	   Config, #iq{type = set,
+		       sub_els = [#carbons_disable{}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = Err ->
+	    xmpp:get_error(Err)
+    end.
+
+message_iterator(_Config) ->
+    [{Dir, #message{type = Type, body = Body, sub_els = Els}}
+     || Dir <- [send, recv],
+	Type <- [error, chat, normal, groupchat, headline],
+    	Body <- [[], xmpp:mk_text(<<"body">>)],
+    	Els <- [[],
+    		[#hint{type = 'no-copy'}],
+    		[#carbons_private{}],
+    		[#carbons_sent{forwarded = #forwarded{}}],
+    		[#carbons_received{forwarded = #forwarded{}}]]].

test/csi_tests.erl

@@ -0,0 +1,147 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(csi_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [disconnect/1, wait_for_slave/1, wait_for_master/1,
+		send/2, send_recv/2, recv_presence/1, recv_message/1,
+		server_jid/1]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {csi_single, [sequence],
+     [single_test(feature_enabled)]}.
+
+feature_enabled(Config) ->
+    true = ?config(csi, Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {csi_master_slave, [sequence],
+     [master_slave_test(all)]}.
+
+all_master(Config) ->
+    Peer = ?config(peer, Config),
+    Presence = #presence{to = Peer},
+    ChatState = #message{to = Peer, thread = <<"1">>,
+			 sub_els = [#chatstate{type = active}]},
+    Message = ChatState#message{body = [#text{data = <<"body">>}]},
+    PepPayload = xmpp:encode(#presence{}),
+    PepOne = #message{
+		to = Peer,
+		sub_els =
+		    [#ps_event{
+			items =
+			    #ps_items{
+			       node = <<"foo-1">>,
+			       items =
+				   [#ps_item{
+				       id = <<"pep-1">>,
+				       xml_els = [PepPayload]}]}}]},
+    PepTwo = #message{
+		to = Peer,
+		sub_els =
+		    [#ps_event{
+			items =
+			    #ps_items{
+			       node = <<"foo-2">>,
+			       items =
+				   [#ps_item{
+				       id = <<"pep-2">>,
+				       xml_els = [PepPayload]}]}}]},
+    %% Wait for the slave to become inactive.
+    wait_for_slave(Config),
+    %% Should be queued (but see below):
+    send(Config, Presence),
+    %% Should replace the previous presence in the queue:
+    send(Config, Presence#presence{type = unavailable}),
+    %% The following two PEP stanzas should be queued (but see below):
+    send(Config, PepOne),
+    send(Config, PepTwo),
+    %% The following two PEP stanzas should replace the previous two:
+    send(Config, PepOne),
+    send(Config, PepTwo),
+    %% Should be queued (but see below):
+    send(Config, ChatState),
+    %% Should replace the previous chat state in the queue:
+    send(Config, ChatState#message{sub_els = [#chatstate{type = composing}]}),
+    %% Should be sent immediately, together with the queued stanzas:
+    send(Config, Message),
+    %% Wait for the slave to become active.
+    wait_for_slave(Config),
+    %% Should be delivered, as the client is active again:
+    send(Config, ChatState),
+    disconnect(Config).
+
+all_slave(Config) ->
+    Peer = ?config(peer, Config),
+    change_client_state(Config, inactive),
+    wait_for_master(Config),
+    #presence{from = Peer, type = unavailable, sub_els = [#delay{}]} =
+	recv_presence(Config),
+    #message{
+       from = Peer,
+       sub_els =
+	   [#ps_event{
+	       items =
+		   #ps_items{
+		      node = <<"foo-1">>,
+		      items =
+			  [#ps_item{
+			      id = <<"pep-1">>}]}},
+	    #delay{}]} = recv_message(Config),
+    #message{
+       from = Peer,
+       sub_els =
+	   [#ps_event{
+	       items =
+		   #ps_items{
+		      node = <<"foo-2">>,
+		      items =
+			  [#ps_item{
+			      id = <<"pep-2">>}]}},
+	    #delay{}]} = recv_message(Config),
+    #message{from = Peer, thread = <<"1">>,
+	     sub_els = [#chatstate{type = composing},
+			#delay{}]} = recv_message(Config),
+    #message{from = Peer, thread = <<"1">>,
+	     body = [#text{data = <<"body">>}],
+	     sub_els = [#chatstate{type = active}]} = recv_message(Config),
+    change_client_state(Config, active),
+    wait_for_master(Config),
+    #message{from = Peer, thread = <<"1">>,
+	     sub_els = [#chatstate{type = active}]} = recv_message(Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("csi_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("csi_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("csi_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("csi_" ++ atom_to_list(T) ++ "_slave")]}.
+
+change_client_state(Config, NewState) ->
+    send(Config, #csi{type = NewState}),
+    send_recv(Config, #iq{type = get, to = server_jid(Config),
+			  sub_els = [#ping{}]}).

test/example_tests.erl

@@ -0,0 +1,52 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(example_tests).
+
+%% API
+-compile(export_all).
+-import(suite, []).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {example_single, [sequence],
+     [single_test(foo)]}.
+
+foo(Config) ->
+    Config.
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {example_master_slave, [sequence],
+     [master_slave_test(foo)]}.
+
+foo_master(Config) ->
+    Config.
+
+foo_slave(Config) ->
+    Config.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("example_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("example_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("example_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("example_" ++ atom_to_list(T) ++ "_slave")]}.

test/mam_tests.erl

@@ -0,0 +1,537 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 14 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(mam_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [get_features/1, disconnect/1, my_jid/1, send_recv/2,
+		wait_for_slave/1, server_jid/1, send/2, get_features/2,
+		wait_for_master/1, recv_message/1, recv_iq/1, muc_room_jid/1,
+		muc_jid/1, is_feature_advertised/3, get_event/1, put_event/2]).
+
+-include("suite.hrl").
+-define(VERSIONS, [?NS_MAM_TMP, ?NS_MAM_0, ?NS_MAM_1]).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {mam_single, [sequence],
+     [single_test(feature_enabled),
+      single_test(get_set_prefs),
+      single_test(get_form),
+      single_test(fake_by)]}.
+
+feature_enabled(Config) ->
+    BareMyJID = jid:remove_resource(my_jid(Config)),
+    RequiredFeatures = sets:from_list(?VERSIONS),
+    ServerFeatures = sets:from_list(get_features(Config)),
+    UserFeatures = sets:from_list(get_features(Config, BareMyJID)),
+    MUCFeatures = get_features(Config, muc_jid(Config)),
+    ct:comment("Checking if all MAM server features are enabled"),
+    true = sets:is_subset(RequiredFeatures, ServerFeatures),
+    ct:comment("Checking if all MAM user features are enabled"),
+    true = sets:is_subset(RequiredFeatures, UserFeatures),
+    ct:comment("Checking if all MAM conference service features are enabled"),
+    true = lists:member(?NS_MAM_1, MUCFeatures),
+    clean(disconnect(Config)).
+
+fake_by(Config) ->
+    BareServerJID = server_jid(Config),
+    FullServerJID = jid:replace_resource(BareServerJID, randoms:get_string()),
+    FullMyJID = my_jid(Config),
+    BareMyJID = jid:remove_resource(FullMyJID),
+    Fakes = lists:flatmap(
+	      fun(JID) ->
+		      [#mam_archived{id = randoms:get_string(), by = JID},
+		       #stanza_id{id = randoms:get_string(), by = JID}]
+	      end, [BareServerJID, FullServerJID, BareMyJID, FullMyJID]),
+    Body = xmpp:mk_text(<<"body">>),
+    ForeignJID = jid:make(randoms:get_string()),
+    Archived = #mam_archived{id = randoms:get_string(), by = ForeignJID},
+    StanzaID = #stanza_id{id = randoms:get_string(), by = ForeignJID},
+    #message{body = Body, sub_els = SubEls} =
+	send_recv(Config, #message{to = FullMyJID,
+				   body = Body,
+				   sub_els = [Archived, StanzaID|Fakes]}),
+    ct:comment("Checking if only foreign tags present"),
+    [ForeignJID, ForeignJID] = lists:flatmap(
+				 fun(#mam_archived{by = By}) -> [By];
+				    (#stanza_id{by = By}) -> [By];
+				    (_) -> []
+				 end, SubEls),
+    clean(disconnect(Config)).
+
+get_set_prefs(Config) ->
+    Range = [{JID, #mam_prefs{xmlns = NS,
+			      default = Default,
+			      always = Always,
+			      never = Never}} ||
+		JID <- [undefined, server_jid(Config)],
+		NS <- ?VERSIONS,
+		Default <- [always, never, roster],
+		Always <- [[], [jid:from_string(<<"foo@bar.baz">>)]],
+		Never <- [[], [jid:from_string(<<"baz@bar.foo">>)]]],
+    lists:foreach(
+      fun({To, Prefs}) ->
+	      NS = Prefs#mam_prefs.xmlns,
+	      #iq{type = result, sub_els = [Prefs]} =
+		  send_recv(Config, #iq{type = set, to = To,
+					sub_els = [Prefs]}),
+	      #iq{type = result, sub_els = [Prefs]} =
+		  send_recv(Config, #iq{type = get, to = To,
+					sub_els = [#mam_prefs{xmlns = NS}]})
+      end, Range),
+    clean(disconnect(Config)).
+
+get_form(Config) ->
+    ServerJID = server_jid(Config),
+    Range = [{JID, NS} || JID <- [undefined, ServerJID],
+			  NS <- ?VERSIONS -- [?NS_MAM_TMP]],
+    lists:foreach(
+      fun({To, NS}) ->
+	      #iq{type = result,
+		  sub_els = [#mam_query{xmlns = NS,
+					xdata = #xdata{} = X}]} =
+		  send_recv(Config, #iq{type = get, to = To,
+					sub_els = [#mam_query{xmlns = NS}]}),
+	      [NS] = xmpp_util:get_xdata_values(<<"FORM_TYPE">>, X),
+	      true = xmpp_util:has_xdata_var(<<"with">>, X),
+	      true = xmpp_util:has_xdata_var(<<"start">>, X),
+	      true = xmpp_util:has_xdata_var(<<"end">>, X)
+      end, Range),
+    clean(disconnect(Config)).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {mam_master_slave, [sequence],
+     [master_slave_test(archived_and_stanza_id),
+      master_slave_test(query_all),
+      master_slave_test(query_with),
+      master_slave_test(query_rsm_max),
+      master_slave_test(query_rsm_after),
+      master_slave_test(query_rsm_before),
+      master_slave_test(muc)]}.
+
+archived_and_stanza_id_master(Config) ->
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_slave(Config),
+    send_messages(Config, lists:seq(1, 5)),
+    clean(disconnect(Config)).
+
+archived_and_stanza_id_slave(Config) ->
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    recv_messages(Config, lists:seq(1, 5)),
+    clean(disconnect(Config)).
+
+query_all_master(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_slave(Config),
+    send_messages(Config, lists:seq(1, 5)),
+    query_all(Config, MyJID, Peer),
+    clean(disconnect(Config)).
+
+query_all_slave(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    recv_messages(Config, lists:seq(1, 5)),
+    query_all(Config, Peer, MyJID),
+    clean(disconnect(Config)).
+
+query_with_master(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_slave(Config),
+    send_messages(Config, lists:seq(1, 5)),
+    query_with(Config, MyJID, Peer),
+    clean(disconnect(Config)).
+
+query_with_slave(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    recv_messages(Config, lists:seq(1, 5)),
+    query_with(Config, Peer, MyJID),
+    clean(disconnect(Config)).
+
+query_rsm_max_master(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_slave(Config),
+    send_messages(Config, lists:seq(1, 5)),
+    query_rsm_max(Config, MyJID, Peer),
+    clean(disconnect(Config)).
+
+query_rsm_max_slave(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    recv_messages(Config, lists:seq(1, 5)),
+    query_rsm_max(Config, Peer, MyJID),
+    clean(disconnect(Config)).
+
+query_rsm_after_master(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_slave(Config),
+    send_messages(Config, lists:seq(1, 5)),
+    query_rsm_after(Config, MyJID, Peer),
+    clean(disconnect(Config)).
+
+query_rsm_after_slave(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    recv_messages(Config, lists:seq(1, 5)),
+    query_rsm_after(Config, Peer, MyJID),
+    clean(disconnect(Config)).
+
+query_rsm_before_master(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_slave(Config),
+    send_messages(Config, lists:seq(1, 5)),
+    query_rsm_before(Config, MyJID, Peer),
+    clean(disconnect(Config)).
+
+query_rsm_before_slave(Config) ->
+    Peer = ?config(peer, Config),
+    MyJID = my_jid(Config),
+    ok = set_default(Config, always),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    recv_messages(Config, lists:seq(1, 5)),
+    query_rsm_before(Config, Peer, MyJID),
+    clean(disconnect(Config)).
+
+muc_master(Config) ->
+    Room = muc_room_jid(Config),
+    %% Joining
+    ok = muc_tests:join_new(Config),
+    %% MAM feature should not be advertised at this point,
+    %% because MAM is not enabled so far
+    false = is_feature_advertised(Config, ?NS_MAM_1, Room),
+    %% Fill in some history
+    send_messages_to_room(Config, lists:seq(1, 21)),
+    %% We now should be able to retrieve those via MAM, even though
+    %% MAM is disabled. However, only last 20 messages should be received.
+    recv_messages_from_room(Config, lists:seq(2, 21)),
+    %% Now enable MAM for the conference
+    %% Retrieve config first
+    #iq{type = result, sub_els = [#muc_owner{config = #xdata{} = RoomCfg}]} =
+        send_recv(Config, #iq{type = get, sub_els = [#muc_owner{}],
+                              to = Room}),
+    %% Find the MAM field in the config and enable it
+    NewFields = lists:flatmap(
+		  fun(#xdata_field{var = <<"mam">> = Var}) ->
+			  [#xdata_field{var = Var, values = [<<"1">>]}];
+		     (_) ->
+			  []
+		  end, RoomCfg#xdata.fields),
+    NewRoomCfg = #xdata{type = submit, fields = NewFields},
+    #iq{type = result, sub_els = []} =
+	send_recv(Config, #iq{type = set, to = Room,
+			      sub_els = [#muc_owner{config = NewRoomCfg}]}),
+    #message{from = Room, type = groupchat,
+	     sub_els = [#muc_user{status_codes = [104]}]} = recv_message(Config),
+    %% Check if MAM has been enabled
+    true = is_feature_advertised(Config, ?NS_MAM_1, Room),
+    %% We now sending some messages again
+    send_messages_to_room(Config, lists:seq(1, 5)),
+    %% And retrieve them via MAM again.
+    recv_messages_from_room(Config, lists:seq(1, 5)),
+    put_event(Config, disconnect),
+    clean(disconnect(Config)).
+
+muc_slave(Config) ->
+    disconnect = get_event(Config),
+    clean(disconnect(Config)).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("mam_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("mam_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("mam_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("mam_" ++ atom_to_list(T) ++ "_slave")]}.
+
+clean(Config) ->
+    {U, S, _} = jid:tolower(my_jid(Config)),
+    mod_mam:remove_user(U, S),
+    Config.
+
+set_default(Config, Default) ->
+    lists:foreach(
+      fun(NS) ->
+	      ct:comment("Setting default preferences of '~s' to '~s'",
+			 [NS, Default]),
+	      #iq{type = result,
+		  sub_els = [#mam_prefs{xmlns = NS, default = Default}]} =
+		  send_recv(Config, #iq{type = set,
+					sub_els = [#mam_prefs{xmlns = NS,
+							      default = Default}]})
+      end, ?VERSIONS).
+
+send_messages(Config, Range) ->
+    Peer = ?config(peer, Config),
+    lists:foreach(
+      fun(N) ->
+	      Body = xmpp:mk_text(integer_to_binary(N)),
+              send(Config, #message{to = Peer, body = Body})
+      end, Range).
+
+recv_messages(Config, Range) ->
+    Peer = ?config(peer, Config),
+    lists:foreach(
+      fun(N) ->
+	      Body = xmpp:mk_text(integer_to_binary(N)),
+	      #message{from = Peer, body = Body} = Msg =
+		  recv_message(Config),
+	      #mam_archived{by = BareMyJID} =
+		  xmpp:get_subtag(Msg, #mam_archived{}),
+	      #stanza_id{by = BareMyJID} =
+		  xmpp:get_subtag(Msg, #stanza_id{})
+      end, Range).
+
+recv_archived_messages(Config, From, To, QID, Range) ->
+    MyJID = my_jid(Config),
+    lists:foreach(
+      fun(N) ->
+	      ct:comment("Retreiving ~pth message in range ~p",
+			 [N, Range]),
+              Body = xmpp:mk_text(integer_to_binary(N)),
+              #message{to = MyJID,
+                       sub_els =
+                           [#mam_result{
+                               queryid = QID,
+                               sub_els =
+                                   [#forwarded{
+                                       delay = #delay{},
+                                       xml_els = [El]}]}]} = recv_message(Config),
+	      #message{from = From, to = To,
+		       body = Body} = xmpp:decode(El)
+      end, Range).
+
+maybe_recv_iq_result(Config, ?NS_MAM_0, I) ->
+    #iq{type = result, id = I} = recv_iq(Config);
+maybe_recv_iq_result(_, _, _) ->
+    ok.
+
+query_iq_type(?NS_MAM_TMP) -> get;
+query_iq_type(_) -> set.
+
+send_query(Config, #mam_query{xmlns = NS} = Query) ->
+    Type = query_iq_type(NS),
+    I = send(Config, #iq{type = Type, sub_els = [Query]}),
+    maybe_recv_iq_result(Config, NS, I),
+    I.
+
+recv_fin(Config, I, QueryID, ?NS_MAM_1 = NS, IsComplete) ->
+    ct:comment("Receiving fin iq for namespace '~s'", [NS]),
+    #iq{type = result, id = I,
+	sub_els = [#mam_fin{xmlns = NS,
+			    id = QueryID,
+			    complete = Complete,
+			    rsm = RSM}]} = recv_iq(Config),
+    ct:comment("Checking if complete is ~s", [IsComplete]),
+    Complete = IsComplete,
+    RSM;
+recv_fin(Config, I, QueryID, ?NS_MAM_TMP = NS, _IsComplete) ->
+    ct:comment("Receiving fin iq for namespace '~s'", [NS]),
+    #iq{type = result, id = I,
+	sub_els = [#mam_query{xmlns = NS,
+			      rsm = RSM,
+			      id = QueryID}]} = recv_iq(Config),
+    RSM;
+recv_fin(Config, _, QueryID, ?NS_MAM_0 = NS, IsComplete) ->
+    ct:comment("Receiving fin message for namespace '~s'", [NS]),
+    #message{} = FinMsg = recv_message(Config),
+    #mam_fin{xmlns = NS,
+	     id = QueryID,
+	     complete = Complete,
+	     rsm = RSM} = xmpp:get_subtag(FinMsg, #mam_fin{xmlns = NS}),
+    ct:comment("Checking if complete is ~s", [IsComplete]),
+    Complete = IsComplete,
+    RSM.
+
+send_messages_to_room(Config, Range) ->
+    MyNick = ?config(master_nick, Config),
+    Room = muc_room_jid(Config),
+    MyNickJID = jid:replace_resource(Room, MyNick),
+    lists:foreach(
+      fun(N) ->
+              Body = xmpp:mk_text(integer_to_binary(N)),
+	      #message{from = MyNickJID,
+		       type = groupchat,
+		       body = Body} =
+		  send_recv(Config, #message{to = Room, body = Body,
+					     type = groupchat})
+      end, Range).
+
+recv_messages_from_room(Config, Range) ->
+    MyNick = ?config(master_nick, Config),
+    Room = muc_room_jid(Config),
+    MyNickJID = jid:replace_resource(Room, MyNick),
+    MyJID = my_jid(Config),
+    QID = randoms:get_string(),
+    Count = length(Range),
+    I = send(Config, #iq{type = set, to = Room,
+			 sub_els = [#mam_query{xmlns = ?NS_MAM_1, id = QID}]}),
+    lists:foreach(
+      fun(N) ->
+	      Body = xmpp:mk_text(integer_to_binary(N)),
+	      #message{
+		 to = MyJID, from = Room,
+		 sub_els =
+		     [#mam_result{
+			 xmlns = ?NS_MAM_1,
+			 queryid = QID,
+			 sub_els =
+			     [#forwarded{
+				 delay = #delay{},
+				 xml_els = [El]}]}]} = recv_message(Config),
+	      #message{from = MyNickJID,
+		       type = groupchat,
+		       body = Body} = xmpp:decode(El)
+      end, Range),
+    #iq{from = Room, id = I, type = result,
+	sub_els = [#mam_fin{xmlns = ?NS_MAM_1,
+			    id = QID,
+			    rsm = #rsm_set{count = Count},
+			    complete = true}]} = recv_iq(Config).
+
+query_all(Config, From, To) ->
+    lists:foreach(
+      fun(NS) ->
+	      query_all(Config, From, To, NS)
+      end, ?VERSIONS).
+
+query_all(Config, From, To, NS) ->
+    QID = randoms:get_string(),
+    Range = lists:seq(1, 5),
+    ID = send_query(Config, #mam_query{xmlns = NS, id = QID}),
+    recv_archived_messages(Config, From, To, QID, Range),
+    #rsm_set{count = 5} = recv_fin(Config, ID, QID, NS, _Complete = true).
+
+query_with(Config, From, To) ->
+    lists:foreach(
+      fun(NS) ->
+	      query_with(Config, From, To, NS)
+      end, ?VERSIONS).
+
+query_with(Config, From, To, NS) ->
+    Peer = ?config(peer, Config),
+    BarePeer = jid:remove_resource(Peer),
+    QID = randoms:get_string(),
+    Range = lists:seq(1, 5),
+    lists:foreach(
+      fun(JID) ->
+	      ct:comment("Sending query with jid ~s", [jid:to_string(JID)]),
+	      Query = if NS == ?NS_MAM_TMP ->
+			      #mam_query{xmlns = NS, with = JID, id = QID};
+			 true ->
+			      Fs = mam_query:encode([{with, JID}]),
+			      #mam_query{xmlns = NS, id = QID,
+					 xdata = #xdata{type = submit,
+							fields = Fs}}
+		      end,
+	      ID = send_query(Config, Query),
+	      recv_archived_messages(Config, From, To, QID, Range),
+	      #rsm_set{count = 5} = recv_fin(Config, ID, QID, NS, true)
+      end, [Peer, BarePeer]).
+
+query_rsm_max(Config, From, To) ->
+    lists:foreach(
+      fun(NS) ->
+	      query_rsm_max(Config, From, To, NS)
+      end, ?VERSIONS).
+
+query_rsm_max(Config, From, To, NS) ->
+    lists:foreach(
+      fun(Max) ->
+	      QID = randoms:get_string(),
+	      Range = lists:sublist(lists:seq(1, Max), 5),
+	      Query = #mam_query{xmlns = NS, id = QID, rsm = #rsm_set{max = Max}},
+	      ID = send_query(Config, Query),
+	      recv_archived_messages(Config, From, To, QID, Range),
+	      IsComplete = Max >= 5,
+	      #rsm_set{count = 5} = recv_fin(Config, ID, QID, NS, IsComplete)
+      end, lists:seq(0, 6)).
+
+query_rsm_after(Config, From, To) ->
+    lists:foreach(
+      fun(NS) ->
+	      query_rsm_after(Config, From, To, NS)
+      end, ?VERSIONS).
+
+query_rsm_after(Config, From, To, NS) ->
+    lists:foldl(
+      fun(Range, #rsm_first{data = After}) ->
+	      ct:comment("Retrieving ~p messages after '~s'",
+			 [length(Range), After]),
+	      QID = randoms:get_string(),
+	      Query = #mam_query{xmlns = NS, id = QID,
+				 rsm = #rsm_set{'after' = After}},
+	      ID = send_query(Config, Query),
+	      recv_archived_messages(Config, From, To, QID, Range),
+	      #rsm_set{count = 5, first = First} =
+		  recv_fin(Config, ID, QID, NS, true),
+	      First
+      end, #rsm_first{}, [lists:seq(N, 5) || N <- lists:seq(1, 6)]).
+
+query_rsm_before(Config, From, To) ->
+    lists:foreach(
+      fun(NS) ->
+	      query_rsm_before(Config, From, To, NS)
+      end, ?VERSIONS).
+
+query_rsm_before(Config, From, To, NS) ->
+    lists:foldl(
+      fun(Range, Before) ->
+	      ct:comment("Retrieving ~p messages before '~s'",
+			 [length(Range), Before]),
+	      QID = randoms:get_string(),
+	      Query = #mam_query{xmlns = NS, id = QID,
+				 rsm = #rsm_set{before = Before}},
+	      ID = send_query(Config, Query),
+	      recv_archived_messages(Config, From, To, QID, Range),
+	      #rsm_set{count = 5, last = Last} =
+		  recv_fin(Config, ID, QID, NS, true),
+	      Last
+      end, <<"">>, lists:reverse([lists:seq(1, N) || N <- lists:seq(0, 5)])).

test/mix_tests.erl

@@ -0,0 +1,139 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(mix_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [mix_jid/1, mix_room_jid/1, my_jid/1, is_feature_advertised/3,
+		disconnect/1, send_recv/2, recv_message/1, send/2,
+		put_event/2, get_event/1]).
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {mix_single, [sequence],
+     [single_test(feature_enabled)]}.
+
+feature_enabled(Config) ->
+    MIX = mix_jid(Config),
+    ct:comment("Checking if ~s is set", [?NS_MIX_0]),
+    true = is_feature_advertised(Config, ?NS_MIX_0, MIX),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {mix_master_slave, [sequence],
+     [master_slave_test(all)]}.
+
+all_master(Config) ->
+    MIX = mix_jid(Config),
+    Room = mix_room_jid(Config),
+    MyJID = my_jid(Config),
+    MyBareJID = jid:remove_resource(MyJID),
+    #iq{type = result,
+	sub_els =
+	    [#disco_info{
+		identities = [#identity{category = <<"conference">>,
+					type = <<"text">>}],
+		xdata = [#xdata{type = result, fields = XFields}]}]} =
+	send_recv(Config, #iq{type = get, to = MIX, sub_els = [#disco_info{}]}),
+    true = lists:any(
+	     fun(#xdata_field{var = <<"FORM_TYPE">>,
+			      values = [?NS_MIX_SERVICEINFO_0]}) -> true;
+		(_) -> false
+	     end, XFields),
+    %% Joining
+    Nodes = [?NS_MIX_NODES_MESSAGES, ?NS_MIX_NODES_PRESENCE,
+	     ?NS_MIX_NODES_PARTICIPANTS, ?NS_MIX_NODES_SUBJECT,
+	     ?NS_MIX_NODES_CONFIG],
+    #iq{type = result,
+	sub_els = [#mix_join{subscribe = Nodes, jid = MyBareJID}]} =
+	send_recv(Config, #iq{type = set, to = Room,
+			      sub_els = [#mix_join{subscribe = Nodes}]}),
+    #message{from = Room,
+	     sub_els =
+		 [#ps_event{
+		     items = #ps_items{
+				node = ?NS_MIX_NODES_PARTICIPANTS,
+				items = [#ps_item{
+					    id = ParticipantID,
+					    xml_els = [PXML]}]}}]} =
+	recv_message(Config),
+    #mix_participant{jid = MyBareJID} = xmpp:decode(PXML),
+    %% Coming online
+    PresenceID = randoms:get_string(),
+    Presence = xmpp:encode(#presence{}),
+    #iq{type = result,
+	sub_els =
+	    [#pubsub{
+		publish = #ps_publish{
+			     node = ?NS_MIX_NODES_PRESENCE,
+			     items = [#ps_item{id = PresenceID}]}}]} =
+	send_recv(
+	  Config,
+	  #iq{type = set, to = Room,
+	      sub_els =
+		  [#pubsub{
+		      publish = #ps_publish{
+				   node = ?NS_MIX_NODES_PRESENCE,
+				   items = [#ps_item{
+					       id = PresenceID,
+					       xml_els = [Presence]}]}}]}),
+    #message{from = Room,
+	     sub_els =
+		 [#ps_event{
+		     items = #ps_items{
+				node = ?NS_MIX_NODES_PRESENCE,
+				items = [#ps_item{
+					    id = PresenceID,
+					    xml_els = [Presence]}]}}]} =
+	recv_message(Config),
+    %% Coming offline
+    send(Config, #presence{type = unavailable, to = Room}),
+    %% Receiving presence retract event
+    #message{from = Room,
+	     sub_els = [#ps_event{
+			   items = #ps_items{
+				      node = ?NS_MIX_NODES_PRESENCE,
+				      retract = PresenceID}}]} =
+	recv_message(Config),
+    %% Leaving
+    #iq{type = result, sub_els = []} =
+	send_recv(Config, #iq{type = set, to = Room, sub_els = [#mix_leave{}]}),
+    #message{from = Room,
+	     sub_els =
+		 [#ps_event{
+		     items = #ps_items{
+				node = ?NS_MIX_NODES_PARTICIPANTS,
+				retract = ParticipantID}}]} =
+	recv_message(Config),
+    put_event(Config, disconnect),
+    disconnect(Config).
+
+all_slave(Config) ->
+    disconnect = get_event(Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("mix_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("mix_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("mix_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("mix_" ++ atom_to_list(T) ++ "_slave")]}.

test/mod_legacy.erl

@@ -10,7 +10,7 @@
 -behaviour(gen_mod).
 
 %% API
--export([start/2, stop/1, process_iq/3]).
+-export([start/2, stop/1, mod_opt_type/1, depends/2, process_iq/3]).
 -include("jlib.hrl").
 
 %%%===================================================================
@@ -25,6 +25,12 @@ start(Host, Opts) ->
 stop(Host) ->
     gen_iq_handler:remove_iq_handler(ejabberd_local, Host, ?MODULE).
 
+mod_opt_type(_) ->
+    [].
+
+depends(_, _) ->
+    [].
+
 %%%===================================================================
 %%% Internal functions
 %%%===================================================================

test/privacy_tests.erl

@@ -13,7 +13,7 @@
 -import(suite, [disconnect/1, send_recv/2, get_event/1, put_event/2,
 		recv_iq/1, recv_presence/1, recv_message/1, recv/1,
 		send/2, my_jid/1, server_jid/1, get_features/1,
-		set_roster/3, del_roster/1]).
+		set_roster/3, del_roster/1, get_roster/1]).
 -include("suite.hrl").
 -include("mod_roster.hrl").
 
@@ -233,7 +233,7 @@ set_get_block(Config) ->
 %%% Master-slave cases
 %%%===================================================================
 master_slave_cases() ->
-    {privacy_master_slave, [parallel],
+    {privacy_master_slave, [sequence],
      [master_slave_test(deny_bare_jid),
       master_slave_test(deny_full_jid),
       master_slave_test(deny_server_jid),
@@ -319,7 +319,8 @@ deny_master(Config, {Type, Value}) ->
     set_roster(Config, Sub, Groups),
     lists:foreach(
       fun(Opts) ->
-	      ListName = str:format("deny-~s-~s-~p", [Type, Value, Opts]),
+	      ct:pal("Set list for ~s, ~s, ~w", [Type, Value, Opts]),
+	      ListName = randoms:get_string(),
 	      Item = #privacy_item{order = 0,
 				   action = deny,
 				   iq = proplists:get_bool(iq, Opts),

test/proxy65_tests.erl

@@ -0,0 +1,105 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(proxy65_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [disconnect/1, is_feature_advertised/3, proxy_jid/1,
+		my_jid/1, wait_for_slave/1, wait_for_master/1,
+		send_recv/2, put_event/2, get_event/1]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {proxy65_single, [sequence],
+     [single_test(feature_enabled)]}.
+
+feature_enabled(Config) ->
+    true = is_feature_advertised(Config, ?NS_BYTESTREAMS, proxy_jid(Config)),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {proxy65_master_slave, [sequence],
+     [master_slave_test(all)]}.
+
+all_master(Config) ->
+    Proxy = proxy_jid(Config),
+    MyJID = my_jid(Config),
+    Peer = ?config(slave, Config),
+    wait_for_slave(Config),
+    #presence{} = send_recv(Config, #presence{}),
+    #iq{type = result, sub_els = [#bytestreams{hosts = [StreamHost]}]} =
+        send_recv(
+          Config,
+          #iq{type = get, sub_els = [#bytestreams{}], to = Proxy}),
+    SID = randoms:get_string(),
+    Data = randoms:bytes(1024),
+    put_event(Config, {StreamHost, SID, Data}),
+    Socks5 = socks5_connect(StreamHost, {SID, MyJID, Peer}),
+    wait_for_slave(Config),
+    #iq{type = result, sub_els = []} =
+        send_recv(Config,
+                  #iq{type = set, to = Proxy,
+                      sub_els = [#bytestreams{activate = Peer, sid = SID}]}),
+    socks5_send(Socks5, Data),
+    disconnect(Config).
+
+all_slave(Config) ->
+    MyJID = my_jid(Config),
+    Peer = ?config(master, Config),
+    #presence{} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    {StreamHost, SID, Data} = get_event(Config),
+    Socks5 = socks5_connect(StreamHost, {SID, Peer, MyJID}),
+    wait_for_master(Config),
+    socks5_recv(Socks5, Data),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("proxy65_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("proxy65_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("proxy65_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("proxy65_" ++ atom_to_list(T) ++ "_slave")]}.
+
+socks5_connect(#streamhost{host = Host, port = Port},
+               {SID, JID1, JID2}) ->
+    Hash = p1_sha:sha([SID, jid:to_string(JID1), jid:to_string(JID2)]),
+    {ok, Sock} = gen_tcp:connect(binary_to_list(Host), Port,
+                                 [binary, {active, false}]),
+    Init = <<?VERSION_5, 1, ?AUTH_ANONYMOUS>>,
+    InitAck = <<?VERSION_5, ?AUTH_ANONYMOUS>>,
+    Req = <<?VERSION_5, ?CMD_CONNECT, 0,
+            ?ATYP_DOMAINNAME, 40, Hash:40/binary, 0, 0>>,
+    Resp = <<?VERSION_5, ?SUCCESS, 0, ?ATYP_DOMAINNAME,
+             40, Hash:40/binary, 0, 0>>,
+    gen_tcp:send(Sock, Init),
+    {ok, InitAck} = gen_tcp:recv(Sock, size(InitAck)),
+    gen_tcp:send(Sock, Req),
+    {ok, Resp} = gen_tcp:recv(Sock, size(Resp)),
+    Sock.
+
+socks5_send(Sock, Data) ->
+    ok = gen_tcp:send(Sock, Data).
+
+socks5_recv(Sock, Data) ->
+    {ok, Data} = gen_tcp:recv(Sock, size(Data)).

test/pubsub_tests.erl

@@ -0,0 +1,729 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(pubsub_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [pubsub_jid/1, send_recv/2, get_features/2, disconnect/1,
+		put_event/2, get_event/1, wait_for_master/1, wait_for_slave/1,
+		recv_message/1, my_jid/1, send/2, recv_presence/1, recv/1]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {pubsub_single, [sequence],
+     [single_test(test_features),
+      single_test(test_create),
+      single_test(test_configure),
+      single_test(test_delete),
+      single_test(test_get_affiliations),
+      single_test(test_get_subscriptions),
+      single_test(test_create_instant),
+      single_test(test_default),
+      single_test(test_create_configure),
+      single_test(test_publish),
+      single_test(test_auto_create),
+      single_test(test_get_items),
+      single_test(test_delete_item),
+      single_test(test_purge),
+      single_test(test_subscribe),
+      single_test(test_unsubscribe)]}.
+
+test_features(Config) ->
+    PJID = pubsub_jid(Config),
+    AllFeatures = sets:from_list(get_features(Config, PJID)),
+    NeededFeatures = sets:from_list(
+		       [?NS_PUBSUB,
+			?PUBSUB("access-open"),
+			?PUBSUB("access-authorize"),
+			?PUBSUB("create-nodes"),
+			?PUBSUB("instant-nodes"),
+			?PUBSUB("config-node"),
+			?PUBSUB("retrieve-default"),
+			?PUBSUB("create-and-configure"),
+			?PUBSUB("publish"),
+			?PUBSUB("auto-create"),
+			?PUBSUB("retrieve-items"),
+			?PUBSUB("delete-items"),
+			?PUBSUB("subscribe"),
+			?PUBSUB("retrieve-affiliations"),
+			?PUBSUB("modify-affiliations"),
+			?PUBSUB("retrieve-subscriptions"),
+			?PUBSUB("manage-subscriptions"),
+			?PUBSUB("purge-nodes"),
+			?PUBSUB("delete-nodes")]),
+    true = sets:is_subset(NeededFeatures, AllFeatures),
+    disconnect(Config).
+
+test_create(Config) ->
+    Node = ?config(pubsub_node, Config),
+    Node = create_node(Config, Node),
+    disconnect(Config).
+
+test_create_instant(Config) ->
+    Node = create_node(Config, <<>>),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_configure(Config) ->
+    Node = ?config(pubsub_node, Config),
+    NodeTitle = ?config(pubsub_node_title, Config),
+    NodeConfig = get_node_config(Config, Node),
+    MyNodeConfig = set_opts(NodeConfig,
+			    [{title, NodeTitle}]),
+    set_node_config(Config, Node, MyNodeConfig),
+    NewNodeConfig = get_node_config(Config, Node),
+    NodeTitle = proplists:get_value(title, NewNodeConfig),
+    disconnect(Config).
+
+test_default(Config) ->
+    get_default_node_config(Config),
+    disconnect(Config).
+
+test_create_configure(Config) ->
+    NodeTitle = ?config(pubsub_node_title, Config),
+    DefaultNodeConfig = get_default_node_config(Config),
+    CustomNodeConfig = set_opts(DefaultNodeConfig,
+				[{title, NodeTitle}]),
+    Node = create_node(Config, <<>>, CustomNodeConfig),
+    NodeConfig = get_node_config(Config, Node),
+    NodeTitle = proplists:get_value(title, NodeConfig),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_publish(Config) ->
+    Node = create_node(Config, <<>>),
+    publish_item(Config, Node),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_auto_create(Config) ->
+    Node = randoms:get_string(),
+    publish_item(Config, Node),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_get_items(Config) ->
+    Node = create_node(Config, <<>>),
+    ItemsIn = [publish_item(Config, Node) || _ <- lists:seq(1, 5)],
+    ItemsOut = get_items(Config, Node),
+    true = [I || #ps_item{id = I} <- lists:sort(ItemsIn)]
+	== [I || #ps_item{id = I} <- lists:sort(ItemsOut)],
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_delete_item(Config) ->
+    Node = create_node(Config, <<>>),
+    #ps_item{id = I} = publish_item(Config, Node),
+    [#ps_item{id = I}] = get_items(Config, Node),
+    delete_item(Config, Node, I),
+    [] = get_items(Config, Node),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_subscribe(Config) ->
+    Node = create_node(Config, <<>>),
+    #ps_subscription{type = subscribed} = subscribe_node(Config, Node),
+    [#ps_subscription{node = Node}] = get_subscriptions(Config),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_unsubscribe(Config) ->
+    Node = create_node(Config, <<>>),
+    subscribe_node(Config, Node),
+    [#ps_subscription{node = Node}] = get_subscriptions(Config),
+    unsubscribe_node(Config, Node),
+    [] = get_subscriptions(Config),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_get_affiliations(Config) ->
+    Nodes = lists:sort([create_node(Config, <<>>) || _ <- lists:seq(1, 5)]),
+    Affs = get_affiliations(Config),
+    Nodes = lists:sort([Node || #ps_affiliation{node = Node,
+						type = owner} <- Affs]),
+    [delete_node(Config, Node) || Node <- Nodes],
+    disconnect(Config).
+
+test_get_subscriptions(Config) ->
+    Nodes = lists:sort([create_node(Config, <<>>) || _ <- lists:seq(1, 5)]),
+    [subscribe_node(Config, Node) || Node <- Nodes],
+    Subs = get_subscriptions(Config),
+    Nodes = lists:sort([Node || #ps_subscription{node = Node} <- Subs]),
+    [delete_node(Config, Node) || Node <- Nodes],
+    disconnect(Config).
+
+test_purge(Config) ->
+    Node = create_node(Config, <<>>),
+    ItemsIn = [publish_item(Config, Node) || _ <- lists:seq(1, 5)],
+    ItemsOut = get_items(Config, Node),
+    true = [I || #ps_item{id = I} <- lists:sort(ItemsIn)]
+	== [I || #ps_item{id = I} <- lists:sort(ItemsOut)],
+    purge_node(Config, Node),
+    [] = get_items(Config, Node),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+test_delete(Config) ->
+    Node = ?config(pubsub_node, Config),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {pubsub_master_slave, [sequence],
+     [master_slave_test(publish),
+      master_slave_test(subscriptions),
+      master_slave_test(affiliations),
+      master_slave_test(authorize)]}.
+
+publish_master(Config) ->
+    Node = create_node(Config, <<>>),
+    put_event(Config, Node),
+    wait_for_slave(Config),
+    #ps_item{id = ID} = publish_item(Config, Node),
+    #ps_item{id = ID} = get_event(Config),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+publish_slave(Config) ->
+    Node = get_event(Config),
+    subscribe_node(Config, Node),
+    wait_for_master(Config),
+    #message{
+       sub_els =
+	   [#ps_event{
+	       items = #ps_items{node = Node,
+				 items = [Item]}}]} = recv_message(Config),
+    put_event(Config, Item),
+    disconnect(Config).
+
+subscriptions_master(Config) ->
+    Peer = ?config(slave, Config),
+    Node = ?config(pubsub_node, Config),
+    Node = create_node(Config, Node),
+    [] = get_subscriptions(Config, Node),
+    wait_for_slave(Config),
+    lists:foreach(
+      fun(Type) ->
+	      ok = set_subscriptions(Config, Node, [{Peer, Type}]),
+	      #ps_item{} = publish_item(Config, Node),
+	      case get_subscriptions(Config, Node) of
+		  [] when Type == none; Type == pending ->
+		      ok;
+		  [#ps_subscription{jid = Peer, type = Type}] ->
+		      ok
+	      end
+      end, [subscribed, unconfigured, pending, none]),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+subscriptions_slave(Config) ->
+    wait_for_master(Config),
+    MyJID = my_jid(Config),
+    Node = ?config(pubsub_node, Config),
+    lists:foreach(
+      fun(subscribed = Type) ->
+	      ?recv2(#message{
+			sub_els =
+			    [#ps_event{
+				subscription = #ps_subscription{
+						  node = Node,
+						  jid = MyJID,
+						  type = Type}}]},
+		     #message{sub_els = [#ps_event{}]});
+	 (Type) ->
+	      #message{
+		 sub_els =
+		     [#ps_event{
+			 subscription = #ps_subscription{
+					   node = Node,
+					   jid = MyJID,
+					   type = Type}}]} =
+		  recv_message(Config)
+      end, [subscribed, unconfigured, pending, none]),
+    disconnect(Config).
+
+affiliations_master(Config) ->
+    Peer = ?config(slave, Config),
+    BarePeer = jid:remove_resource(Peer),
+    lists:foreach(
+      fun(Aff) ->
+	      Node = <<(atom_to_binary(Aff, utf8))/binary,
+		       $-, (randoms:get_string())/binary>>,
+	      create_node(Config, Node, default_node_config(Config)),
+	      #ps_item{id = I} = publish_item(Config, Node),
+	      ok = set_affiliations(Config, Node, [{Peer, Aff}]),
+	      Affs = get_affiliations(Config, Node),
+	      case lists:keyfind(BarePeer, #ps_affiliation.jid, Affs) of
+		  false when Aff == none ->
+		      ok;
+		  #ps_affiliation{type = Aff} ->
+		      ok
+	      end,
+	      put_event(Config, {Aff, Node, I}),
+	      wait_for_slave(Config),
+	      delete_node(Config, Node)
+      end, [outcast, none, member, publish_only, publisher, owner]),
+    put_event(Config, disconnect),
+    disconnect(Config).
+
+affiliations_slave(Config) ->
+    affiliations_slave(Config, get_event(Config)).
+
+affiliations_slave(Config, {outcast, Node, ItemID}) ->
+    #stanza_error{reason = 'forbidden'} = subscribe_node(Config, Node),
+    #stanza_error{} = unsubscribe_node(Config, Node),
+    #stanza_error{reason = 'forbidden'} = get_items(Config, Node),
+    #stanza_error{reason = 'forbidden'} = publish_item(Config, Node),
+    #stanza_error{reason = 'forbidden'} = delete_item(Config, Node, ItemID),
+    #stanza_error{reason = 'forbidden'} = purge_node(Config, Node),
+    #stanza_error{reason = 'forbidden'} = get_node_config(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_node_config(Config, Node, default_node_config(Config)),
+    #stanza_error{reason = 'forbidden'} = get_subscriptions(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_subscriptions(Config, Node, [{my_jid(Config), subscribed}]),
+    #stanza_error{reason = 'forbidden'} = get_affiliations(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_affiliations(Config, Node, [{?config(master, Config), outcast},
+					{my_jid(Config), owner}]),
+    #stanza_error{reason = 'forbidden'} = delete_node(Config, Node),
+    wait_for_master(Config),
+    affiliations_slave(Config, get_event(Config));
+affiliations_slave(Config, {none, Node, ItemID}) ->
+    #ps_subscription{type = subscribed} = subscribe_node(Config, Node),
+    ok = unsubscribe_node(Config, Node),
+    %% This violates the affiliation char from section 4.1
+    [_|_] = get_items(Config, Node),
+    #stanza_error{reason = 'forbidden'} = publish_item(Config, Node),
+    #stanza_error{reason = 'forbidden'} = delete_item(Config, Node, ItemID),
+    #stanza_error{reason = 'forbidden'} = purge_node(Config, Node),
+    #stanza_error{reason = 'forbidden'} = get_node_config(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_node_config(Config, Node, default_node_config(Config)),
+    #stanza_error{reason = 'forbidden'} = get_subscriptions(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_subscriptions(Config, Node, [{my_jid(Config), subscribed}]),
+    #stanza_error{reason = 'forbidden'} = get_affiliations(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_affiliations(Config, Node, [{?config(master, Config), outcast},
+					{my_jid(Config), owner}]),
+    #stanza_error{reason = 'forbidden'} = delete_node(Config, Node),
+    wait_for_master(Config),
+    affiliations_slave(Config, get_event(Config));
+affiliations_slave(Config, {member, Node, ItemID}) ->
+    #ps_subscription{type = subscribed} = subscribe_node(Config, Node),
+    ok = unsubscribe_node(Config, Node),
+    [_|_] = get_items(Config, Node),
+    #stanza_error{reason = 'forbidden'} = publish_item(Config, Node),
+    #stanza_error{reason = 'forbidden'} = delete_item(Config, Node, ItemID),
+    #stanza_error{reason = 'forbidden'} = purge_node(Config, Node),
+    #stanza_error{reason = 'forbidden'} = get_node_config(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_node_config(Config, Node, default_node_config(Config)),
+    #stanza_error{reason = 'forbidden'} = get_subscriptions(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_subscriptions(Config, Node, [{my_jid(Config), subscribed}]),
+    #stanza_error{reason = 'forbidden'} = get_affiliations(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_affiliations(Config, Node, [{?config(master, Config), outcast},
+					{my_jid(Config), owner}]),
+    #stanza_error{reason = 'forbidden'} = delete_node(Config, Node),
+    wait_for_master(Config),
+    affiliations_slave(Config, get_event(Config));
+affiliations_slave(Config, {publish_only, Node, ItemID}) ->
+    #stanza_error{reason = 'forbidden'} = subscribe_node(Config, Node),
+    #stanza_error{} = unsubscribe_node(Config, Node),
+    #stanza_error{reason = 'forbidden'} = get_items(Config, Node),
+    #ps_item{id = _MyItemID} = publish_item(Config, Node),
+    %% BUG: This should be fixed
+    %% ?match(ok, delete_item(Config, Node, MyItemID)),
+    #stanza_error{reason = 'forbidden'} = delete_item(Config, Node, ItemID),
+    #stanza_error{reason = 'forbidden'} = purge_node(Config, Node),
+    #stanza_error{reason = 'forbidden'} = get_node_config(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_node_config(Config, Node, default_node_config(Config)),
+    #stanza_error{reason = 'forbidden'} = get_subscriptions(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_subscriptions(Config, Node, [{my_jid(Config), subscribed}]),
+    #stanza_error{reason = 'forbidden'} = get_affiliations(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_affiliations(Config, Node, [{?config(master, Config), outcast},
+					{my_jid(Config), owner}]),
+    #stanza_error{reason = 'forbidden'} = delete_node(Config, Node),
+    wait_for_master(Config),
+    affiliations_slave(Config, get_event(Config));
+affiliations_slave(Config, {publisher, Node, _ItemID}) ->
+    #ps_subscription{type = subscribed} = subscribe_node(Config, Node),
+    ok = unsubscribe_node(Config, Node),
+    [_|_] = get_items(Config, Node),
+    #ps_item{id = MyItemID} = publish_item(Config, Node),
+    ok = delete_item(Config, Node, MyItemID),
+    %% BUG: this should be fixed
+    %% #stanza_error{reason = 'forbidden'} = delete_item(Config, Node, ItemID),
+    #stanza_error{reason = 'forbidden'} = purge_node(Config, Node),
+    #stanza_error{reason = 'forbidden'} = get_node_config(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_node_config(Config, Node, default_node_config(Config)),
+    #stanza_error{reason = 'forbidden'} = get_subscriptions(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_subscriptions(Config, Node, [{my_jid(Config), subscribed}]),
+    #stanza_error{reason = 'forbidden'} = get_affiliations(Config, Node),
+    #stanza_error{reason = 'forbidden'} =
+	set_affiliations(Config, Node, [{?config(master, Config), outcast},
+					{my_jid(Config), owner}]),
+    #stanza_error{reason = 'forbidden'} = delete_node(Config, Node),
+    wait_for_master(Config),
+    affiliations_slave(Config, get_event(Config));
+affiliations_slave(Config, {owner, Node, ItemID}) ->
+    MyJID = my_jid(Config),
+    Peer = ?config(master, Config),
+    #ps_subscription{type = subscribed} = subscribe_node(Config, Node),
+    ok = unsubscribe_node(Config, Node),
+    [_|_] = get_items(Config, Node),
+    #ps_item{id = MyItemID} = publish_item(Config, Node),
+    ok = delete_item(Config, Node, MyItemID),
+    ok = delete_item(Config, Node, ItemID),
+    ok = purge_node(Config, Node),
+    [_|_] = get_node_config(Config, Node),
+    ok = set_node_config(Config, Node, default_node_config(Config)),
+    ok = set_subscriptions(Config, Node, []),
+    [] = get_subscriptions(Config, Node),
+    ok = set_affiliations(Config, Node, [{Peer, outcast}, {MyJID, owner}]),
+    [_, _] = get_affiliations(Config, Node),
+    ok = delete_node(Config, Node),
+    wait_for_master(Config),
+    affiliations_slave(Config, get_event(Config));
+affiliations_slave(Config, disconnect) ->
+    disconnect(Config).
+
+authorize_master(Config) ->
+    send(Config, #presence{}),
+    #presence{} = recv_presence(Config),
+    Peer = ?config(slave, Config),
+    PJID = pubsub_jid(Config),
+    NodeConfig = set_opts(default_node_config(Config),
+			  [{access_model, authorize}]),
+    Node = ?config(pubsub_node, Config),
+    Node = create_node(Config, Node, NodeConfig),
+    wait_for_slave(Config),
+    #message{sub_els = [#xdata{fields = F1}]} = recv_message(Config),
+    C1 = pubsub_subscribe_authorization:decode(F1),
+    Node = proplists:get_value(node, C1),
+    Peer = proplists:get_value(subscriber_jid, C1),
+    %% Deny it at first
+    Deny = #xdata{type = submit,
+		  fields = pubsub_subscribe_authorization:encode(
+			     [{node, Node},
+			      {subscriber_jid, Peer},
+			      {allow, false}])},
+    send(Config, #message{to = PJID, sub_els = [Deny]}),
+    %% We should not have any subscriptions
+    [] = get_subscriptions(Config, Node),
+    wait_for_slave(Config),
+    #message{sub_els = [#xdata{fields = F2}]} = recv_message(Config),
+    C2 = pubsub_subscribe_authorization:decode(F2),
+    Node = proplists:get_value(node, C2),
+    Peer = proplists:get_value(subscriber_jid, C2),
+    %% Now we accept is as the peer is very insisting ;)
+    Approve = #xdata{type = submit,
+		     fields = pubsub_subscribe_authorization:encode(
+				[{node, Node},
+				 {subscriber_jid, Peer},
+				 {allow, true}])},
+    send(Config, #message{to = PJID, sub_els = [Approve]}),
+    wait_for_slave(Config),
+    delete_node(Config, Node),
+    disconnect(Config).
+
+authorize_slave(Config) ->
+    Node = ?config(pubsub_node, Config),
+    MyJID = my_jid(Config),
+    wait_for_master(Config),
+    #ps_subscription{type = pending} = subscribe_node(Config, Node),
+    %% We're denied at first
+    #message{
+       sub_els =
+	   [#ps_event{
+	       subscription = #ps_subscription{type = none,
+					       jid = MyJID}}]} =
+	recv_message(Config),
+    wait_for_master(Config),
+    #ps_subscription{type = pending} = subscribe_node(Config, Node),
+    %% Now much better!
+    #message{
+       sub_els =
+	   [#ps_event{
+	       subscription = #ps_subscription{type = subscribed,
+					       jid = MyJID}}]} =
+	recv_message(Config),
+    wait_for_master(Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("pubsub_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("pubsub_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("pubsub_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("pubsub_" ++ atom_to_list(T) ++ "_slave")]}.
+
+set_opts(Config, Options) ->
+    lists:foldl(
+      fun({Opt, Val}, Acc) ->
+	      lists:keystore(Opt, 1, Acc, {Opt, Val})
+      end, Config, Options).
+
+create_node(Config, Node) ->
+    create_node(Config, Node, undefined).
+
+create_node(Config, Node, Options) ->
+    PJID = pubsub_jid(Config),
+    NodeConfig = if is_list(Options) ->
+			 #xdata{type = submit,
+				fields = pubsub_node_config:encode(Options)};
+		    true ->
+			 undefined
+		 end,
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub{create = Node,
+					  configure = {<<>>, NodeConfig}}]}) of
+	#iq{type = result, sub_els = [#pubsub{create = NewNode}]} ->
+	    NewNode;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+delete_node(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub_owner{delete = {Node, <<>>}}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+purge_node(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub_owner{purge = Node}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+get_default_node_config(Config) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = get, to = PJID,
+		       sub_els = [#pubsub_owner{default = {<<>>, undefined}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub_owner{default = {<<>>, NodeConfig}}]} ->
+	    pubsub_node_config:decode(NodeConfig#xdata.fields);
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+get_node_config(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = get, to = PJID,
+		       sub_els = [#pubsub_owner{configure = {Node, undefined}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub_owner{configure = {Node, NodeConfig}}]} ->
+	    pubsub_node_config:decode(NodeConfig#xdata.fields);
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+set_node_config(Config, Node, Options) ->
+    PJID = pubsub_jid(Config),
+    NodeConfig = #xdata{type = submit,
+			fields = pubsub_node_config:encode(Options)},
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub_owner{configure =
+						    {Node, NodeConfig}}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+publish_item(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    ItemID = randoms:get_string(),
+    Item = #ps_item{id = ItemID, xml_els = [xmpp:encode(#presence{id = ItemID})]},
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub{publish = #ps_publish{
+						       node = Node,
+						       items = [Item]}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub{publish = #ps_publish{
+					    node = Node,
+					    items = [#ps_item{id = ItemID}]}}]} ->
+	    Item;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+get_items(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = get, to = PJID,
+		       sub_els = [#pubsub{items = #ps_items{node = Node}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub{items = #ps_items{node = Node, items = Items}}]} ->
+	    Items;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+delete_item(Config, Node, I) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub{retract =
+					      #ps_retract{
+						 node = Node,
+						 items = [#ps_item{id = I}]}}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+subscribe_node(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    MyJID = my_jid(Config),
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub{subscribe = #ps_subscribe{
+							 node = Node,
+							 jid = MyJID}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub{
+			  subscription = #ps_subscription{
+					    node = Node,
+					    jid = MyJID} = Sub}]} ->
+	    Sub;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+unsubscribe_node(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    MyJID = my_jid(Config),
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub{
+				     unsubscribe = #ps_unsubscribe{
+						      node = Node,
+						      jid = MyJID}}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+get_affiliations(Config) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = get, to = PJID,
+		       sub_els = [#pubsub{affiliations = {<<>>, []}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub{affiliations = {<<>>, Affs}}]} ->
+	    Affs;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+get_affiliations(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = get, to = PJID,
+		       sub_els = [#pubsub_owner{affiliations = {Node, []}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub_owner{affiliations = {Node, Affs}}]} ->
+	    Affs;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+set_affiliations(Config, Node, JTs) ->
+    PJID = pubsub_jid(Config),
+    Affs = [#ps_affiliation{jid = J, type = T} || {J, T} <- JTs],
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub_owner{affiliations =
+						    {Node, Affs}}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+get_subscriptions(Config) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = get, to = PJID,
+		       sub_els = [#pubsub{subscriptions = {<<>>, []}}]}) of
+	#iq{type = result, sub_els = [#pubsub{subscriptions = {<<>>, Subs}}]} ->
+	    Subs;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+get_subscriptions(Config, Node) ->
+    PJID = pubsub_jid(Config),
+    case send_recv(Config,
+		   #iq{type = get, to = PJID,
+		       sub_els = [#pubsub_owner{subscriptions = {Node, []}}]}) of
+	#iq{type = result,
+	    sub_els = [#pubsub_owner{subscriptions = {Node, Subs}}]} ->
+	    Subs;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+set_subscriptions(Config, Node, JTs) ->
+    PJID = pubsub_jid(Config),
+    Subs = [#ps_subscription{jid = J, type = T} || {J, T} <- JTs],
+    case send_recv(Config,
+		   #iq{type = set, to = PJID,
+		       sub_els = [#pubsub_owner{subscriptions =
+						    {Node, Subs}}]}) of
+	#iq{type = result, sub_els = []} ->
+	    ok;
+	#iq{type = error} = IQ ->
+	    xmpp:get_subtag(IQ, #stanza_error{})
+    end.
+
+default_node_config(Config) ->
+    [{title, ?config(pubsub_node_title, Config)},
+     {notify_delete, false},
+     {send_last_published_item, never}].

test/replaced_tests.erl

@@ -0,0 +1,57 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(replaced_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [bind/1, wait_for_slave/1, wait_for_master/1, recv/1,
+		close_socket/1, disconnect/1]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {replaced_single, [sequence], []}.
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {replaced_master_slave, [sequence], []}.
+%% Disable tests for now due to a race condition
+%% because ejabberd_sm:sid() is generated in ejabberd_s2s:init()
+%%[master_slave_test(conflict)]}.
+
+conflict_master(Config0) ->
+    Config = bind(Config0),
+    wait_for_slave(Config),
+    #stream_error{reason = conflict} = recv(Config),
+    {xmlstreamend, <<"stream:stream">>} = recv(Config),
+    close_socket(Config).
+
+conflict_slave(Config0) ->
+    wait_for_master(Config0),
+    Config = bind(Config0),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("replaced_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("replaced_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("replaced_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("replaced_" ++ atom_to_list(T) ++ "_slave")]}.

test/roster_tests.erl

@@ -13,8 +13,7 @@
 -import(suite, [send_recv/2, recv_iq/1, send/2, disconnect/1, del_roster/1,
 		del_roster/2, make_iq_result/1, wait_for_slave/1,
 		wait_for_master/1, recv_presence/1, self_presence/2,
-		put_event/2, get_event/1, match_failure/2, get_roster/1,
+		put_event/2, get_event/1, match_failure/2, get_roster/1]).
-		is_feature_advertised/2]).
 -include("suite.hrl").
 -include("mod_roster.hrl").
 
@@ -132,7 +131,7 @@ version(Config) ->
 %%% Master-slave tests
 %%%===================================================================
 master_slave_cases() ->
-    {roster_master_slave, [parallel],
+    {roster_master_slave, [sequence],
      [master_slave_test(subscribe)]}.
 
 subscribe_master(Config) ->
@@ -149,6 +148,7 @@ process_subscriptions_master(Config, Actions) ->
     self_presence(Config, available),
     lists:foldl(
       fun({N, {Dir, Type}}, State) ->
+	      timer:sleep(100),
 	      if Dir == out -> put_event(Config, {N, in, Type});
 		 Dir == in -> put_event(Config, {N, out, Type})
 	      end,

test/sm_tests.erl

@@ -0,0 +1,99 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(sm_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [send/2, recv/1, close_socket/1, set_opt/3, my_jid/1,
+		recv_message/1, disconnect/1]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {sm_single, [sequence],
+     [single_test(feature_enabled),
+      single_test(enable),
+      single_test(resume),
+      single_test(resume_failed)]}.
+
+feature_enabled(Config) ->
+    true = ?config(sm, Config),
+    disconnect(Config).
+
+enable(Config) ->
+    Server = ?config(server, Config),
+    ServerJID = jid:make(<<"">>, Server, <<"">>),
+    %% Send messages of type 'headline' so the server discards them silently
+    Msg = #message{to = ServerJID, type = headline,
+		   body = [#text{data = <<"body">>}]},
+    %% Enable the session management with resumption enabled
+    send(Config, #sm_enable{resume = true, xmlns = ?NS_STREAM_MGMT_3}),
+    #sm_enabled{id = ID, resume = true} = recv(Config),
+    %% Initial request; 'h' should be 0.
+    send(Config, #sm_r{xmlns = ?NS_STREAM_MGMT_3}),
+    #sm_a{h = 0} = recv(Config),
+    %% sending two messages and requesting again; 'h' should be 3.
+    send(Config, Msg),
+    send(Config, Msg),
+    send(Config, Msg),
+    send(Config, #sm_r{xmlns = ?NS_STREAM_MGMT_3}),
+    #sm_a{h = 3} = recv(Config),
+    close_socket(Config),
+    {save_config, set_opt(sm_previd, ID, Config)}.
+
+resume(Config) ->
+    {_, SMConfig} = ?config(saved_config, Config),
+    ID = ?config(sm_previd, SMConfig),
+    Server = ?config(server, Config),
+    ServerJID = jid:make(<<"">>, Server, <<"">>),
+    MyJID = my_jid(Config),
+    Txt = #text{data = <<"body">>},
+    Msg = #message{from = ServerJID, to = MyJID, body = [Txt]},
+    %% Route message. The message should be queued by the C2S process.
+    ejabberd_router:route(ServerJID, MyJID, Msg),
+    send(Config, #sm_resume{previd = ID, h = 0, xmlns = ?NS_STREAM_MGMT_3}),
+    #sm_resumed{previd = ID, h = 3} = recv(Config),
+    #message{from = ServerJID, to = MyJID, body = [Txt]} = recv_message(Config),
+    #sm_r{} = recv(Config),
+    send(Config, #sm_a{h = 1, xmlns = ?NS_STREAM_MGMT_3}),
+    %% Send another stanza to increment the server's 'h' for sm_resume_failed.
+    send(Config, #presence{to = ServerJID}),
+    close_socket(Config),
+    {save_config, set_opt(sm_previd, ID, Config)}.
+
+resume_failed(Config) ->
+    {_, SMConfig} = ?config(saved_config, Config),
+    ID = ?config(sm_previd, SMConfig),
+    ct:sleep(5000), % Wait for session to time out.
+    send(Config, #sm_resume{previd = ID, h = 1, xmlns = ?NS_STREAM_MGMT_3}),
+    #sm_failed{reason = 'item-not-found', h = 4} = recv(Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {sm_master_slave, [sequence], []}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("sm_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("sm_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("sm_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("sm_" ++ atom_to_list(T) ++ "_slave")]}.

test/suite.erl

@@ -488,8 +488,9 @@ decode(El, NS, Opts) ->
 	       [format_element(El), xmpp:pp(Pkt)]),
 	Pkt
     catch _:{xmpp_codec, Why} ->
-	    ct:fail("recv failed: ~p->~n~s",
+	    ct:pal("recv failed: ~p->~n~s",
-		    [El, xmpp:format_error(Why)])
+		   [El, xmpp:format_error(Why)]),
+	    erlang:error({xmpp_codec, Why})
     end.
 
 send_text(Config, Text) ->

test/vcard_tests.erl

@@ -0,0 +1,125 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2016, Evgeny Khramtsov
+%%% @doc
+%%%
+%%% @end
+%%% Created : 16 Nov 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(vcard_tests).
+
+%% API
+-compile(export_all).
+-import(suite, [send_recv/2, disconnect/1, is_feature_advertised/2,
+		is_feature_advertised/3,
+		my_jid/1, wait_for_slave/1, wait_for_master/1,
+		recv_presence/1, recv/1]).
+
+-include("suite.hrl").
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+%%%===================================================================
+%%% Single user tests
+%%%===================================================================
+single_cases() ->
+    {vcard_single, [sequence],
+     [single_test(feature_enabled),
+      single_test(get_set)]}.
+
+feature_enabled(Config) ->
+    BareMyJID = jid:remove_resource(my_jid(Config)),
+    true = is_feature_advertised(Config, ?NS_VCARD),
+    true = is_feature_advertised(Config, ?NS_VCARD, BareMyJID),
+    disconnect(Config).
+
+get_set(Config) ->
+    VCard =
+        #vcard_temp{fn = <<"Peter Saint-Andre">>,
+		    n = #vcard_name{family = <<"Saint-Andre">>,
+				    given = <<"Peter">>},
+		    nickname = <<"stpeter">>,
+		    bday = <<"1966-08-06">>,
+		    adr = [#vcard_adr{work = true,
+				      extadd = <<"Suite 600">>,
+				      street = <<"1899 Wynkoop Street">>,
+				      locality = <<"Denver">>,
+				      region = <<"CO">>,
+				      pcode = <<"80202">>,
+				      ctry = <<"USA">>},
+			   #vcard_adr{home = true,
+				      locality = <<"Denver">>,
+				      region = <<"CO">>,
+				      pcode = <<"80209">>,
+				      ctry = <<"USA">>}],
+		    tel = [#vcard_tel{work = true,voice = true,
+				      number = <<"303-308-3282">>},
+			   #vcard_tel{home = true,voice = true,
+				      number = <<"303-555-1212">>}],
+		    email = [#vcard_email{internet = true,pref = true,
+					  userid = <<"stpeter@jabber.org">>}],
+		    jabberid = <<"stpeter@jabber.org">>,
+		    title = <<"Executive Director">>,role = <<"Patron Saint">>,
+		    org = #vcard_org{name = <<"XMPP Standards Foundation">>},
+		    url = <<"http://www.xmpp.org/xsf/people/stpeter.shtml">>,
+		    desc = <<"More information about me is located on my "
+			     "personal website: http://www.saint-andre.com/">>},
+    #iq{type = result, sub_els = []} =
+        send_recv(Config, #iq{type = set, sub_els = [VCard]}),
+    %% TODO: check if VCard == VCard1.
+    #iq{type = result, sub_els = [_VCard1]} =
+        send_recv(Config, #iq{type = get, sub_els = [#vcard_temp{}]}),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Master-slave tests
+%%%===================================================================
+master_slave_cases() ->
+    {vcard_master_slave, [sequence], []}.
+   %%[master_slave_test(xupdate)]}.
+
+xupdate_master(Config) ->
+    Img = <<137, "PNG\r\n", 26, $\n>>,
+    ImgHash = p1_sha:sha(Img),
+    MyJID = my_jid(Config),
+    Peer = ?config(slave, Config),
+    wait_for_slave(Config),
+    #presence{from = MyJID, type = available} = send_recv(Config, #presence{}),
+    #presence{from = Peer, type = available} = recv_presence(Config),
+    VCard = #vcard_temp{photo = #vcard_photo{type = <<"image/png">>, binval = Img}},
+    #iq{type = result, sub_els = []} =
+	send_recv(Config, #iq{type = set, sub_els = [VCard]}),
+    #presence{from = MyJID, type = available,
+	      sub_els = [#vcard_xupdate{hash = ImgHash}]} = recv_presence(Config),
+    #iq{type = result, sub_els = []} =
+	send_recv(Config, #iq{type = set, sub_els = [#vcard_temp{}]}),
+    ?recv2(#presence{from = MyJID, type = available,
+		     sub_els = [#vcard_xupdate{hash = undefined}]},
+	   #presence{from = Peer, type = unavailable}),
+    disconnect(Config).
+
+xupdate_slave(Config) ->
+    Img = <<137, "PNG\r\n", 26, $\n>>,
+    ImgHash = p1_sha:sha(Img),
+    MyJID = my_jid(Config),
+    Peer = ?config(master, Config),
+    #presence{from = MyJID, type = available} = send_recv(Config, #presence{}),
+    wait_for_master(Config),
+    #presence{from = Peer, type = available} = recv_presence(Config),
+    #presence{from = Peer, type = available,
+	      sub_els = [#vcard_xupdate{hash = ImgHash}]} = recv_presence(Config),
+    #presence{from = Peer, type = available,
+	      sub_els = [#vcard_xupdate{hash = undefined}]} = recv_presence(Config),
+    disconnect(Config).
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+single_test(T) ->
+    list_to_atom("vcard_" ++ atom_to_list(T)).
+
+master_slave_test(T) ->
+    {list_to_atom("vcard_" ++ atom_to_list(T)), [parallel],
+     [list_to_atom("vcard_" ++ atom_to_list(T) ++ "_master"),
+      list_to_atom("vcard_" ++ atom_to_list(T) ++ "_slave")]}.