From 1114a35e0abb960e6a6020e834928961f3627ddd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pawe=C5=82=20Chmielowski?= <pawel@process-one.net>
Date: Fri, 14 Apr 2023 12:19:38 +0200
Subject: [PATCH] Recognize message retractions in mod_muc

---
 mix.exs              |  2 +-
 rebar.config         |  2 +-
 src/mod_muc_room.erl | 60 +++++++++++++++++++++++++++++++++++++++-----
 3 files changed, 56 insertions(+), 8 deletions(-)

diff --git a/mix.exs b/mix.exs
index 38cba9790..7e63787c7 100644
--- a/mix.exs
+++ b/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: "9ba5f2b3a66f929c5a9e455e9124b8752ada4b43", override: true},
+     {:xmpp, git: "https://github.com/processone/xmpp.git", ref: "46b6c192d353e60e13a5cf8ed467c5696729b624", override: true},
      {:yconf, "~> 1.0"}]
     ++ cond_deps()
   end
diff --git a/rebar.config b/rebar.config
index f1fdd07df..cb3200ac7 100644
--- a/rebar.config
+++ b/rebar.config
@@ -73,7 +73,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.7"}}}},
-        {xmpp, ".*", {git, "https://github.com/processone/xmpp", "9ba5f2b3a66f929c5a9e455e9124b8752ada4b43"}},
+        {xmpp, ".*", {git, "https://github.com/processone/xmpp", "46b6c192d353e60e13a5cf8ed467c5696729b624"}},
         {yconf, ".*", {git, "https://github.com/processone/yconf", {tag, "1.0.15"}}}
        ]}.
 
diff --git a/src/mod_muc_room.erl b/src/mod_muc_room.erl
index 2be5b4a78..3093de248 100644
--- a/src/mod_muc_room.erl
+++ b/src/mod_muc_room.erl
@@ -1074,19 +1074,20 @@ process_groupchat_message(#message{from = From, lang = Lang} = Packet, StateData
 			     Node = if Subject == [] -> ?NS_MUCSUB_NODES_MESSAGES;
 				       true -> ?NS_MUCSUB_NODES_SUBJECT
 				    end,
+			     NewStateData2 = check_message_for_retractions(NewPacket1, NewStateData1),
 			     send_wrapped_multiple(
 			       jid:replace_resource(StateData#state.jid, FromNick),
 			       get_users_and_subscribers_with_node(Node, StateData),
-			       NewPacket, Node, NewStateData1),
-			     NewStateData2 = case has_body_or_subject(NewPacket) of
+			       NewPacket, Node, NewStateData2),
+			     NewStateData3 = case has_body_or_subject(NewPacket) of
 					       true ->
 						   add_message_to_history(FromNick, From,
 									  NewPacket,
-									  NewStateData1);
+									  NewStateData2);
 					       false ->
-						   NewStateData1
+						   NewStateData2
 					     end,
-			     {next_state, normal_state, NewStateData2}
+			     {next_state, normal_state, NewStateData3}
 		       end;
 		   _ ->
 		       Err = case (StateData#state.config)#config.allow_change_subj of
@@ -1118,6 +1119,34 @@ process_groupchat_message(#message{from = From, lang = Lang} = Packet, StateData
 	  {next_state, normal_state, StateData}
     end.
 
+-spec check_message_for_retractions(Packet :: message(), State :: state()) -> state().
+check_message_for_retractions(Packet,
+			  #state{config = Config, jid = JID, server_host = Server} = State) ->
+    case xmpp:get_subtag(Packet, #fasten_apply_to{}) of
+	#fasten_apply_to{id = ID} = F ->
+	    case xmpp:get_subtag(F, #message_retract{}) of
+		#message_retract{} ->
+		    #jid{luser = U, lserver = S} = xmpp:get_from(Packet),
+		    case remove_from_history({U, S}, ID, State) of
+			{NewState, StanzaId} when is_integer(StanzaId) ->
+			    case Config#config.mam of
+				true ->
+				    JIDs = jid:encode(JID),
+				    mod_mam:remove_message_from_archive(JIDs, Server, StanzaId),
+				    NewState;
+				_ ->
+				    NewState
+			    end;
+			{NewState, _} ->
+			    NewState
+		    end;
+		_ ->
+		    State
+	    end;
+	_ ->
+	    State
+    end.
+
 -spec add_stanza_id(Packet :: message(), State :: state()) -> message().
 add_stanza_id(Packet, #state{jid = JID}) ->
     {AddId, NewPacket} =
@@ -2910,6 +2939,25 @@ remove_from_history(StanzaId, #state{history = #lqueue{queue = Queue} = LQueue}
 	end, p1_queue:new(), Queue),
     StateData#state{history = LQueue#lqueue{queue = NewQ}}.
 
+remove_from_history({U1, S1}, OriginId, #state{history = #lqueue{queue = Queue} = LQueue} = StateData) ->
+    {NewQ, StanzaId} = p1_queue:foldl(
+	fun({_, Pkt, _, _, _} = Entry, {Q, none}) ->
+	    case jid:tolower(xmpp:get_from(Pkt)) of
+		{U2, S2, _} when U1 == U2, S1 == S2 ->
+		    case xmpp:get_subtag(Pkt, #origin_id{}) of
+			#origin_id{id = V} when V == OriginId ->
+			    {Q, xmpp:get_meta(Pkt, stanza_id, missing)};
+			_ ->
+			    {p1_queue:in(Entry, Q), none}
+		    end;
+		_ ->
+		    {p1_queue:in(Entry, Q), none}
+	    end;
+	   (Entry, {Q, S}) ->
+	       {p1_queue:in(Entry, Q), S}
+	end, {p1_queue:new(), none}, Queue),
+    {StateData#state{history = LQueue#lqueue{queue = NewQ}}, StanzaId}.
+
 -spec send_history(jid(), [lqueue_elem()], state()) -> ok.
 send_history(JID, History, StateData) ->
     lists:foreach(
@@ -4285,7 +4333,7 @@ maybe_forget_room(StateData) ->
 make_disco_info(_From, StateData) ->
     Config = StateData#state.config,
     Feats = [?NS_VCARD, ?NS_MUC, ?NS_DISCO_INFO, ?NS_DISCO_ITEMS,
-             ?NS_COMMANDS, ?NS_MESSAGE_MODERATE,
+             ?NS_COMMANDS, ?NS_MESSAGE_MODERATE, ?NS_MESSAGE_RETRACT,
 	     ?CONFIG_OPT_TO_FEATURE((Config#config.public),
 				    <<"muc_public">>, <<"muc_hidden">>),
 	     ?CONFIG_OPT_TO_FEATURE((Config#config.persistent),