Support for XEP-0424 "Message Retraction"

include/mod_mam.hrl

@@ -26,7 +26,8 @@
 	 bare_peer = {<<"">>, <<"">>, <<"">>} :: ljid(),
 	 packet = #xmlel{}                    :: xmlel() | message(),
 	 nick = <<"">>                        :: binary(),
-	 type = chat                          :: chat | groupchat}).
+	 type = chat                          :: chat | groupchat,
+         origin_id                            :: binary()}).
 
 -record(archive_prefs,
 	{us = {<<"">>, <<"">>} :: {binary(), binary()},

mix.exs

@@ -114,7 +114,7 @@ defmodule Ejabberd.MixProject do
      {:p1_utils, "~> 1.0"},
      {:pkix, "~> 1.0"},
      {:stringprep, ">= 1.0.26"},
-     {:xmpp, git: "https://github.com/processone/xmpp.git", ref: "ded8be8c169487688b11130eda566b1377ab3301", override: true},
+     {:xmpp, git: "https://github.com/processone/xmpp.git", ref: "26dd833dcf66ebb790d9afe212b7a26f3a6c2328", override: true},
      {:yconf, "~> 1.0"}]
     ++ cond_deps()
   end

rebar.config

@@ -77,7 +77,7 @@
         {stringprep, ".*", {git, "https://github.com/processone/stringprep", {tag, "1.0.29"}}},
         {if_var_true, stun,
          {stun, ".*", {git, "https://github.com/processone/stun", {tag, "1.2.10"}}}},
-        {xmpp, ".*", {git, "https://github.com/processone/xmpp", "ded8be8c169487688b11130eda566b1377ab3301"}},
+        {xmpp, ".*", {git, "https://github.com/processone/xmpp", "26dd833dcf66ebb790d9afe212b7a26f3a6c2328"}},
         {yconf, ".*", {git, "https://github.com/processone/yconf", {tag, "1.0.15"}}}
        ]}.
 

src/mod_mam.erl

@@ -69,7 +69,8 @@
 			      all | chat | groupchat) -> any().
 -callback extended_fields() -> [mam_query:property() | #xdata_field{}].
 -callback store(xmlel(), binary(), {binary(), binary()}, chat | groupchat,
-		jid(), binary(), recv | send, integer()) -> ok | any().
+		jid(), binary(), recv | send, integer(), binary(),
+                {true, binary()} | false) -> ok | any().
 -callback write_prefs(binary(), binary(), #archive_prefs{}, binary()) -> ok | any().
 -callback get_prefs(binary(), binary()) -> {ok, #archive_prefs{}} | error | {error, db_failure}.
 -callback select(binary(), jid(), jid(), mam_query:result(),
@@ -512,6 +513,17 @@ set_stanza_id(Pkt, JID, ID) ->
     NewEls = [Archived, StanzaID|xmpp:get_els(Pkt)],
     xmpp:set_els(Pkt, NewEls).
 
+-spec get_origin_id(stanza()) -> binary().
+get_origin_id(#message{type = groupchat} = Pkt) ->
+    integer_to_binary(get_stanza_id(Pkt));
+get_origin_id(#message{} = Pkt) ->
+    case xmpp:get_subtag(Pkt, #origin_id{}) of
+        #origin_id{id = ID} ->
+            ID;
+        _ ->
+            xmpp:get_id(Pkt)
+    end.
+
 -spec mark_stored_msg(message(), jid()) -> message().
 mark_stored_msg(#message{meta = #{stanza_id := ID}} = Pkt, JID) ->
     Pkt1 = set_stanza_id(Pkt, JID, integer_to_binary(ID)),
@@ -585,7 +597,8 @@ disco_sm_features(empty, From, To, Node, Lang) ->
 disco_sm_features({result, OtherFeatures},
 		  #jid{luser = U, lserver = S},
 		  #jid{luser = U, lserver = S}, <<"">>, _Lang) ->
-    {result, [?NS_MAM_TMP, ?NS_MAM_0, ?NS_MAM_1, ?NS_MAM_2, ?NS_SID_0 |
+    {result, [?NS_MAM_TMP, ?NS_MAM_0, ?NS_MAM_1, ?NS_MAM_2, ?NS_SID_0,
+              ?NS_MESSAGE_RETRACT |
 	      OtherFeatures]};
 disco_sm_features(Acc, _From, _To, _Node, _Lang) ->
     Acc.
@@ -1038,9 +1051,16 @@ store_mam_message(Pkt, U, S, Peer, Nick, Type, Dir) ->
     LServer = ejabberd_router:host_of_route(S),
     US = {U, S},
     ID = get_stanza_id(Pkt),
+    OriginID = get_origin_id(Pkt),
+    Retract = case xmpp:get_subtag(Pkt, #message_retract{}) of
+                  #message_retract{id = RID} when RID /= <<"">> ->
+                      {true, RID};
+                  _ ->
+                      false
+              end,
     El = xmpp:encode(Pkt),
     Mod = gen_mod:db_mod(LServer, ?MODULE),
-    Mod:store(El, LServer, US, Type, Peer, Nick, Dir, ID),
+    Mod:store(El, LServer, US, Type, Peer, Nick, Dir, ID, OriginID, Retract),
     Pkt.
 
 write_prefs(LUser, LServer, Host, Default, Always, Never) ->

src/mod_mam_mnesia.erl

@@ -28,8 +28,10 @@
 
 %% API
 -export([init/2, remove_user/2, remove_room/3, delete_old_messages/3,
-	 extended_fields/0, store/8, write_prefs/4, get_prefs/2, select/6, remove_from_archive/3,
+	 extended_fields/0, store/10, write_prefs/4, get_prefs/2, select/6,
-	 is_empty_for_user/2, is_empty_for_room/3, delete_old_messages_batch/5]).
+         remove_from_archive/3,
+	 is_empty_for_user/2, is_empty_for_room/3, delete_old_messages_batch/5,
+         transform/1]).
 
 -include_lib("stdlib/include/ms_transform.hrl").
 -include_lib("xmpp/include/xmpp.hrl").
@@ -187,7 +189,8 @@ delete_old_messages_batch(LServer, TimeStamp, Type, Batch, LastUS) ->
 extended_fields() ->
     [].
 
-store(Pkt, _, {LUser, LServer}, Type, Peer, Nick, _Dir, TS) ->
+store(Pkt, _, {LUser, LServer}, Type, Peer, Nick, _Dir, TS,
+      OriginID, _Retract) ->
     case {mnesia:table_info(archive_msg, disc_only_copies),
 	  mnesia:table_info(archive_msg, memory)} of
 	{[_|_], TableSize} when TableSize > ?TABLE_SIZE_LIMIT ->
@@ -205,7 +208,8 @@ store(Pkt, _, {LUser, LServer}, Type, Peer, Nick, _Dir, TS) ->
 				       bare_peer = {PUser, PServer, <<>>},
 				       type = Type,
 				       nick = Nick,
-				       packet = Pkt})
+				       packet = Pkt,
+                                       origin_id = OriginID})
 		end,
 	    case mnesia:transaction(F) of
 		{atomic, ok} ->
@@ -330,3 +334,16 @@ filter_by_max(Msgs, Len) when is_integer(Len), Len >= 0 ->
     {lists:sublist(Msgs, Len), length(Msgs) =< Len};
 filter_by_max(_Msgs, _Junk) ->
     {[], true}.
+
+transform({archive_msg, US, ID, Timestamp, Peer, BarePeer,
+           Packet, Nick, Type}) ->
+    #archive_msg{
+       us = US,
+       id = ID,
+       timestamp = Timestamp,
+       peer = Peer,
+       bare_peer = BarePeer,
+       packet = Packet,
+       nick = Nick,
+       type = Type,
+       origin_id = <<"">>}.

src/mod_mam_sql.erl

@@ -29,7 +29,7 @@
 
 %% API
 -export([init/2, remove_user/2, remove_room/3, delete_old_messages/3,
-	 extended_fields/0, store/8, write_prefs/4, get_prefs/2, select/7, export/1, remove_from_archive/3,
+	 extended_fields/0, store/10, write_prefs/4, get_prefs/2, select/7, export/1, remove_from_archive/3,
 	 is_empty_for_user/2, is_empty_for_room/3, select_with_mucsub/6,
 	 delete_old_messages_batch/4, count_messages_to_delete/3]).
 
@@ -49,6 +49,61 @@ init(Host, _Opts) ->
 
 schemas() ->
     [#sql_schema{
+        version = 2,
+        tables =
+            [#sql_table{
+                name = <<"archive">>,
+                columns =
+                    [#sql_column{name = <<"username">>, type = text},
+                     #sql_column{name = <<"server_host">>, type = text},
+                     #sql_column{name = <<"timestamp">>, type = bigint},
+                     #sql_column{name = <<"peer">>, type = text},
+                     #sql_column{name = <<"bare_peer">>, type = text},
+                     #sql_column{name = <<"xml">>, type = {text, big}},
+                     #sql_column{name = <<"txt">>, type = {text, big}},
+                     #sql_column{name = <<"id">>, type = bigserial},
+                     #sql_column{name = <<"kind">>, type = {text, 10}},
+                     #sql_column{name = <<"nick">>, type = text},
+                     #sql_column{name = <<"origin_id">>, type = text},
+                     #sql_column{name = <<"created_at">>, type = timestamp,
+                                 default = true}],
+                indices = [#sql_index{
+                              columns = [<<"server_host">>, <<"username">>, <<"timestamp">>]},
+                           #sql_index{
+                              columns = [<<"server_host">>, <<"username">>, <<"peer">>]},
+                           #sql_index{
+                              columns = [<<"server_host">>, <<"username">>, <<"bare_peer">>]},
+                           #sql_index{
+                              columns = [<<"server_host">>, <<"timestamp">>]},
+                           #sql_index{
+                              columns = [<<"server_host">>, <<"username">>, <<"origin_id">>]}
+                          ],
+                post_create =
+                    fun(mysql, _) ->
+                            ejabberd_sql:sql_query_t(
+                              <<"CREATE FULLTEXT INDEX i_archive_txt ON archive(txt);">>);
+                       (_, _) ->
+                            ok
+                    end},
+             #sql_table{
+                name = <<"archive_prefs">>,
+                columns =
+                    [#sql_column{name = <<"username">>, type = text},
+                     #sql_column{name = <<"server_host">>, type = text},
+                     #sql_column{name = <<"def">>, type = text},
+                     #sql_column{name = <<"always">>, type = text},
+                     #sql_column{name = <<"never">>, type = text},
+                     #sql_column{name = <<"created_at">>, type = timestamp,
+                                 default = true}],
+                indices = [#sql_index{
+                              columns = [<<"server_host">>, <<"username">>],
+                              unique = true}]}],
+        update =
+            [{add_column, <<"archive">>, <<"origin_id">>},
+             {create_index, <<"archive">>,
+              [<<"server_host">>, <<"username">>, <<"origin_id">>]}
+            ]},
+     #sql_schema{
         version = 1,
         tables =
             [#sql_table{
@@ -200,7 +255,8 @@ delete_old_messages(ServerHost, TimeStamp, Type) ->
 extended_fields() ->
     [{withtext, <<"">>}].
 
-store(Pkt, LServer, {LUser, LHost}, Type, Peer, Nick, _Dir, TS) ->
+store(Pkt, LServer, {LUser, LHost}, Type, Peer, Nick, _Dir, TS,
+      OriginID, Retract) ->
     SUser = case Type of
 		chat -> LUser;
 		groupchat -> jid:encode({LUser, LHost, <<>>})
@@ -223,8 +279,19 @@ store(Pkt, LServer, {LUser, LHost}, Type, Peer, Nick, _Dir, TS) ->
 	      _ ->
 		  fxml:element_to_binary(Pkt)
 	  end,
-	case SqlType of
+    case Retract of
-	  mssql -> case ejabberd_sql:sql_query(
+        {true, RID} ->
+            ejabberd_sql:sql_query(
+              LServer,
+              ?SQL("delete from archive"
+                   " where username=%(SUser)s"
+                   " and %(LServer)H"
+                   " and bare_peer=%(BarePeer)s"
+                   " and origin_id=%(RID)s"));
+        false -> ok
+    end,
+    case SqlType of
+        mssql -> case ejabberd_sql:sql_query(
 	           LServer,
 	           ?SQL_INSERT(
 	              "archive",
@@ -236,13 +303,14 @@ store(Pkt, LServer, {LUser, LHost}, Type, Peer, Nick, _Dir, TS) ->
 	               "xml=N%(XML)s",
 	               "txt=N%(Body)s",
 	               "kind=%(SType)s",
-	               "nick=%(Nick)s"])) of
+	               "nick=%(Nick)s",
+	               "origin_id=%(OriginID)s"])) of
 		{updated, _} ->
 		    ok;
 		Err ->
 		    Err
 	    end;
-	    _ -> case ejabberd_sql:sql_query(
+        _ -> case ejabberd_sql:sql_query(
 	           LServer,
 	           ?SQL_INSERT(
 	              "archive",
@@ -254,13 +322,14 @@ store(Pkt, LServer, {LUser, LHost}, Type, Peer, Nick, _Dir, TS) ->
 	               "xml=%(XML)s",
 	               "txt=%(Body)s",
 	               "kind=%(SType)s",
-	               "nick=%(Nick)s"])) of
+	               "nick=%(Nick)s",
+	               "origin_id=%(OriginID)s"])) of
 		{updated, _} ->
 		    ok;
 		Err ->
 		    Err
 	    end
-	end.
+    end.
 
 write_prefs(LUser, _LServer, #archive_prefs{default = Default,
 					   never = Never,
@@ -420,7 +489,7 @@ export(_Server) ->
      {archive_msg,
       fun([Host | HostTail], #archive_msg{us ={LUser, LServer},
                 id = _ID, timestamp = TS, peer = Peer,
-                type = Type, nick = Nick, packet = Pkt})
+                type = Type, nick = Nick, packet = Pkt, origin_id = OriginID})
           when (LServer == Host) or ([LServer] == HostTail)  ->
                 TStmp = misc:now_to_usec(TS),
                 SUser = case Type of
@@ -444,7 +513,8 @@ export(_Server) ->
 	                     "xml=N%(XML)s",
 	                     "txt=N%(Body)s",
 	                     "kind=%(SType)s",
-	                     "nick=%(Nick)s"])];
+	                     "nick=%(Nick)s",
+                             "origin_id=%(OriginID)s"])];
 	                _ -> [?SQL_INSERT(
 	                    "archive",
 	                    ["username=%(SUser)s",
@@ -455,7 +525,8 @@ export(_Server) ->
 	                     "xml=%(XML)s",
 	                     "txt=%(Body)s",
 	                     "kind=%(SType)s",
-	                     "nick=%(Nick)s"])]
+	                     "nick=%(Nick)s",
+                             "origin_id=%(OriginID)s"])]
 		            end;
          (_Host, _R) ->
               []

src/mod_muc_room.erl

@@ -5181,7 +5181,7 @@ process_iq_moderate(From, #iq{type = set, lang = Lang},
 				      sub_els = [
 					  #fasten_apply_to{id = Id, sub_els = [
 					      #message_moderated{by = By, reason = Reason,
-								 retract = #message_retract{}}
+								 retract = #message_retract{id = Id}}
 					  ]}]},
 	            {FromNick, _Role} = get_participant_data(From, StateData),
                     Packet = ejabberd_hooks:run_fold(muc_filter_message,