Support XEP-0191 Simple Communications Blocking (thanks to Stephan Maka)(EJAB-695)

6 files changed, 411 insertions, 13 deletions

diff --git a/doc/guide.tex b/doc/guide.tex
index ef8f39dfe..ba403ce2a 100644
--- a/doc/guide.tex
+++ b/doc/guide.tex
@@ -66,6 +66,7 @@
 \newcommand{\module}[1]{\texttt{#1}}
 \newcommand{\modadhoc}{\module{mod\_adhoc}}
 \newcommand{\modannounce}{\module{mod\_announce}}
+\newcommand{\modblocking}{\module{mod\_blocking}}
 \newcommand{\modcaps}{\module{mod\_caps}}
 \newcommand{\modconfigure}{\module{mod\_configure}}
 \newcommand{\moddisco}{\module{mod\_disco}}
@@ -2582,6 +2583,7 @@ The following table lists all modules included in \ejabberd{}.
     \hline
     \hline \modadhoc{} & Ad-Hoc Commands (\xepref{0050}) &  \\
     \hline \ahrefloc{modannounce}{\modannounce{}} & Manage announcements & recommends \modadhoc{} \\
+    \hline \modblocking{} & Simple Communications Blocking (\xepref{0191}) & \modprivacy{} \\
     \hline \modcaps{} &  Entity Capabilities (\xepref{0115}) & \\
     \hline \modconfigure{} & Server configuration using Ad-Hoc & \modadhoc{} \\
     \hline \ahrefloc{moddisco}{\moddisco{}} & Service Discovery (\xepref{0030}) &  \\
diff --git a/src/ejabberd.cfg.example b/src/ejabberd.cfg.example
index 603064f6b..a33dff219 100644
--- a/src/ejabberd.cfg.example
+++ b/src/ejabberd.cfg.example
@@ -513,6 +513,7 @@
  [
   {mod_adhoc,    []},
   {mod_announce, [{access, announce}]}, % recommends mod_adhoc
+  {mod_blocking,[]}, % requires mod_privacy
   {mod_caps,     []}, % 1 proc/host
   {mod_configure,[]}, % requires mod_adhoc
   {mod_disco,    []},
diff --git a/src/ejabberd_c2s.erl b/src/ejabberd_c2s.erl
index b08685c0f..c84b95279 100644
--- a/src/ejabberd_c2s.erl
+++ b/src/ejabberd_c2s.erl
@@ -1077,7 +1077,9 @@ session_established2(El, StateData) ->
 		end;
 	    #xmlel{ns = ?NS_JABBER_CLIENT, name = 'iq'} ->
 		case exmpp_iq:xmlel_to_iq(El) of
-		    #iq{kind = request, ns = ?NS_PRIVACY} = IQ_Rec ->
+		    #iq{kind = request, ns = Xmlns} = IQ_Rec
+			    when Xmlns == ?NS_PRIVACY;
+				 Xmlns == ?NS_BLOCKING ->
 			process_privacy_iq(
 			  FromJID, ToJID, IQ_Rec, StateData);
 		    _ ->
@@ -1342,6 +1344,13 @@ handle_info({route, From, To, Packet}, StateName, StateData) ->
 				send_element(StateData, PrivPushEl),
 				{false, Attrs, StateData#state{privacy_list = NewPL}}
 			end;
+		    blocking ->
+			CDataString = exmpp_xml:get_cdata_as_list(Packet),
+			{ok, A2, _} = erl_scan:string(CDataString),
+			{_, W} = erl_parse:parse_exprs(A2),
+			{value, What, []} = erl_eval:exprs(W, []),
+			route_blocking(What, StateData),
+			{false, Attrs, StateData};
 		    _ ->
 			{false, Attrs, StateData}
 		end;
@@ -2274,6 +2283,35 @@ bounce_messages() ->
     end.
 
 
+%%%----------------------------------------------------------------------
+%%% XEP-0191
+%%%----------------------------------------------------------------------
+
+route_blocking(What, StateData) ->
+    SubEl =
+	case What of
+	    {Action, JIDs} when (Action == block) or (Action == unblock) ->
+		UnblockJids =
+		    lists:map(
+		      fun(JidString) ->
+			      exmpp_xml:set_attribute(#xmlel{ns = ?NS_BLOCKING,
+							     name = item},
+						      <<"jid">>,
+						      JidString)
+		      end, JIDs),
+		#xmlel{ns = ?NS_BLOCKING, name = Action,
+		       children = UnblockJids};
+	    unblock_all ->
+		#xmlel{ns = ?NS_BLOCKING, name = 'unblock'}
+	end,
+    El1 = exmpp_iq:set(?NS_BLOCKING, SubEl, random),
+    El2 = exmpp_stanza:set_sender(El1, exmpp_jid:bare(StateData#state.jid)),
+    El3 = exmpp_stanza:set_recipient(El2, StateData#state.jid),
+    send_element(StateData, El3),
+    %% No need to replace active privacy list here,
+    %% blocking pushes are always accompanied by
+    %% Privacy List pushes
+    ok.
 
 %%%----------------------------------------------------------------------
 %%% JID Set memory footprint reduction code
diff --git a/src/mod_blocking.erl b/src/mod_blocking.erl
new file mode 100644
index 000000000..bcbb12973
--- /dev/null
+++ b/src/mod_blocking.erl
@@ -0,0 +1,349 @@
+%%%----------------------------------------------------------------------
+%%% File    : mod_blocking.erl
+%%% Author  : Stephan Maka
+%%% Purpose : XEP-0191: Simple Communications Blocking
+%%% Created : 24 Aug 2008 by Stephan Maka <stephan@spaceboyz.net>
+%%%
+%%%
+%%% ejabberd, Copyright (C) 2002-2011   ProcessOne
+%%%
+%%% This program is free software; you can redistribute it and/or
+%%% modify it under the terms of the GNU General Public License as
+%%% published by the Free Software Foundation; either version 2 of the
+%%% License, or (at your option) any later version.
+%%%
+%%% This program is distributed in the hope that it will be useful,
+%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
+%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+%%% General Public License for more details.
+%%%
+%%% You should have received a copy of the GNU General Public License
+%%% along with this program; if not, write to the Free Software
+%%% Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+%%% 02111-1307 USA
+%%%
+%%%----------------------------------------------------------------------
+
+-module(mod_blocking).
+
+-behaviour(gen_mod).
+
+-export([start/2, stop/1,
+	 process_iq/3,
+	 process_iq_set/4,
+	 process_iq_get/5]).
+
+-include("ejabberd.hrl").
+-include("jlib.hrl").
+-include_lib("exmpp/include/exmpp.hrl").
+-include("mod_privacy.hrl").
+
+start(Host, Opts) ->
+    HostB = list_to_binary(Host),
+    IQDisc = gen_mod:get_opt(iqdisc, Opts, one_queue),
+    ejabberd_hooks:add(privacy_iq_get, HostB,
+		       ?MODULE, process_iq_get, 40),
+    ejabberd_hooks:add(privacy_iq_set, HostB,
+		       ?MODULE, process_iq_set, 40),
+    mod_disco:register_feature(HostB, ?NS_BLOCKING),
+    gen_iq_handler:add_iq_handler(ejabberd_sm, HostB, ?NS_BLOCKING,
+				  ?MODULE, process_iq, IQDisc).
+
+stop(Host) ->
+    HostB = list_to_binary(Host),
+    ejabberd_hooks:delete(privacy_iq_get, HostB,
+			  ?MODULE, process_iq_get, 40),
+    ejabberd_hooks:delete(privacy_iq_set, HostB,
+			  ?MODULE, process_iq_set, 40),
+    mod_disco:unregister_feature(HostB, ?NS_BLOCKING),
+    gen_iq_handler:remove_iq_handler(ejabberd_sm, HostB, ?NS_BLOCKING).
+
+process_iq(_From, _To, IQ_Rec) ->
+    exmpp_iq:error(IQ_Rec, 'not-allowed').
+
+process_iq_get(_, From, _To, #iq{ns = ?NS_BLOCKING, payload = SubEl}, _) ->
+    case SubEl#xmlel.name == blocklist of
+	true ->
+	    LUser = exmpp_jid:prep_node(From),
+	    LServer = exmpp_jid:prep_domain(From),
+	    process_blocklist_get(LUser, LServer);
+	false ->
+	    {error, 'bad-request'}
+    end;
+
+process_iq_get(Acc, _, _, _, _) ->
+    Acc.
+
+process_iq_set(_, From, _To, #iq{ns = ?NS_BLOCKING,
+				 payload = #xmlel{name = SubElName,
+						  children = SubEls}}) ->
+    LUser = exmpp_jid:prep_node(From),
+    LServer = exmpp_jid:prep_domain(From),
+    case {SubElName, exmpp_xml:remove_cdata_from_list(SubEls)} of
+	{block, []} ->
+	    {error, 'bad-request'};
+	{block, Els} ->
+	    JIDs = parse_blocklist_items(Els, []),
+	    process_blocklist_block(LUser, LServer, JIDs);
+	{unblock, []} ->
+	    process_blocklist_unblock_all(LUser, LServer);
+	{unblock, Els} ->
+	    JIDs = parse_blocklist_items(Els, []),
+	    process_blocklist_unblock(LUser, LServer, JIDs);
+	_ ->
+	    {error, 'bad-request'}
+    end;
+
+process_iq_set(Acc, _, _,  _) ->
+    Acc.
+
+is_list_needdb(Items) ->
+    lists:any(
+      fun(X) ->
+	      case X#listitem.type of
+		  subscription -> true;
+		  group -> true;
+		  _ -> false
+	      end
+      end, Items).
+
+get_list_blocklist_jids(LUser, LServer, Name) ->
+    Tuples = gen_storage:dirty_select(LServer, privacy_list_data,
+				      [{'=', user_host, {LUser, LServer}},
+				       {'=', name, Name},
+				       {'=', type, jid}]),
+    [Tuple#privacy_list_data.value ||
+	Tuple <- Tuples, Tuple#privacy_list_data.match_all == true].
+
+parse_blocklist_items([], JIDs) ->
+    JIDs;
+
+parse_blocklist_items([#xmlel{name = item} = El | Els], JIDs) ->
+    case exmpp_xml:get_attribute(El, <<"jid">>, false) of
+	false ->
+	    %% Tolerate missing jid attribute
+	    parse_blocklist_items(Els, JIDs);
+	JID1 ->
+	    JID = exmpp_jid:to_binary(exmpp_jid:parse(JID1)),
+	    parse_blocklist_items(Els, [JID | JIDs])
+    end;
+
+parse_blocklist_items([_ | Els], JIDs) ->
+    %% Tolerate unknown elements
+    parse_blocklist_items(Els, JIDs).
+
+process_blocklist_block(LUser, LServer, JIDs) ->
+    F =
+	fun() ->
+		case gen_storage:read(LServer, {privacy_list, {LUser, LServer}}) of
+		    [] ->
+			%% No lists yet
+			%% TODO: i18n here:
+			Default = <<"Blocked contacts">>,
+			gen_storage:write(LServer,
+					  #privacy_list{
+					    user_host = {LUser, LServer},
+					    name = Default}),
+			gen_storage:write(LServer,
+					  #privacy_default_list{
+					    user_host = {LUser, LServer},
+					    name = Default}),
+			ok;
+		    _Lists ->
+			case gen_storage:read(LServer,
+					      {privacy_default_list, {LUser, LServer}}) of
+			    [#privacy_default_list{name = Default}] ->
+				%% Default list exists
+				Default;
+			    [] ->
+				%% No default list yet, create one
+				%% TODO: i18n here:
+				Default = <<"Blocked contacts">>,
+				gen_storage:write(LServer,
+						  #privacy_list{
+						    user_host = {LUser, LServer},
+						    name = Default}),
+				gen_storage:write(LServer,
+						  #privacy_default_list{
+						    user_host = {LUser, LServer},
+						    name = Default})
+			end
+		end,
+		AlreadyBlocked = get_list_blocklist_jids(LUser, LServer, Default),
+		NewItems = lists:foldr(fun(JID, Res) ->
+					       case lists:member(JID, AlreadyBlocked) of
+						   true ->
+						       Res;
+						   false ->
+						       Data = #privacy_list_data{
+							 user_host = {LUser, LServer},
+							 name = Default,
+							 type = jid,
+							 value = JID,
+							 action = deny,
+							 order = 0,
+							 match_all = true
+							},
+						       gen_storage:write(LServer, Data),
+						       [Data | Res]
+					       end
+				       end, [], JIDs),
+		{ok, Default, NewItems}
+	end,
+    case gen_storage:transaction(LServer, privacy_list_data, F) of
+	{atomic, {error, _} = Error} ->
+	    Error;
+	{atomic, {ok, Default, Data}} ->
+	    %%		Data = gen_storage:select(LServer, privacy_list_data,
+	    %%				  [{'=', user_host, {LUser, LServer}},
+	    %%				   {'=', name, Default}]),
+	    List = list_data_to_items(Data),
+	    broadcast_list_update(LUser, LServer, Default, List),
+	    broadcast_blocklist_event(LUser, LServer, {block, JIDs}),
+	    {result, []};
+	Error ->
+	    ?DEBUG("Error ~n~p", [Error]),
+	    {error, 'internal-server-error'}
+    end.
+
+%%Copied from mod_privacy
+%% storage representation to ejabberd representation
+list_data_to_items(Data) ->
+    List =
+	lists:map(
+	  fun(Data1) ->
+		  #listitem{type = Data1#privacy_list_data.type,
+			    value = Data1#privacy_list_data.value,
+			    action = Data1#privacy_list_data.action,
+			    order = Data1#privacy_list_data.order,
+			    match_all = Data1#privacy_list_data.match_all,
+			    match_iq = Data1#privacy_list_data.match_iq,
+			    match_message = Data1#privacy_list_data.match_message,
+			    match_presence_in = Data1#privacy_list_data.match_presence_in,
+			    match_presence_out = Data1#privacy_list_data.match_presence_out}
+	  end, Data),
+    SortedList = lists:keysort(#listitem.order, List),
+    SortedList.
+
+process_blocklist_unblock_all(LUser, LServer) ->
+    F =
+	fun() ->
+		case gen_storage:read(LServer, {privacy_list, {LUser, LServer}}) of
+		    [] ->
+			%% No lists, nothing to unblock
+			ok;
+		    _ ->
+			case gen_storage:read(LServer, {privacy_default_list, {LUser, LServer}}) of
+			    [#privacy_default_list{name = Default}] ->
+				%% Default list, remove all deny items
+				gen_storage:delete_where(LServer, privacy_list_data,
+							 [{'=', user_host, {LUser, LServer}},
+							  {'=', name, Default},
+							  {'=', action, deny},
+							  {'=', match_all, true},
+							  {'=', type, jid}]),
+				Data = gen_storage:select(LServer, privacy_list_data,
+							  [{'=', user_host, {LUser, LServer}},
+							   {'=', name, Default}]),
+				{ok, Default, Data};
+			    [] ->
+				%% No default list, nothing to unblock
+				ok
+			end
+		end
+	end,
+    case gen_storage:transaction(LServer, privacy_list_data, F) of
+	{atomic, {error, _} = Error} ->
+	    Error;
+	{atomic, ok} ->
+	    {result, []};
+	{atomic, {ok, Default, Data}} ->
+	    List = list_data_to_items(Data),
+	    broadcast_list_update(LUser, LServer, Default, List),
+	    broadcast_blocklist_event(LUser, LServer, unblock_all),
+	    {result, []};
+	_ ->
+	    {error, 'internal-server-error'}
+    end.
+
+process_blocklist_unblock(LUser, LServer, JIDs) ->
+    F =
+	fun() ->
+		case gen_storage:read(LServer, {privacy_list, {LUser, LServer}}) of
+		    [] ->
+			%% No lists, nothing to unblock
+			ok;
+		    _ ->
+			case gen_storage:read(LServer, {privacy_default_list, {LUser, LServer}}) of
+			    [#privacy_default_list{name = Default}] ->
+				%% Default list, remove matching deny items
+				lists:foreach(
+				  fun(JID) ->
+					  gen_storage:delete_where(LServer, privacy_list_data,
+								   [{'=', user_host, {LUser, LServer}},
+								    {'=', name, Default},
+								    {'=', action, deny},
+								    {'=', match_all, true},
+								    {'=', value, JID},
+								    {'=', type, jid}])
+				  end, JIDs),
+				Data = gen_storage:select(LServer, privacy_list_data,
+							  [{'=', user_host, {LUser, LServer}},
+							   {'=', name, Default}]),
+				{ok, Default, Data};
+			    [] ->
+				%% No default list, nothing to unblock
+				ok
+			end
+		end
+	end,
+    case gen_storage:transaction(LServer, privacy_list_data, F) of
+	{atomic, {error, _} = Error} ->
+	    Error;
+	{atomic, ok} ->
+	    {result, []};
+	{atomic, {ok, Default, Data}} ->
+	    List = list_data_to_items(Data),
+	    broadcast_list_update(LUser, LServer, Default, List),
+	    broadcast_blocklist_event(LUser, LServer, {unblock, JIDs}),
+	    {result, []};
+	_ ->
+	    {error, 'internal-server-error'}
+    end.
+
+broadcast_list_update(LUser, LServer, Name, List) ->
+    NeedDb = is_list_needdb(List),
+    JID = exmpp_jid:make(LUser, LServer),
+    ListString = lists:flatten(io_lib:format("~p.", [#userlist{name = Name, list = List, needdb = NeedDb}])),
+    ejabberd_router:route(
+      JID,
+      JID,
+      #xmlel{name = 'broadcast', ns = privacy_list,
+	     attrs = [?XMLATTR(<<"list_name">>, Name)],
+	     children = [exmpp_xml:cdata(ListString)]}).
+
+broadcast_blocklist_event(LUser, LServer, Event) ->
+    JID = exmpp_jid:make(LUser, LServer),
+    EventString = lists:flatten(io_lib:format("~p.", [Event])),
+    ejabberd_router:route(
+      JID, JID,
+      #xmlel{name = 'broadcast', ns = blocking,
+             children = [exmpp_xml:cdata(EventString)]}).
+
+process_blocklist_get(LUser, LServer) ->
+    case catch gen_storage:dirty_read(LServer, privacy_default_list, {LUser, LServer}) of
+	{'EXIT', _Reason} ->
+	    {error, 'internal-server-error'};
+	[] ->
+	    {result, #xmlel{name = 'blocklist', ns = ?NS_BLOCKING}};
+	[#privacy_default_list{name = Default}] ->
+	    JIDs = get_list_blocklist_jids(LUser, LServer, Default),
+	    Items = lists:map(
+		      fun(JID) ->
+			      ?DEBUG("JID: ~p",[JID]),
+			      #xmlel{name = item, ns = privacy_list,
+				     attrs = [?XMLATTR(<<"jid">>, JID)]}
+		      end, JIDs),
+	    {result,
+	     #xmlel{name = 'blocklist', ns = ?NS_BLOCKING, children = Items}}
+    end.
diff --git a/src/mod_privacy.erl b/src/mod_privacy.erl
index b514a75a5..168fc8a6d 100644
--- a/src/mod_privacy.erl
+++ b/src/mod_privacy.erl
@@ -1,7 +1,7 @@
 %%%----------------------------------------------------------------------
 %%% File    : mod_privacy.erl
 %%% Author  : Alexey Shchepin <alexey@process-one.net>
-%%% Purpose : jabber:iq:privacy support
+%%% Purpose : XEP-0016: Privacy Lists
 %%% Created : 21 Jul 2003 by Alexey Shchepin <alexey@process-one.net>
 %%%
 %%%
@@ -118,13 +118,6 @@
 -include("ejabberd.hrl").
 -include("mod_privacy.hrl").
 
--record(privacy_list, {user_host, name}).
--record(privacy_default_list, {user_host, name}).
--record(privacy_list_data, {user_host, name,
-			    type, value, action, order,
-			    match_all, match_iq, match_message,
-			    match_presence_in, match_presence_out}).
-
 start(Host, Opts) ->
     HostB = list_to_binary(Host),
     IQDisc = gen_mod:get_opt(iqdisc, Opts, one_queue),
@@ -194,7 +187,7 @@ process_iq(_From, _To, IQ_Rec) ->
     exmpp_iq:error(IQ_Rec, 'not-allowed').
 
 
-process_iq_get(_, From, _To, #iq{payload = SubEl},
+process_iq_get(_, From, _To, #iq{ns = ?NS_PRIVACY, payload = SubEl},
 	       #userlist{name = Active}) ->
     LUser = exmpp_jid:prep_node(From),
     LServer = exmpp_jid:prep_domain(From),
@@ -211,8 +204,10 @@ process_iq_get(_, From, _To, #iq{payload = SubEl},
 	    end;
 	_ ->
 	    {error, 'bad-request'}
-    end.
+    end;
 
+process_iq_get(Acc, _, _, _, _) ->
+    Acc.
 
 process_lists_get(LUser, LServer, Active) ->
     F = fun() ->
@@ -352,7 +347,7 @@ list_to_action(S) ->
 
 
 
-process_iq_set(_, From, _To, #iq{payload = SubEl}) ->
+process_iq_set(_, From, _To, #iq{ns = ?NS_PRIVACY, payload = SubEl}) ->
     LUser = exmpp_jid:prep_node(From),
     LServer = exmpp_jid:prep_domain(From),
     case exmpp_xml:get_child_elements(SubEl) of
@@ -371,7 +366,10 @@ process_iq_set(_, From, _To, #iq{payload = SubEl}) ->
 	    end;
 	_ ->
 	    {error, 'bad-request'}
-    end.
+    end;
+
+process_iq_set(Acc, _, _, _) ->
+    Acc.
 
 
 process_default_set(LUser, LServer, false) ->
diff --git a/src/mod_privacy.hrl b/src/mod_privacy.hrl
index e5daf1def..c9366d87b 100644
--- a/src/mod_privacy.hrl
+++ b/src/mod_privacy.hrl
@@ -19,10 +19,19 @@
 %%%
 %%%----------------------------------------------------------------------
 
+-record(privacy_list, {user_host, name}).
+-record(privacy_default_list, {user_host, name}).
+-record(privacy_list_data, {user_host, name,
+			    type, value, action, order,
+			    match_all, match_iq, match_message,
+			    match_presence_in, match_presence_out}).
+
+%% ejabberd 2 format:
 -record(privacy, {user_host,
 		  default = none,
 		  lists = []}).
 
+%% ejabberd 2 format:
 -record(listitem, {type = none,
 		   value = none,
 		   action,
@@ -35,3 +44,4 @@
 		  }).
 
 -record(userlist, {name = none, list = [], needdb = false }).
+