Index: ejabberd_ctl.erl
===================================================================
--- ejabberd_ctl.erl	(revisión: 444)
+++ ejabberd_ctl.erl	(copia de trabajo)
@@ -6,16 +6,35 @@
 %%% Id      : $Id$
 %%%----------------------------------------------------------------------
 
+%%% ejabberdctl-extra patch v0.5 for ejabberd 0.9.8 (23/Nov/2005) 
+%%%
+%%% INSTALL:
+%%%  1. Copy ejabberd_ctl.erl.diff to your ejabberd/src
+%%%  2. Apply the patch with: patch -p0 <ejabberd_ctl.erl.diff
+%%%  3. Recompile and restart ejabberd 
+%%%
+%%% USAGE:
+%%%  - Now you have several new options for ejabberd-ctl
+%%%  - Example for vcard: ejabberdctl eja@host vcard-get joe myjab.net email
+%%%  - The file used by 'pushroster' and 'pushroster-all' must be placed on 
+%%%      the same directory where the .beam files are. Example content:
+%%%         [{"bob", "myserver", "workers", "Bob"},
+%%%          {"mart", "myserver", "workers", "Mart"},
+%%%          {"Rich", "myserver", "bosses", "Rich"}].
+
 -module(ejabberd_ctl).
 -author('alexey@sevcom.net').
 
--export([start/0, dump_to_textfile/1]).
+-export([start/0, dump_to_textfile/1, add_rosteritem/8, pushroster/3, pushroster_all/1, push_alltoall/2, 
+	num_active_users/2, delete_older_users/1, vcard_get/3, vcard_set/4, vcard_set/5]).
 
 -define(STATUS_SUCCESS, 0).
 -define(STATUS_ERROR,   1).
 -define(STATUS_USAGE,   2).
 -define(STATUS_BADRPC,  3).
 
+-include("jlib.hrl").
+
 start() ->
     case init:get_plain_arguments() of
 	[SNode | Args] ->
@@ -173,6 +192,20 @@
 	    ?STATUS_BADRPC
     end;
 
+process(Node, ["load-config", Path]) ->
+    case rpc:call(Node, ejabberd_config, load_file, [Path]) of
+        {atomic, ok} ->
+            ?STATUS_SUCCESS;
+        {error, Reason} ->
+            io:format("Can't load config file ~p at node ~p: ~p~n",
+                      [filename:absname(Path), Node, Reason]),
+	    ?STATUS_ERROR;
+        {badrpc, Reason} ->
+            io:format("Can't load config file ~p at node ~p: ~p~n",
+                      [filename:absname(Path), Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
 process(Node, ["import-file", Path]) ->
     case rpc:call(Node, jd2ejd, import_file, [Path]) of
         ok ->
@@ -228,7 +261,233 @@
 	_ ->
 	    ?STATUS_SUCCESS
     end;
+ 
+process(Node, ["delete-older-messages", Days]) ->
+    case rpc:call(Node, mod_offline, remove_old_messages, [list_to_integer(Days)]) of
+	{badrpc, Reason} ->
+	    io:format("Can't delete old messages at node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC;
+	_ ->
+	    ?STATUS_SUCCESS
+    end;
 
+process(Node, ["delete-older-users", Days]) ->
+    case rpc:call(Node, ejabberd_ctl, delete_older_users, [list_to_integer(Days)]) of
+	{badrpc, Reason} ->
+	    io:format("Can't delete older users at node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC;
+	{removed, N, UR} ->
+	    io:format("Removed ~p users: ~p~n", [N, UR]),
+	    ?STATUS_SUCCESS
+    end;
+
+process(Node, ["num-active-users", Host, Days]) ->
+    case rpc:call(Node, ejabberd_ctl, num_active_users, [Host, list_to_integer(Days)]) of
+	Number when is_integer(Number) ->
+	    io:format("~p~n", [Number]),
+	    ?STATUS_SUCCESS;
+	{badrpc, Reason} ->
+	    io:format("Can't get number of active users at node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC;
+	_ ->
+	    ?STATUS_SUCCESS
+    end;
+process(Node, ["set-password", User, Server, Password]) ->
+    case rpc:call(Node, ejabberd_auth, set_password, [User, Server, Password]) of
+	{atomic, ok} ->
+            ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't set password for user ~p@~p on node ~p: ~p~n",
+		      [User, Server, Node, Reason]),
+	    ?STATUS_ERROR
+    end;
+
+process(Node, ["import", Path]) ->
+    case rpc:call(Node, jd2ejd, import_dir, [Path]) of
+	    {atomic, ok} ->
+            ?STATUS_SUCCESS;
+        _ ->
+            Reason = "unknown reason",
+            io:format("Can't import ~p on node ~p: ~p~n",
+                [Path, Node, Reason]),
+            ?STATUS_ERROR
+    end;
+
+process(Node, ["add-rosteritem", LocalUser, LocalServer, RemoteUser, RemoteServer, Nick, Group, Subs]) ->
+    case rpc:call(Node, ejabberd_ctl, add_rosteritem, 
+		[LocalUser, LocalServer, RemoteUser, RemoteServer, Nick, Group, list_to_atom(Subs), []]) of
+	{atomic, ok} ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't add ~p@~p to ~p@~p on node ~p: ~p~n",
+		      [RemoteUser, RemoteServer, LocalUser, LocalServer, Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't add roster item to user ~p on node ~p: ~p~n",
+		      [LocalUser, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["pushroster", File, User, Server]) ->
+    case rpc:call(Node, ejabberd_ctl, pushrosterq, [File, User, Server]) of
+	ok ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't push roster ~p to ~p@~p on node ~p: ~p~n",
+		      [File, User, Server, Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't push roster ~p on node ~p: ~p~n",
+		      [File, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["pushroster-all", File]) ->
+    case rpc:call(Node, ejabberd_ctl, pushroster_all, [File]) of
+	ok ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't push roster ~p on node ~p: ~p~n",
+		      [File, Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't push roster ~p on node ~p: ~p~n",
+		      [File, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["push-alltoall", Server, Group]) ->
+    case rpc:call(Node, ejabberd_ctl, push_alltoall, [Server, Group]) of
+	ok ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't push all to all on node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't push all to all on node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+ 
+process(Node, ["vcard-get", User, Server, Data]) ->
+    case rpc:call(Node, ejabberd_ctl, vcard_get, [User, Server, Data]) of
+	{ok, Res} ->
+	    io:format("~s~n", [Res]),
+	    ?STATUS_SUCCESS;
+	{badrpc, Reason} ->
+	    io:format("Can't get vcard attribute at node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["vcard-get", User, Server, Data1, Data2]) ->
+    case rpc:call(Node, ejabberd_ctl, vcard_get, [User, Server, {Data1, Data2}]) of
+	{ok, Res} ->
+	    io:format("~s~n", [Res]),
+	    ?STATUS_SUCCESS;
+	{badrpc, Reason} ->
+	    io:format("Can't get vcard attribute at node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["vcard-set", User, Server, Data, Content]) ->
+    case rpc:call(Node, ejabberd_ctl, vcard_set, [User, Server, Data, Content]) of
+	{ok, Res} ->
+	    io:format("~s~n", [Res]),
+	    ?STATUS_SUCCESS;
+	{badrpc, Reason} ->
+	    io:format("Can't set vcard attribute at node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["vcard-set", User, Server, Data1, Data2, Content]) ->
+    case rpc:call(Node, ejabberd_ctl, vcard_set, [User, Server, Data1, Data2, Content]) of
+	{ok, Res} ->
+	    io:format("~s~n", [Res]),
+	    ?STATUS_SUCCESS;
+	{badrpc, Reason} ->
+	    io:format("Can't set vcard attribute at node ~p: ~p~n",
+		      [Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["compile", Module]) ->
+    case rpc:call(Node, compile, file, [Module]) of
+        {ok, _} ->
+            ?STATUS_SUCCESS;
+        error ->
+            io:format("Can't compile file ~p at node ~p~n",
+                      [Module, Node]),
+	    ?STATUS_ERROR;
+        {badrpc, Reason} ->
+            io:format("Can't compile file ~p at node ~p: ~p~n",
+                      [Module, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["create-group", Group, Host, Name, Description, Display]) ->
+	Opts = [{name, Name}, {displayed_groups, [Display]}, {description, Description}],
+    case rpc:call(Node, mod_shared_roster, create_group, [Host, Group, Opts]) of
+	{atomic, ok} ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't create group ~p on host ~p on node ~p: ~p~n",
+		      [Group, Host, Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't create group ~p on host ~p on node ~p: ~p~n",
+		      [Group, Host, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["delete-group", Group, Host]) ->
+    case rpc:call(Node, mod_shared_roster, delete_group, [Host, Group]) of
+	{atomic, ok} ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't delete group ~p on host ~p on node ~p: ~p~n",
+		      [Group, Host, Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't delete group ~p on host ~p on node ~p: ~p~n",
+		      [Group, Host, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["add-usertogroup", User, Server, Group, Host]) ->
+    case rpc:call(Node, mod_shared_roster, add_user_to_group, [Host, {User, Server}, Group]) of
+	{atomic, ok} ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't add ~p@~p to ~p on host ~p on node ~p: ~p~n",
+		      [User, Server, Group, Host, Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't add ~p@~p to ~p on host ~p on node ~p: ~p~n",
+		      [User, Server, Group, Host, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
+process(Node, ["rem-userfromgroup", User, Server, Group, Host]) ->
+    case rpc:call(Node, mod_shared_roster, remove_user_from_group, [Host, {User, Server}, Group]) of
+	{atomic, ok} ->
+	    ?STATUS_SUCCESS;
+	{error, Reason} ->
+	    io:format("Can't remove ~p@~p from ~p on host ~p on node ~p: ~p~n",
+		      [User, Server, Group, Host, Node, Reason]),
+	    ?STATUS_ERROR;
+	{badrpc, Reason} ->
+	    io:format("Can't remove ~p@~p from ~p on host ~p on node ~p: ~p~n",
+		      [User, Server, Group, Host, Node, Reason]),
+	    ?STATUS_BADRPC
+    end;
+
 process(_Node, _Args) ->
     print_usage(),
     ?STATUS_USAGE.
@@ -240,12 +499,16 @@
       "Usage: ejabberdctl node command~n"
       "~n"
       "Available commands:~n"
+      "~n"
+      " - SERVER:~n"
       "  status\t\t\tget ejabberd status~n"
       "  stop\t\t\t\tstop ejabberd~n"
       "  restart\t\t\trestart ejabberd~n"
       "  reopen-log\t\t\treopen log file~n"
-      "  register user server password\tregister a user~n"
-      "  unregister user server\tunregister a user~n"
+      "  load-config file\t\tload config from file~n"
+      "  compile file\t\t\trecompile and reload file~n"
+      "~n"
+      " - MAINTANCE:~n"
       "  backup file\t\t\tstore a database backup to file~n"
       "  restore file\t\t\trestore a database backup from file~n"
       "  install-fallback file\t\tinstall a database fallback from file~n"
@@ -253,9 +516,36 @@
       "  load file\t\t\trestore a database from a text file~n"
       "  import-file file\t\timport user data from jabberd 1.4 spool file~n"
       "  import-dir dir\t\timport user data from jabberd 1.4 spool directory~n"
-      "  registered-users\t\tlist all registered users~n"
       "  delete-expired-messages\tdelete expired offline messages from database~n"
+      "  delete-older-messages days\tdelete offline messages older than 'days'~n"      
+      "  delete-older-users days\tdelete users that have not logged in the last 'days'~n"      
       "~n"
+      " - USERS:~n"
+      "  register user server password\t\t\tregister a user~n"
+      "  set-password user server password\t\tset password to user@server~n"
+      "  unregister user server\t\t\tunregister a user~n"
+      "  registered-users\t\t\t\tlist all registered users~n"
+      "  num-active-users server days\t\t\tnumber of users active in the last 'days'~n"      
+      "  vcard-get user server data [data2]\t\tget data from the vCard of the user~n"
+      "  vcard-set user server data [data2] content\tsets data to content on the vCard~n"
+      "~n"
+      " - ROSTERS:~n"
+      "  add-rosteritem user1 server1 user2 server2 nick group subs~n"
+      "       Adds user2@server2 to user1@server1~n"
+      "       subs= none, from, to or both~n"
+      "       example: add-roster peter localhost mike server.com MiKe Employees both~n"
+      "       will add mike@server.com to peter@localhost roster~n"
+      "  pushroster file user server\t\tpush template roster in file to user@server~n"
+      "  pushroster-all file\t\t\tpush template roster in file to all those users~n"
+      "  push-alltoall server group\t\tadds all the users to all the users in Group~n"
+      "~n"
+      " - SHARED ROSTER GROUPS:~n"
+      "  create-group group host name description display\tCreate the group with options~n"
+      "  delete-group group host\t\t\t\tDelete the group~n"
+      "  add-usertogroup username server group host\t\tAdds user@server to group on host~n"
+      "  rem-userfromgroup username server group host\t\tRemoves user@server from group on host~n"
+
+      "~n"
       "Example:~n"
       "  ejabberdctl ejabberd@host restart~n"
      ).
@@ -294,3 +584,210 @@
     lists:foreach(
       fun(Term) -> io:format(F,"~p.~n", [setelement(1, Term, T)]) end, All).
 
+add_rosteritem(LU, LS, RU, RS, Nick, Group, Subscription, Xattrs) ->
+	subscribe(LU, LS, RU, RS, Nick, Group, Subscription, Xattrs),
+	% TODO: if the server is not local and Subs=to or both: send subscription request
+	% TODO: check if the 'remote server' is a virtual host here, else do nothing
+	%add_rosteritem2(RU, RS, LU, LS, LU, "", invert_subs(Subscription), Xattrs, Host).
+	subscribe(RU, RS, LU, LS, LU, "", invert_subs(Subscription), Xattrs).
+
+invert_subs(none) -> none;
+invert_subs(to) -> none;
+invert_subs(from) -> to;
+invert_subs(both) -> both.
+
+subscribe(LocalUser, LocalServer, RemoteUser, RemoteServer, Nick, Group, Subscription, Xattrs) ->
+	mnesia:transaction(
+		fun() ->
+			mnesia:write({
+				roster,
+				{LocalUser,LocalServer,{RemoteUser,RemoteServer,[]}}, % usj
+				{LocalUser,LocalServer},                 % us
+				{RemoteUser,RemoteServer,[]},      % jid
+				Nick,                  % name: "Mom", []
+				Subscription,  % subscription: none, to=you see him, from=he sees you, both
+				none,          % ask: out=send request, in=somebody requests you, none
+				[Group],       % groups: ["Family"]
+				Xattrs,        % xattrs: [{"category","conference"}]
+				[]             % xs: []
+		})
+	end).
+
+pushroster(File, User, Server) ->
+	{ok, [Roster]} = file:consult(File),
+	subscribe_roster({User, Server, "", User}, Roster).
+
+pushroster_all(File) ->
+	{ok, [Roster]} = file:consult(File),
+	subscribe_all(Roster).
+
+subscribe_all(Roster) ->
+	subscribe_all(Roster, Roster).
+subscribe_all([], _) ->
+	ok;
+subscribe_all([User1 | Users], Roster) ->
+	subscribe_roster(User1, Roster),
+	subscribe_all(Users, Roster).
+
+subscribe_roster(_, []) ->
+	ok;
+% Do not subscribe a user to itself
+subscribe_roster({Name, Server, Group, Nick}, [{Name, Server, _, _} | Roster]) ->
+	subscribe_roster({Name, Server, Group, Nick}, Roster);
+% Subscribe Name2 to Name1
+subscribe_roster({Name1, Server1, Group1, Nick1}, [{Name2, Server2, Group2, Nick2} | Roster]) ->
+	subscribe(Name1, Server1, Name2, Server2, Nick2, Group2, both, []),
+	subscribe_roster({Name1, Server1, Group1, Nick1}, Roster).
+
+push_alltoall(S, G) ->
+	Users = ejabberd_auth:get_vh_registered_users(S),
+	Users2 = build_list_users(G, Users, []),
+	subscribe_all(Users2).
+
+build_list_users(_Group, [], Res) ->
+	Res;
+build_list_users(Group, [{User, Server}|Users], Res) ->
+	build_list_users(Group, Users, [{User, Server, Group, User}|Res]).
+
+vcard_get(User, Server, DataX) ->
+    [{_, _, A1}] = mnesia:dirty_read(vcard, {User, Server}),
+    Elem = vcard_get(DataX, A1),
+    {ok, xml:get_tag_cdata(Elem)}.
+
+vcard_get({Data1, Data2}, A1) ->
+    A2 = xml:get_subtag(A1, Data1),
+    A3 = xml:get_subtag(A2, Data2),
+    case A3 of
+		"" -> A2;
+		_ -> A3
+	end;
+
+vcard_get({Data}, A1) ->
+    xml:get_subtag(A1, Data).
+
+vcard_set(User, Server, Data1, Data2, Content) ->
+	Content2 = {xmlelement, Data2, [], [{xmlcdata,Content}]},
+	R = {xmlelement, Data1, [], [Content2]},
+	vcard_set(User, Server, R).
+
+vcard_set(User, Server, Data, Content) ->
+	R = {xmlelement, Data, [], [{xmlcdata,Content}]},
+	vcard_set(User, Server, R).
+
+vcard_set(User, Server, R) ->
+	SubEl = {xmlelement, "vCard", [{"xmlns","vcard-temp"}], [R]},
+	IQ = #iq{type=set, sub_el = SubEl},
+	JID = jlib:make_jid(User, Server, ""),
+	mod_vcard:process_sm_iq(JID, JID, IQ),
+	{ok, "done"}.
+
+
+-record(last_activity, {us, timestamp, status}).
+
+delete_older_users(Days) ->
+	% Convert older time
+	SecOlder = Days*24*60*60,
+
+	% Get current time
+	{MegaSecs, Secs, _MicroSecs} = now(),
+	TimeStamp_now = MegaSecs * 1000000 + Secs,
+
+	% Get the list of registered users
+	Users = ejabberd_auth:dirty_get_registered_users(),
+
+	% For a user, remove if required and answer true
+	F = fun({LUser, LServer}) ->
+		% Check if the user is logged
+		case ejabberd_sm:get_user_resources(LUser, LServer) of
+			% If it isn't
+			[] ->
+				% Look for his last_activity
+				case mnesia:dirty_read(last_activity, {LUser, LServer}) of
+				% If it is
+					% existent:
+					[#last_activity{timestamp = TimeStamp}] ->
+						% get his age
+						Sec = TimeStamp_now - TimeStamp,
+						% If he is
+						if 
+							% younger than SecOlder: 
+							Sec < SecOlder ->
+								% do nothing
+								false;
+							% older: 
+							true ->
+								% remove the user
+								ejabberd_auth:remove_user(LUser, LServer),
+								true
+						end;
+					% nonexistent:
+					[] ->
+						% remove the user
+						ejabberd_auth:remove_user(LUser, LServer),
+						true
+				end;
+			% Else
+			_ ->
+				% do nothing
+				false
+		end
+	end,
+	% Apply the function to every user in the list
+	Users_removed = lists:filter(F, Users),
+	{removed, length(Users_removed), Users_removed}.
+
+num_active_users(Host, Days) ->
+	list_last_activity(Host, true, Days).
+
+% Code based on ejabberd/src/web/ejabberd_web_admin.erl
+list_last_activity(Host, Integral, Days) ->
+    {MegaSecs, Secs, _MicroSecs} = now(),
+    TimeStamp = MegaSecs * 1000000 + Secs,
+    TS = TimeStamp - Days * 86400,
+    case catch mnesia:dirty_select(
+		 last_activity, [{{last_activity, {'_', Host}, '$1', '_'},
+				  [{'>', '$1', TS}],
+				  [{'trunc', {'/',
+					      {'-', TimeStamp, '$1'},
+					      86400}}]}]) of
+	{'EXIT', _Reason} ->
+	    [];
+	Vals ->
+	    Hist = histogram(Vals, Integral),
+	    if
+		Hist == [] ->
+		    0;
+		true ->
+		    Left = if
+			       Days == infinity ->
+				   0;
+			       true ->
+				   Days - length(Hist)
+			   end,
+		    Tail = if
+			       Integral ->
+				   lists:duplicate(Left, lists:last(Hist));
+			       true ->
+				   lists:duplicate(Left, 0)
+			   end,
+		    lists:nth(Days, Hist ++ Tail)
+	    end
+    end.
+histogram(Values, Integral) ->
+    histogram(lists:sort(Values), Integral, 0, 0, []).
+histogram([H | T], Integral, Current, Count, Hist) when Current == H ->
+    histogram(T, Integral, Current, Count + 1, Hist);
+histogram([H | _] = Values, Integral, Current, Count, Hist) when Current < H ->
+    if
+	Integral ->
+	    histogram(Values, Integral, Current + 1, Count, [Count | Hist]);
+	true ->
+	    histogram(Values, Integral, Current + 1, 0, [Count | Hist])
+    end;
+histogram([], _Integral, _Current, Count, Hist) ->
+    if
+	Count > 0 ->
+	    lists:reverse([Count | Hist]);
+	true ->
+	    lists:reverse(Hist)
+    end.