From aaecdc4b8a0b9aacb4a4b670fc409a65ca126b25 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jean-S=C3=A9bastien=20P=C3=A9dron?=
 <js.pedron@meetic-corp.com>
Date: Tue, 7 Oct 2008 12:20:09 +0000
Subject: [PATCH] Convert to exmpp.

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

SVN Revision: 1611
---
 ChangeLog                |   3 +
 src/mod_private.erl      | 216 ++++++++++++++++++++++++++-------------
 src/mod_private_odbc.erl | 176 +++++++++++++++++++------------
 src/mod_version.erl      |  33 +++---
 4 files changed, 271 insertions(+), 157 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 0c1a114cc..882217ace 100644
--- a/ChangeLog
+++ b/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
diff --git a/src/mod_private.erl b/src/mod_private.erl
index 1a4ad4fff..f88bc3b4d 100644
--- a/src/mod_private.erl
+++ b/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) ->
-    #jid{luser = LUser, lserver = LServer} = From,
-    case lists:member(LServer, ?MYHOSTS) of
-	true ->
-	    {xmlelement, Name, Attrs, Els} = SubEl,
+process_sm_iq(From, To, #iq{type = Type} = IQ_Rec) ->
+    case check_packet(From, To, IQ_Rec) of
+	ok ->
 	    case Type of
 		set ->
-		    F = fun() ->
-				lists:foreach(
-				  fun(El) ->
-					  set_data(LUser, LServer, El)
-				  end, Els)
-			end,
-		    mnesia:transaction(F),
-		    IQ#iq{type = result,
-			  sub_el = [{xmlelement, Name, Attrs, []}]};
+		    process_iq_set(From, To, IQ_Rec);
 		get ->
-		    case catch get_data(LUser, LServer, Els) of
-			{'EXIT', _Reason} ->
-			    IQ#iq{type = error,
-				  sub_el = [SubEl,
-					    ?ERR_INTERNAL_SERVER_ERROR]};
-			Res ->
-			    IQ#iq{type = result,
-				  sub_el = [{xmlelement, Name, Attrs, Res}]}
-		    end
+		    process_iq_get(From, To, IQ_Rec)
 	    end;
-	false ->
-	    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]}
+	{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, exmpp_xml:get_child_elements(SubEl))
+    end,
+    mnesia:transaction(F),
+    exmpp_iq:result(IQ_Rec).
+
+
+check_packet(From, To, IQ_Rec) ->
+    check_packet(From, To, IQ_Rec, [ fun check_domain/3,
+				     fun check_user/3,
+				     fun check_ns/3]).
+check_packet(_From, _To, _IQ_Rec, []) ->
+    ok;
+check_packet(From, To, IQ_Rec, [F | R]) ->
+    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.
 
 set_data(LUser, LServer, El) ->
-    case El of
-	{xmlelement, _Name, Attrs, _Els} ->
-	    XMLNS = xml:get_attr_s("xmlns", Attrs),
-	    case XMLNS of
-		"" ->
-		    ignore;
-		_ ->
-		    mnesia:write(
-		      #private_storage{usns = {LUser, LServer, XMLNS},
-				       xml = El})
-	    end;
-	_ ->
-	    ignore
-    end.
+    XMLNS = exmpp_xml:get_ns_as_atom(El),
+    mnesia:write(#private_storage{usns = {LUser, LServer, XMLNS},
+				  xml = El}).
 
 get_data(LUser, LServer, Els) ->
     get_data(LUser, LServer, Els, []).
@@ -109,45 +148,45 @@ get_data(LUser, LServer, Els) ->
 get_data(_LUser, _LServer, [], Res) ->
     lists:reverse(Res);
 get_data(LUser, LServer, [El | Els], Res) ->
-    case El of
-	{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,
-			     [R#private_storage.xml | Res]);
-		[] ->
-		    get_data(LUser, LServer, Els,
-			     [El | Res])
-	    end;
-	_ ->
-	    get_data(LUser, LServer, Els, Res)
+    XMLNS = exmpp_xml:get_ns_as_atom(El),
+    case mnesia:dirty_read(private_storage, {LUser, LServer, XMLNS}) of
+	[R] ->
+	    get_data(LUser, LServer, Els,
+	      [R#private_storage.xml | Res]);
+	[] ->
+	    get_data(LUser, LServer, Els,
+	      [El | Res])
     end.
 
 remove_user(User, Server) ->
-    LUser = jlib:nodeprep(User),
-    LServer = jlib:nameprep(Server),
-    F = fun() ->
-		Namespaces = mnesia:select(
-			    private_storage,
-			    [{#private_storage{usns={LUser, LServer, '$1'},
-					       _ = '_'},
-			     [],
-			     ['$$']}]),
-		lists:foreach(
-		  fun([Namespace]) ->
-			  mnesia:delete({private_storage,
-					 {LUser, LServer, Namespace}})
-		     end, Namespaces)
-        end,
-    mnesia:transaction(F).
+    try
+	LUser = exmpp_stringprep:nodeprep(User),
+	LServer = exmpp_stringprep:nameprep(Server),
+	F = fun() ->
+		    Namespaces = mnesia:select(
+				private_storage,
+				[{#private_storage{usns = {LUser, LServer, '$1'},
+						   _ = '_'},
+				 [],
+				 ['$$']}]),
+		    lists:foreach(
+		      fun([Namespace]) ->
+			      mnesia:delete({private_storage,
+					     {LUser, LServer, Namespace}})
+			 end, Namespaces)
+	    end,
+	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.
diff --git a/src/mod_private_odbc.erl b/src/mod_private_odbc.erl
index 6ea9a9af2..09dce943d 100644
--- a/src/mod_private_odbc.erl
+++ b/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,87 +51,126 @@ 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) ->
-    #jid{luser = LUser, lserver = LServer} = From,
-    case lists:member(LServer, ?MYHOSTS) of
-	true ->
-	    {xmlelement, Name, Attrs, Els} = SubEl,
+process_sm_iq(From, To, #iq{type = Type} = IQ_Rec) ->
+    case check_packet(From, To, IQ_Rec) of
+	ok ->
 	    case Type of
 		set ->
-		    F = fun() ->
-				lists:foreach(
-				  fun(El) ->
-					  set_data(LUser, LServer, El)
-				  end, Els)
-			end,
-		    odbc_queries:sql_transaction(LServer, F),
-		    IQ#iq{type = result,
-			  sub_el = [{xmlelement, Name, Attrs, []}]};
+		    process_iq_set(From, To, IQ_Rec);
 		get ->
-		    case catch get_data(LUser, LServer, Els) of
-			{'EXIT', _Reason} ->
-			    IQ#iq{type = error,
-				  sub_el = [SubEl,
-					    ?ERR_INTERNAL_SERVER_ERROR]};
-			Res ->
-			    IQ#iq{type = result,
-				  sub_el = [{xmlelement, Name, Attrs, Res}]}
-		    end
+		    process_iq_get(From, To, IQ_Rec)
 	    end;
-	false ->
-	    IQ#iq{type = error, sub_el = [SubEl, ?ERR_NOT_ALLOWED]}
+	{error, Error} ->
+	    exmpp_iq:error(IQ_Rec, Error)
     end.
 
-set_data(LUser, LServer, El) ->
-    case El of
-	{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(
-			       lists:flatten(xml:element_to_string(El))),
-			odbc_queries:set_private_data(LServer, Username, LXMLNS, SData)
-	    end;
-	_ ->
-	    ignore
+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, exmpp_xml:get_child_elements(SubEl))
+    end,
+    odbc_queries:sql_transaction(LServer, F),
+    exmpp_iq:result(IQ_Rec).
+
+
+check_packet(From, To, IQ_Rec) ->
+    check_packet(From, To, IQ_Rec, [ fun check_domain/3,
+				     fun check_user/3,
+				     fun check_ns/3]).
+check_packet(_From, _To, _IQ_Rec, []) ->
+    ok;
+check_packet(From, To, IQ_Rec, [F | R]) ->
+    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.
+
+
+
+set_data(LUser, LServer, El) ->
+    XMLNS = exmpp_xml:get_ns_as_list(El),
+    Username = ejabberd_odbc:escape(LUser),
+	LXMLNS = ejabberd_odbc:escape(XMLNS),
+	SData = ejabberd_odbc:escape(exmpp_xml:document_to_list(El)),
+	odbc_queries:set_private_data(LServer, Username, LXMLNS, SData).
+
 get_data(LUser, LServer, Els) ->
     get_data(LUser, LServer, Els, []).
 
 get_data(_LUser, _LServer, [], Res) ->
     lists:reverse(Res);
 get_data(LUser, LServer, [El | Els], Res) ->
-    case El of
-	{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 when element(1, Data) == xmlelement ->
-			    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.
+    XMLNS = exmpp_xml:get_ns_as_list(El),
+    Username = ejabberd_odbc:escape(LUser),
+    LXMLNS = ejabberd_odbc:escape(XMLNS),
+    case catch odbc_queries:get_private_data(LServer, Username, LXMLNS) of
+    {selected, ["data"], [{SData}]} ->
+	[Data] = exmpp_xml:parse_document(SData,[namespace,
+						 name_as_atom,
+						 autoload_known]),
+	get_data(LUser, LServer, Els, [Data | Res]);
+    %% 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.
 
 
 remove_user(User, Server) ->
-    LUser = jlib:nodeprep(User),
-    LServer = jlib:nameprep(Server),
-    Username = ejabberd_odbc:escape(LUser),
-    odbc_queries:del_user_private_storage(LServer, Username).
+    try
+	LUser = exmpp_stringprep:nodeprep(User),
+	LServer = exmpp_stringprep:nameprep(Server),
+	Username = ejabberd_odbc:escape(LUser),
+	odbc_queries:del_user_private_storage(LServer, Username)
+    catch
+	_ ->
+	    ok
+    end.
diff --git a/src/mod_version.erl b/src/mod_version.erl
index 26a960dca..ec7115a37 100644
--- a/src/mod_version.erl
+++ b/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,
-			       xmlns = _XMLNS, sub_el = SubEl} = IQ) ->
+process_local_iq(_From, To, #iq{type = Type} = IQ_Rec) ->
     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,
-		  sub_el = [{xmlelement, "query",
-			     [{"xmlns", ?NS_VERSION}],
-			     [{xmlelement, "name", [],
-			       [{xmlcdata, "ejabberd"}]},
-			      {xmlelement, "version", [],
-			       [{xmlcdata, ?VERSION}]}
-			     ] ++ OS
-			    }]}
+	    R = #xmlel{ns = ?NS_SOFT_VERSION, name = 'query',
+		       children = [ exmpp_xml:set_cdata(#xmlel{ns = ?NS_SOFT_VERSION,
+							       name = 'name'},
+							<<"ejabberd">>),
+				    exmpp_xml:set_cdata(#xmlel{ns = ?NS_SOFT_VERSION,
+							       name = 'version'},
+							?VERSION) | 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).