Convert to exmpp.

PR:		EJABP-1
Submitted by:	Pablo Polvorin <pablo.polvorin@process-one.net>

SVN Revision: 1611

ChangeLog

@@ -6,6 +6,9 @@
 	* src/mod_stats.erl, src/mod_service_log.erl, src/mod_time.erl:
 	Convert to exmpp.
 
+	* src/mod_private.erl, src/mod_private_odbc.erl, src/mod_version.erl:
+	Convert to exmpp. Thanks to Pablo Polvorin!
+
 2008-10-06  Jean-Sébastien Pédron  <js.pedron@meetic-corp.com>
 
 	* src/ejabberd_sm.erl (process_iq/3): Fix a bug where we were matching

src/mod_private.erl

@@ -34,8 +34,9 @@
 	 process_sm_iq/3,
 	 remove_user/2]).
 
+-include_lib("exmpp/include/exmpp.hrl").
+
 -include("ejabberd.hrl").
--include("jlib.hrl").
 
 -record(private_storage, {usns, xml}).
 
@@ -56,52 +57,90 @@ stop(Host) ->
     gen_iq_handler:remove_iq_handler(ejabberd_sm, Host, ?NS_PRIVATE).
 
 
-process_sm_iq(From, _To, #iq{type = Type, sub_el = SubEl} = IQ) ->
+process_sm_iq(From, To, #iq{type = Type} = IQ_Rec) ->
-    #jid{luser = LUser, lserver = LServer} = From,
+    case check_packet(From, To, IQ_Rec) of
-    case lists:member(LServer, ?MYHOSTS) of
+	ok ->
-	true ->
-	    {xmlelement, Name, Attrs, Els} = SubEl,
 	    case Type of
 		set ->
+		    process_iq_set(From, To, IQ_Rec);
+		get ->
+		    process_iq_get(From, To, IQ_Rec)
+	    end;
+	{error, Error} ->
+	    exmpp_iq:error(IQ_Rec, Error)
+    end.
+
+process_iq_get(From, _To, #iq{payload = SubEl} = IQ_Rec) ->
+    #jid{lnode = LUser, ldomain = LServer} = From,
+    case catch get_data(LUser,
+			LServer,
+			exmpp_xml:get_child_elements(SubEl)) of
+	{'EXIT', _Reason} ->
+	    {error, 'internal-server-error'};
+	Res ->
+	    exmpp_iq:result(IQ_Rec, #xmlel{ns = ?NS_PRIVATE,
+					   name = 'query',
+					   children = Res})
+    end.
+
+
+process_iq_set(From, _To, #iq{payload = SubEl} = IQ_Rec) ->
+    #jid{lnode = LUser, ldomain = LServer} = From,
     F = fun() ->
         lists:foreach(
           fun(El) ->
               set_data(LUser, LServer, El)
-				  end, Els)
+          end, exmpp_xml:get_child_elements(SubEl))
     end,
     mnesia:transaction(F),
-		    IQ#iq{type = result,
+    exmpp_iq:result(IQ_Rec).
-			  sub_el = [{xmlelement, Name, Attrs, []}]};
+
-		get ->
+
-		    case catch get_data(LUser, LServer, Els) of
+check_packet(From, To, IQ_Rec) ->
-			{'EXIT', _Reason} ->
+    check_packet(From, To, IQ_Rec, [ fun check_domain/3,
-			    IQ#iq{type = error,
+				     fun check_user/3,
-				  sub_el = [SubEl,
+				     fun check_ns/3]).
-					    ?ERR_INTERNAL_SERVER_ERROR]};
+check_packet(_From, _To, _IQ_Rec, []) ->
-			Res ->
+    ok;
-			    IQ#iq{type = result,
+check_packet(From, To, IQ_Rec, [F | R]) ->
-				  sub_el = [{xmlelement, Name, Attrs, Res}]}
+    case F(From, To, IQ_Rec) of
+	{error, _} = Error -> Error;
+	ok -> check_packet(From, To, IQ_Rec, R)
+    end.
+
+check_domain(#jid{ldomain = LServer}, _To, _IQ_Rec) ->
+    case lists:member(LServer, ?MYHOSTS) of
+	true -> ok;
+	false -> {error, 'not-allowed'}
+    end.
+
+% the iq can't be directed to another jid
+check_user(From, To, _IQ_Rec) ->
+    case exmpp_jid:compare_bare_jids(From, To) of
+	true -> ok;
+	false -> {error, 'forbidden'}
+    end.
+
+%there must be at least one child, and every child should have
+%a namespace specified (reject if the namespace is jabber:iq:private,
+%the same than the parent element).
+check_ns(_From, _To, #iq{payload = SubEl}) ->
+    case exmpp_xml:get_child_elements(SubEl) of
+	[] ->
+	    {error, 'not-acceptable'};
+	Children ->
+	    case lists:any(fun(Child) ->
+			       exmpp_xml:get_ns_as_atom(Child) =:= ?NS_PRIVATE
+			   end, Children) of
+		true -> {error, 'not-acceptable'};
+		false -> ok
 	    end
-	    end;
-	false ->
-	    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]}
     end.
 
 set_data(LUser, LServer, El) ->
-    case El of
+    XMLNS = exmpp_xml:get_ns_as_atom(El),
-	{xmlelement, _Name, Attrs, _Els} ->
+    mnesia:write(#private_storage{usns = {LUser, LServer, XMLNS},
-	    XMLNS = xml:get_attr_s("xmlns", Attrs),
+				  xml = El}).
-	    case XMLNS of
-		"" ->
-		    ignore;
-		_ ->
-		    mnesia:write(
-		      #private_storage{usns = {LUser, LServer, XMLNS},
-				       xml = El})
-	    end;
-	_ ->
-	    ignore
-    end.
 
 get_data(LUser, LServer, Els) ->
     get_data(LUser, LServer, Els, []).
@@ -109,9 +148,7 @@ get_data(LUser, LServer, Els) ->
 get_data(_LUser, _LServer, [], Res) ->
     lists:reverse(Res);
 get_data(LUser, LServer, [El | Els], Res) ->
-    case El of
+    XMLNS = exmpp_xml:get_ns_as_atom(El),
-	{xmlelement, _Name, Attrs, _} ->
-	    XMLNS = xml:get_attr_s("xmlns", Attrs),
     case mnesia:dirty_read(private_storage, {LUser, LServer, XMLNS}) of
 	[R] ->
 	    get_data(LUser, LServer, Els,
@@ -119,14 +156,12 @@ get_data(LUser, LServer, [El | Els], Res) ->
 	[] ->
 	    get_data(LUser, LServer, Els,
 	      [El | Res])
-	    end;
-	_ ->
-	    get_data(LUser, LServer, Els, Res)
     end.
 
 remove_user(User, Server) ->
-    LUser = jlib:nodeprep(User),
+    try
-    LServer = jlib:nameprep(Server),
+	LUser = exmpp_stringprep:nodeprep(User),
+	LServer = exmpp_stringprep:nameprep(Server),
 	F = fun() ->
 		    Namespaces = mnesia:select(
 				private_storage,
@@ -140,14 +175,18 @@ remove_user(User, Server) ->
 					     {LUser, LServer, Namespace}})
 			 end, Namespaces)
 	    end,
-    mnesia:transaction(F).
+	mnesia:transaction(F)
+    catch
+	_ ->
+	    ok
+    end.
 
 
 update_table() ->
     Fields = record_info(fields, private_storage),
     case mnesia:table_info(private_storage, attributes) of
 	Fields ->
-	    ok;
+            convert_to_exmpp();
 	[userns, xml] ->
 	    ?INFO_MSG("Converting private_storage table from "
 		      "{user, default, lists} format", []),
@@ -163,10 +202,14 @@ update_table() ->
 	    F1 = fun() ->
 			 mnesia:write_lock_table(mod_private_tmp_table),
 			 mnesia:foldl(
-			   fun(#private_storage{usns = {U, NS}} = R, _) ->
+			   fun(#private_storage{usns = {U, NS}, xml = El} = R, _) ->
+				   NS1 = list_to_atom(NS),
+				   El0 = exmpp_xml:xmlelement_to_xmlel(El,
+				     [?NS_PRIVATE], [{?NS_XMPP, ?NS_XMPP_pfx}]),
+				   El1 = exmpp_xml:remove_whitespaces_deeply(El0),
 				   mnesia:dirty_write(
 				     mod_private_tmp_table,
-				     R#private_storage{usns = {U, Host, NS}})
+				     R#private_storage{usns = {U, Host, NS1}, xml = El1})
 			   end, ok, private_storage)
 		 end,
 	    mnesia:transaction(F1),
@@ -186,3 +229,32 @@ update_table() ->
     end.
 
 
+convert_to_exmpp() ->
+    Fun = fun() ->
+	    case mnesia:first(private_storage) of
+		'$end_of_table' ->
+		    none;
+		Key ->
+		    case mnesia:read({private_storage, Key}) of
+			[#private_storage{xml = #xmlel{}}] ->
+			    none;
+			[#private_storage{xml = #xmlelement{}}] ->
+			    mnesia:foldl(fun convert_to_exmpp2/2,
+			      done, private_storage, write)
+		    end
+	    end
+    end,
+    mnesia:transaction(Fun).
+
+convert_to_exmpp2(#private_storage{usns = {U, S, NS} = Key, xml = El} = R,
+  Acc) ->
+    mnesia:delete({private_storage, Key}),
+    NS1 = list_to_atom(NS),
+    El0 = exmpp_xml:xmlelement_to_xmlel(El,
+      [?NS_PRIVATE], [{?NS_XMPP, ?NS_XMPP_pfx}]),
+    El1 = exmpp_xml:remove_whitespaces_deeply(El0),
+    New_R = R#private_storage{
+      usns = {U, S, NS1},
+      xml = El1},
+    mnesia:write(New_R),
+    Acc.

src/mod_private_odbc.erl

@@ -34,8 +34,9 @@
 	 process_sm_iq/3,
 	 remove_user/2]).
 
+-include_lib("exmpp/include/exmpp.hrl").
+
 -include("ejabberd.hrl").
--include("jlib.hrl").
 
 start(Host, Opts) ->
     IQDisc = gen_mod:get_opt(iqdisc, Opts, one_queue),
@@ -50,54 +51,94 @@ stop(Host) ->
     gen_iq_handler:remove_iq_handler(ejabberd_sm, Host, ?NS_PRIVATE).
 
 
-process_sm_iq(From, _To, #iq{type = Type, sub_el = SubEl} = IQ) ->
+process_sm_iq(From, To, #iq{type = Type} = IQ_Rec) ->
-    #jid{luser = LUser, lserver = LServer} = From,
+    case check_packet(From, To, IQ_Rec) of
-    case lists:member(LServer, ?MYHOSTS) of
+	ok ->
-	true ->
-	    {xmlelement, Name, Attrs, Els} = SubEl,
 	    case Type of
 		set ->
+		    process_iq_set(From, To, IQ_Rec);
+		get ->
+		    process_iq_get(From, To, IQ_Rec)
+	    end;
+	{error, Error} ->
+	    exmpp_iq:error(IQ_Rec, Error)
+    end.
+
+process_iq_get(From, _To, #iq{payload = SubEl} = IQ_Rec) ->
+    #jid{lnode = LUser, ldomain = LServer} = From,
+    case catch get_data(LUser,
+			LServer,
+			exmpp_xml:get_child_elements(SubEl)) of
+	{'EXIT', _Reason} ->
+	    {error, 'internal-server-error'};
+	Res ->
+	    exmpp_iq:result(IQ_Rec, #xmlel{ns = ?NS_PRIVATE,
+					   name = 'query',
+					   children = Res})
+    end.
+
+
+process_iq_set(From, _To, #iq{payload = SubEl} = IQ_Rec) ->
+    #jid{lnode = LUser, ldomain = LServer} = From,
     F = fun() ->
         lists:foreach(
           fun(El) ->
               set_data(LUser, LServer, El)
-				  end, Els)
+          end, exmpp_xml:get_child_elements(SubEl))
     end,
     odbc_queries:sql_transaction(LServer, F),
-		    IQ#iq{type = result,
+    exmpp_iq:result(IQ_Rec).
-			  sub_el = [{xmlelement, Name, Attrs, []}]};
+
-		get ->
+
-		    case catch get_data(LUser, LServer, Els) of
+check_packet(From, To, IQ_Rec) ->
-			{'EXIT', _Reason} ->
+    check_packet(From, To, IQ_Rec, [ fun check_domain/3,
-			    IQ#iq{type = error,
+				     fun check_user/3,
-				  sub_el = [SubEl,
+				     fun check_ns/3]).
-					    ?ERR_INTERNAL_SERVER_ERROR]};
+check_packet(_From, _To, _IQ_Rec, []) ->
-			Res ->
+    ok;
-			    IQ#iq{type = result,
+check_packet(From, To, IQ_Rec, [F | R]) ->
-				  sub_el = [{xmlelement, Name, Attrs, Res}]}
+    case F(From, To, IQ_Rec) of
-		    end
+	{error, _} = Error -> Error;
-	    end;
+	ok -> check_packet(From, To, IQ_Rec, R)
-	false ->
-	    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]}
     end.
 
+check_domain(#jid{ldomain = LServer}, _To, _IQ_Rec) ->
+    case lists:member(LServer, ?MYHOSTS) of
+	true -> ok;
+	false -> {error, 'not-allowed'}
+    end.
+
+% the iq can't be directed to another jid
+check_user(From, To, _IQ_Rec) ->
+    case exmpp_jid:compare_bare_jids(From, To) of
+	true -> ok;
+	false -> {error, 'forbidden'}
+    end.
+
+%there must be at least one child, and every child should have
+%a namespace specified (reject if the namespace is jabber:iq:private,
+%the same than the parent element).
+check_ns(_From, _To, #iq{payload = SubEl}) ->
+    case exmpp_xml:get_child_elements(SubEl) of
+	[] ->
+	    {error, 'not-acceptable'};
+	Children ->
+	    case lists:any(fun(Child) ->
+			       exmpp_xml:get_ns_as_atom(Child) =:= ?NS_PRIVATE
+			   end, Children) of
+		true -> {error, 'not-acceptable'};
+		false -> ok
+	    end
+    end.
+
+
+
 set_data(LUser, LServer, El) ->
-    case El of
+    XMLNS = exmpp_xml:get_ns_as_list(El),
-	{xmlelement, _Name, Attrs, _Els} ->
-	    XMLNS = xml:get_attr_s("xmlns", Attrs),
-	    case XMLNS of
-		"" ->
-		    ignore;
-		_ ->
     Username = ejabberd_odbc:escape(LUser),
 	LXMLNS = ejabberd_odbc:escape(XMLNS),
-		    SData = ejabberd_odbc:escape(
+	SData = ejabberd_odbc:escape(exmpp_xml:document_to_list(El)),
-			       lists:flatten(xml:element_to_string(El))),
+	odbc_queries:set_private_data(LServer, Username, LXMLNS, SData).
-			odbc_queries:set_private_data(LServer, Username, LXMLNS, SData)
-	    end;
-	_ ->
-	    ignore
-    end.
 
 get_data(LUser, LServer, Els) ->
     get_data(LUser, LServer, Els, []).
@@ -105,32 +146,31 @@ get_data(LUser, LServer, Els) ->
 get_data(_LUser, _LServer, [], Res) ->
     lists:reverse(Res);
 get_data(LUser, LServer, [El | Els], Res) ->
-    case El of
+    XMLNS = exmpp_xml:get_ns_as_list(El),
-	{xmlelement, _Name, Attrs, _} ->
-	    XMLNS = xml:get_attr_s("xmlns", Attrs),
     Username = ejabberd_odbc:escape(LUser),
     LXMLNS = ejabberd_odbc:escape(XMLNS),
     case catch odbc_queries:get_private_data(LServer, Username, LXMLNS) of
     {selected, ["data"], [{SData}]} ->
-		    case xml_stream:parse_element(SData) of
+	[Data] = exmpp_xml:parse_document(SData,[namespace,
-			Data when element(1, Data) == xmlelement ->
+						 name_as_atom,
-			    get_data(LUser, LServer, Els,
+						 autoload_known]),
-				     [Data | Res])
+	get_data(LUser, LServer, Els, [Data | Res]);
-		    end;
     %% MREMOND: I wonder when the query could return a vcard ?
     {selected, ["vcard"], []} ->
 	get_data(LUser, LServer, Els,
 	  [El | Res]);
     _ ->
 	get_data(LUser, LServer, Els, [El | Res])
-	    end;
-	_ ->
-	    get_data(LUser, LServer, Els, Res)
 end.
 
 
 remove_user(User, Server) ->
-    LUser = jlib:nodeprep(User),
+    try
-    LServer = jlib:nameprep(Server),
+	LUser = exmpp_stringprep:nodeprep(User),
+	LServer = exmpp_stringprep:nameprep(Server),
 	Username = ejabberd_odbc:escape(LUser),
-    odbc_queries:del_user_private_storage(LServer, Username).
+	odbc_queries:del_user_private_storage(LServer, Username)
+    catch
+	_ ->
+	    ok
+    end.

src/mod_version.erl

@@ -33,40 +33,39 @@
 	 stop/1,
 	 process_local_iq/3]).
 
+-include_lib("exmpp/include/exmpp.hrl").
+
 -include("ejabberd.hrl").
--include("jlib.hrl").
 
 
 
 start(Host, Opts) ->
     IQDisc = gen_mod:get_opt(iqdisc, Opts, one_queue),
-    gen_iq_handler:add_iq_handler(ejabberd_local, Host, ?NS_VERSION,
+    gen_iq_handler:add_iq_handler(ejabberd_local, Host, ?NS_SOFT_VERSION,
 				  ?MODULE, process_local_iq, IQDisc).
 
 stop(Host) ->
-    gen_iq_handler:remove_iq_handler(ejabberd_local, Host, ?NS_VERSION).
+    gen_iq_handler:remove_iq_handler(ejabberd_local, Host, ?NS_SOFT_VERSION).
 
 
-process_local_iq(_From, To, #iq{id = _ID, type = Type,
+process_local_iq(_From, To, #iq{type = Type} = IQ_Rec) ->
-			       xmlns = _XMLNS, sub_el = SubEl} = IQ) ->
     case Type of
 	set ->
-	    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]};
+	    exmpp_iq:error(IQ_Rec, 'not-allowed');
 	get ->
-	    Host = To#jid.server,
+	    Host = To#jid.domain,
 	    OS = case gen_mod:get_module_opt(Host, ?MODULE, show_os, true) of
 		     true -> [get_os()];
 		     false -> []
 		 end,
-	    IQ#iq{type = result,
+	    R = #xmlel{ns = ?NS_SOFT_VERSION, name = 'query',
-		  sub_el = [{xmlelement, "query",
+		       children = [ exmpp_xml:set_cdata(#xmlel{ns = ?NS_SOFT_VERSION,
-			     [{"xmlns", ?NS_VERSION}],
+							       name = 'name'},
-			     [{xmlelement, "name", [],
+							<<"ejabberd">>),
-			       [{xmlcdata, "ejabberd"}]},
+				    exmpp_xml:set_cdata(#xmlel{ns = ?NS_SOFT_VERSION,
-			      {xmlelement, "version", [],
+							       name = 'version'},
-			       [{xmlcdata, ?VERSION}]}
+							?VERSION) | OS]},
-			     ] ++ OS
+	    exmpp_iq:result(IQ_Rec, R)
-			    }]}
     end.
 
 
@@ -87,4 +86,4 @@ get_os() ->
 			VersionString
 		end,
     OS = OSType ++ " " ++ OSVersion,
-    {xmlelement, "os", [], [{xmlcdata, OS}]}.
+    exmpp_xml:set_cdata(#xmlel{ns = ?NS_SOFT_VERSION, name = 'os'}, OS).