Rewrite mod_blocking to use XML generator

diff --git a/include/xmpp_codec.hrl b/include/xmpp_codec.hrl
index e348404b03f3d7d627a6eeb0b573a90e4ff227b0..7b8275ed575ce62691ea9f49c3db010467f6ac83 100644 (file)
--- a/include/xmpp_codec.hrl
+++ b/include/xmpp_codec.hrl
@@ -347,7 +347,7 @@
                        text = [] :: [#text{}]}).
 -type sasl_failure() :: #sasl_failure{}.
 
--record(block_list, {}).
+-record(block_list, {items = [] :: [any()]}).
 -type block_list() :: #block_list{}.
 
 -record(xdata_field, {label :: binary(),

diff --git a/src/mod_blocking.erl b/src/mod_blocking.erl
index 818d5325958f0a2f891f1973546c492473207c89..743b78efd8abeb79d2b8f1a599d84f08df20ccf1 100644 (file)
--- a/src/mod_blocking.erl
+++ b/src/mod_blocking.erl
@@ -29,13 +29,13 @@
 
 -protocol({xep, 191, '1.2'}).
 
--export([start/2, stop/1, process_iq/3,
-        process_iq_set/4, process_iq_get/5, mod_opt_type/1, depends/2]).
+-export([start/2, stop/1, process_iq/1,
+        process_iq_set/2, process_iq_get/3, mod_opt_type/1, depends/2]).
 
 -include("ejabberd.hrl").
 -include("logger.hrl").
 
--include("jlib.hrl").
+-include("xmpp.hrl").
 
 -include("mod_privacy.hrl").
 
@@ -43,6 +43,8 @@
 -callback unblock_by_filter(binary(), binary(), function()) -> {atomic, any()}.
 -callback process_blocklist_get(binary(), binary()) -> [listitem()] | error.
 
+-type block_event() :: {block, [jid()]} | {unblock, [jid()]} | unblock_all.
+
 start(Host, Opts) ->
     IQDisc = gen_mod:get_opt(iqdisc, Opts, fun gen_iq_handler:check_type/1,
                              one_queue),
@@ -66,55 +68,65 @@ stop(Host) ->
 depends(_Host, _Opts) ->
     [{mod_privacy, hard}].
 
-process_iq(_From, _To, IQ) ->
-    SubEl = IQ#iq.sub_el,
-    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]}.
+-spec process_iq(iq()) -> iq().
+process_iq(IQ) ->
+    xmpp:make_error(IQ, xmpp:err_not_allowed()).
 
-process_iq_get(_, From, _To,
-              #iq{xmlns = ?NS_BLOCKING, lang = Lang,
-                  sub_el = #xmlel{name = <<"blocklist">>}},
-              _) ->
+-spec process_iq_get({error, error()} | {result, xmpp_element() | undefined},
+                    iq(), userlist()) ->
+                           {error, error()} | {result, block_list()}.
+process_iq_get(_, #iq{lang = Lang, from = From,
+                     sub_els = [#block_list{}]}, _) ->
     #jid{luser = LUser, lserver = LServer} = From,
     {stop, process_blocklist_get(LUser, LServer, Lang)};
-process_iq_get(Acc, _, _, _, _) -> Acc.
+process_iq_get(Acc, _, _) -> Acc.
 
-process_iq_set(_, From, _To,
-              #iq{xmlns = ?NS_BLOCKING, lang = Lang,
-                  sub_el =
-                      #xmlel{name = SubElName, children = SubEls}}) ->
+-spec process_iq_set({error, error()} |
+                    {result, xmpp_element() | undefined} |
+                    {result, xmpp_element() | undefined, userlist()},
+                    iq()) -> {error, error()} |
+                             {result, undefined} |
+                             {result, undefined, userlist()}.
+process_iq_set(_, #iq{from = From, lang = Lang, sub_els = [SubEl]}) ->
     #jid{luser = LUser, lserver = LServer} = From,
-    Res = case {SubElName, fxml:remove_cdata(SubEls)} of
-           {<<"block">>, []} ->
-               Txt = <<"No items found in this query">>,
-               {error, ?ERRT_BAD_REQUEST(Lang, Txt)};
-           {<<"block">>, Els} ->
-               JIDs = parse_blocklist_items(Els, []),
-               process_blocklist_block(LUser, LServer, JIDs, Lang);
-           {<<"unblock">>, []} ->
-               process_blocklist_unblock_all(LUser, LServer, Lang);
-           {<<"unblock">>, Els} ->
-               JIDs = parse_blocklist_items(Els, []),
-               process_blocklist_unblock(LUser, LServer, JIDs, Lang);
-           _ ->
-               Txt = <<"Unknown blocking command">>,
-               {error, ?ERRT_BAD_REQUEST(Lang, Txt)}
+    Res = case SubEl of
+             #block{items = []} ->
+                 Txt = <<"No items found in this query">>,
+                 {error, xmpp:err_bad_request(Txt, Lang)};
+             #block{items = Items} ->
+                 JIDs = [jid:tolower(Item) || Item <- Items],
+                 process_blocklist_block(LUser, LServer, JIDs, Lang);
+             #unblock{items = []} ->
+                 process_blocklist_unblock_all(LUser, LServer, Lang);
+             #unblock{items = Items} ->
+                 JIDs = [jid:tolower(Item) || Item <- Items],
+                 process_blocklist_unblock(LUser, LServer, JIDs, Lang);
+             _ ->
+                 Txt = <<"Only <block/> and <unblock/> are allowed "
+                         "in this request">>,
+                 {error, xmpp:err_bad_request(Txt, Lang)}
          end,
     {stop, Res};
-process_iq_set(Acc, _, _, _) -> Acc.
+process_iq_set(Acc, _) -> Acc.
 
+-spec list_to_blocklist_jids([listitem()], [ljid()]) -> [ljid()].
 list_to_blocklist_jids([], JIDs) -> JIDs;
 list_to_blocklist_jids([#listitem{type = jid,
                                  action = deny, value = JID} =
                            Item
                        | Items],
                       JIDs) ->
-    case Item of
-      #listitem{match_all = true} -> Match = true;
-      #listitem{match_iq = true, match_message = true,
-               match_presence_in = true, match_presence_out = true} ->
-         Match = true;
-      _ -> Match = false
-    end,
+    Match = case Item of
+               #listitem{match_all = true} ->
+                   true;
+               #listitem{match_iq = true,
+                         match_message = true,
+                         match_presence_in = true,
+                         match_presence_out = true} ->
+                   true;
+               _ ->
+                   false
+           end,
     if Match -> list_to_blocklist_jids(Items, [JID | JIDs]);
        true -> list_to_blocklist_jids(Items, JIDs)
     end;
@@ -122,20 +134,10 @@ list_to_blocklist_jids([#listitem{type = jid,
 list_to_blocklist_jids([_ | Items], JIDs) ->
     list_to_blocklist_jids(Items, JIDs).
 
-parse_blocklist_items([], JIDs) -> JIDs;
-parse_blocklist_items([#xmlel{name = <<"item">>,
-                             attrs = Attrs}
-                      | Els],
-                     JIDs) ->
-    case fxml:get_attr(<<"jid">>, Attrs) of
-      {value, JID1} ->
-         JID = jid:tolower(jid:from_string(JID1)),
-         parse_blocklist_items(Els, [JID | JIDs]);
-      false -> parse_blocklist_items(Els, JIDs)
-    end;
-parse_blocklist_items([_ | Els], JIDs) ->
-    parse_blocklist_items(Els, JIDs).
-
+-spec process_blocklist_block(binary(), binary(), [ljid()],
+                             undefined | binary()) ->
+                                    {error, error()} |
+                                    {result, undefined, userlist()}.
 process_blocklist_block(LUser, LServer, JIDs, Lang) ->
     Filter = fun (List) ->
                     AlreadyBlocked = list_to_blocklist_jids(List, []),
@@ -161,13 +163,17 @@ process_blocklist_block(LUser, LServer, JIDs, Lang) ->
          broadcast_list_update(LUser, LServer, Default,
                                UserList),
          broadcast_blocklist_event(LUser, LServer,
-                                   {block, JIDs}),
-         {result, [], UserList};
+                                   {block, [jid:make(J) || J <- JIDs]}),
+         {result, undefined, UserList};
       _Err ->
            ?ERROR_MSG("Error processing ~p: ~p", [{LUser, LServer, JIDs}, _Err]),
-           {error, ?ERRT_INTERNAL_SERVER_ERROR(Lang, <<"Database failure">>)}
+           {error, xmpp:err_internal_server_error(<<"Database failure">>, Lang)}
     end.
 
+-spec process_blocklist_unblock_all(binary(), binary(), undefined | binary()) ->
+                                          {error, error()} |
+                                          {result, undefined} |
+                                          {result, undefined, userlist()}.
 process_blocklist_unblock_all(LUser, LServer, Lang) ->
     Filter = fun (List) ->
                     lists:filter(fun (#listitem{action = A}) -> A =/= deny
@@ -176,18 +182,23 @@ process_blocklist_unblock_all(LUser, LServer, Lang) ->
             end,
     Mod = db_mod(LServer),
     case Mod:unblock_by_filter(LUser, LServer, Filter) of
-      {atomic, ok} -> {result, []};
+      {atomic, ok} -> {result, undefined};
       {atomic, {ok, Default, List}} ->
          UserList = make_userlist(Default, List),
          broadcast_list_update(LUser, LServer, Default,
                                UserList),
          broadcast_blocklist_event(LUser, LServer, unblock_all),
-         {result, [], UserList};
+         {result, undefined, UserList};
       _Err ->
            ?ERROR_MSG("Error processing ~p: ~p", [{LUser, LServer}, _Err]),
-           {error, ?ERRT_INTERNAL_SERVER_ERROR(Lang, <<"Database failure">>)}
+           {error, xmpp:err_internal_server_error(<<"Database failure">>, Lang)}
     end.
 
+-spec process_blocklist_unblock(binary(), binary(), [ljid()],
+                               undefined | binary()) ->
+                                      {error, error()} |
+                                      {result, undefined} |
+                                      {result, undefined, userlist()}.
 process_blocklist_unblock(LUser, LServer, JIDs, Lang) ->
     Filter = fun (List) ->
                     lists:filter(fun (#listitem{action = deny, type = jid,
@@ -199,56 +210,53 @@ process_blocklist_unblock(LUser, LServer, JIDs, Lang) ->
             end,
     Mod = db_mod(LServer),
     case Mod:unblock_by_filter(LUser, LServer, Filter) of
-      {atomic, ok} -> {result, []};
+      {atomic, ok} -> {result, undefined};
       {atomic, {ok, Default, List}} ->
          UserList = make_userlist(Default, List),
          broadcast_list_update(LUser, LServer, Default,
                                UserList),
          broadcast_blocklist_event(LUser, LServer,
-                                   {unblock, JIDs}),
-         {result, [], UserList};
+                                   {unblock, [jid:make(J) || J <- JIDs]}),
+         {result, undefined, UserList};
       _Err ->
            ?ERROR_MSG("Error processing ~p: ~p", [{LUser, LServer, JIDs}, _Err]),
-           {error, ?ERRT_INTERNAL_SERVER_ERROR(Lang, <<"Database failure">>)}
+           {error, xmpp:err_internal_server_error(<<"Database failure">>, Lang)}
     end.
 
+-spec make_userlist(binary(), [listitem()]) -> userlist().
 make_userlist(Name, List) ->
     NeedDb = mod_privacy:is_list_needdb(List),
     #userlist{name = Name, list = List, needdb = NeedDb}.
 
+-spec broadcast_list_update(binary(), binary(), binary(), userlist()) ->
+                                  {broadcast,
+                                   {privacy_list, userlist(), binary() | none}}.
 broadcast_list_update(LUser, LServer, Name, UserList) ->
-    ejabberd_sm:route(jid:make(LUser, LServer,
-                                    <<"">>),
+    ejabberd_sm:route(jid:make(LUser, LServer, <<"">>),
                       jid:make(LUser, LServer, <<"">>),
                       {broadcast, {privacy_list, UserList, Name}}).
 
+-spec broadcast_blocklist_event(binary(), binary(), block_event()) ->
+                                      {broadcast, {blocking, block_event()}}.
 broadcast_blocklist_event(LUser, LServer, Event) ->
     JID = jid:make(LUser, LServer, <<"">>),
     ejabberd_sm:route(JID, JID,
                       {broadcast, {blocking, Event}}).
 
+-spec process_blocklist_get(binary(), binary(), undefined | binary()) ->
+                                  {error, error()} | {result, block_list()}.
 process_blocklist_get(LUser, LServer, Lang) ->
     Mod = db_mod(LServer),
     case Mod:process_blocklist_get(LUser, LServer) of
       error ->
-         {error, ?ERRT_INTERNAL_SERVER_ERROR(Lang, <<"Database failure">>)};
+         {error, xmpp:err_internal_server_error(<<"Database failure">>, Lang)};
       List ->
-         JIDs = list_to_blocklist_jids(List, []),
-         Items = lists:map(fun (JID) ->
-                                   ?DEBUG("JID: ~p", [JID]),
-                                   #xmlel{name = <<"item">>,
-                                          attrs =
-                                              [{<<"jid">>,
-                                                jid:to_string(JID)}],
-                                          children = []}
-                           end,
-                           JIDs),
-         {result,
-          [#xmlel{name = <<"blocklist">>,
-                  attrs = [{<<"xmlns">>, ?NS_BLOCKING}],
-                  children = Items}]}
+         LJIDs = list_to_blocklist_jids(List, []),
+         Items = [jid:make(J) || J <- LJIDs],
+         {result, #block_list{items = Items}}
     end.
 
+-spec db_mod(binary()) -> module().
 db_mod(LServer) ->
     DBType = gen_mod:db_type(LServer, mod_privacy),
     gen_mod:db_mod(DBType, ?MODULE).

diff --git a/src/mod_privacy.erl b/src/mod_privacy.erl
index e88c1fb5b08bbf5bf6f4c20077eafac94a0e45a1..f61ba31d4aad9be7ab19d2e1f6e4e7ca51e41d1b 100644 (file)
--- a/src/mod_privacy.erl
+++ b/src/mod_privacy.erl
@@ -100,7 +100,7 @@ stop(Host) ->
 process_iq(IQ) ->
     xmpp:make_error(IQ, xmpp:err_not_allowed()).
 
--spec process_iq_get({error, error()} | iq(),
+-spec process_iq_get({error, error()} | {result, xmpp_element() | undefined},
                     iq(), userlist()) -> {error, error()} | {result, privacy_query()}.
 process_iq_get(_, #iq{from = From, lang = Lang,
                      sub_els = [#privacy_query{lists = Lists}]},
@@ -215,7 +215,8 @@ decode_value(Type, Value) ->
     end.
 
 -spec process_iq_set({error, error()} |
-                    {result, privacy_query() | undefined, userlist()},
+                    {result, xmpp_element() | undefined} |
+                    {result, xmpp_element() | undefined, userlist()},
                     iq()) -> {error, error()} |
                              {result, undefined, userlist()}.
 process_iq_set(_, #iq{from = From, lang = Lang,

diff --git a/src/xmpp_codec.erl b/src/xmpp_codec.erl
index 976a7bfeb0b874ba32b6771d41d44ca7a483234f..f6e5f0f1abbe00bb2ce8ef1c9d06eb6080e54717 100644 (file)
--- a/src/xmpp_codec.erl
+++ b/src/xmpp_codec.erl
@@ -1899,7 +1899,7 @@ encode({block, _} = Block) ->
 encode({unblock, _} = Unblock) ->
     encode_unblock(Unblock,
                   [{<<"xmlns">>, <<"urn:xmpp:blocking">>}]);
-encode({block_list} = Blocklist) ->
+encode({block_list, _} = Blocklist) ->
     encode_block_list(Blocklist,
                      [{<<"xmlns">>, <<"urn:xmpp:blocking">>}]);
 encode({identity, _, _, _, _} = Identity) ->
@@ -2351,7 +2351,7 @@ get_name({privacy_list, _, _}) -> <<"list">>;
 get_name({privacy_query, _, _, _}) -> <<"query">>;
 get_name({block, _}) -> <<"block">>;
 get_name({unblock, _}) -> <<"unblock">>;
-get_name({block_list}) -> <<"blocklist">>;
+get_name({block_list, _}) -> <<"blocklist">>;
 get_name({identity, _, _, _, _}) -> <<"identity">>;
 get_name({disco_info, _, _, _, _}) -> <<"query">>;
 get_name({disco_item, _, _, _}) -> <<"item">>;
@@ -2520,7 +2520,7 @@ get_ns({privacy_query, _, _, _}) ->
     <<"jabber:iq:privacy">>;
 get_ns({block, _}) -> <<"urn:xmpp:blocking">>;
 get_ns({unblock, _}) -> <<"urn:xmpp:blocking">>;
-get_ns({block_list}) -> <<"urn:xmpp:blocking">>;
+get_ns({block_list, _}) -> <<"urn:xmpp:blocking">>;
 get_ns({identity, _, _, _, _}) ->
     <<"http://jabber.org/protocol/disco#info">>;
 get_ns({disco_info, _, _, _, _}) ->
@@ -2796,7 +2796,7 @@ pp(privacy_list, 2) -> [name, items];
 pp(privacy_query, 3) -> [lists, default, active];
 pp(block, 1) -> [items];
 pp(unblock, 1) -> [items];
-pp(block_list, 0) -> [];
+pp(block_list, 1) -> [items];
 pp(identity, 4) -> [category, type, lang, name];
 pp(disco_info, 4) ->
     [node, identities, features, xdata];
@@ -22454,13 +22454,52 @@ encode_disco_identity_attr_name(_val, _acc) ->
 
 decode_block_list(__TopXMLNS, __IgnoreEls,
                  {xmlel, <<"blocklist">>, _attrs, _els}) ->
-    {block_list}.
+    Items = decode_block_list_els(__TopXMLNS, __IgnoreEls,
+                                 _els, []),
+    {block_list, Items}.
 
-encode_block_list({block_list}, _xmlns_attrs) ->
-    _els = [],
+decode_block_list_els(__TopXMLNS, __IgnoreEls, [],
+                     Items) ->
+    lists:reverse(Items);
+decode_block_list_els(__TopXMLNS, __IgnoreEls,
+                     [{xmlel, <<"item">>, _attrs, _} = _el | _els], Items) ->
+    case get_attr(<<"xmlns">>, _attrs) of
+      <<"">> when __TopXMLNS == <<"urn:xmpp:blocking">> ->
+         decode_block_list_els(__TopXMLNS, __IgnoreEls, _els,
+                               case decode_block_item(__TopXMLNS, __IgnoreEls,
+                                                      _el)
+                                   of
+                                 undefined -> Items;
+                                 _new_el -> [_new_el | Items]
+                               end);
+      <<"urn:xmpp:blocking">> ->
+         decode_block_list_els(__TopXMLNS, __IgnoreEls, _els,
+                               case decode_block_item(<<"urn:xmpp:blocking">>,
+                                                      __IgnoreEls, _el)
+                                   of
+                                 undefined -> Items;
+                                 _new_el -> [_new_el | Items]
+                               end);
+      _ ->
+         decode_block_list_els(__TopXMLNS, __IgnoreEls, _els,
+                               Items)
+    end;
+decode_block_list_els(__TopXMLNS, __IgnoreEls,
+                     [_ | _els], Items) ->
+    decode_block_list_els(__TopXMLNS, __IgnoreEls, _els,
+                         Items).
+
+encode_block_list({block_list, Items}, _xmlns_attrs) ->
+    _els = lists:reverse('encode_block_list_$items'(Items,
+                                                   [])),
     _attrs = _xmlns_attrs,
     {xmlel, <<"blocklist">>, _attrs, _els}.
 
+'encode_block_list_$items'([], _acc) -> _acc;
+'encode_block_list_$items'([Items | _els], _acc) ->
+    'encode_block_list_$items'(_els,
+                              [encode_block_item(Items, []) | _acc]).
+
 decode_unblock(__TopXMLNS, __IgnoreEls,
               {xmlel, <<"unblock">>, _attrs, _els}) ->
     Items = decode_unblock_els(__TopXMLNS, __IgnoreEls,

diff --git a/tools/xmpp_codec.spec b/tools/xmpp_codec.spec
index a94b317de4421b918c615b997f1b1e27a889cd23..6c74a7ab15b80d864d8c98a9a61c7056579968a7 100644 (file)
--- a/tools/xmpp_codec.spec
+++ b/tools/xmpp_codec.spec
@@ -176,7 +176,9 @@
 -xml(block_list,
      #elem{name = <<"blocklist">>,
            xmlns = <<"urn:xmpp:blocking">>,
-           result = {block_list}}).
+           result = {block_list, '$items'},
+          refs = [#ref{name = block_item,
+                        label = '$items'}]}).
 
 -xml(disco_identity,
      #elem{name = <<"identity">>,