%%%-------------------------------------------------------------------

%%% File    : mod_admin_extra.erl

%%% Author  : Badlop <badlop@process-one.net>

%%% Purpose : Contributed administrative functions and commands

%%% Created : 10 Aug 2008 by Badlop <badlop@process-one.net>

%%%

%%%

%%% ejabberd, Copyright (C) 2002-2008   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_admin_extra).

-author('badlop@process-one.net').

-behaviour(gen_mod).

-export([start/2, stop/1,

	 %% Node

	 compile/1,

	 load_config/1,

	 get_cookie/0,

	 remove_node/1,

	 export2odbc/2,

	 %% Accounts

	 set_password/3,

	 check_password_hash/4,

	 delete_old_users/1,

	 delete_old_users_vhost/2,

	 ban_account/3,

	 num_active_users/2,

	 %% Sessions

	 num_resources/2,

	 resource_num/3,

	 kick_session/4,

	 status_num/2, status_num/1,

	 status_list/2, status_list/1,

	 connected_users_info/0,

	 connected_users_vhost/1,

	 set_presence/7,

	 user_sessions_info/2,

	 %% Vcard

	 set_nickname/3,

	 get_vcard/3,

	 get_vcard/4,

	 get_vcard_multi/4,

	 set_vcard/4,

	 set_vcard/5,

	 %% Roster

	 add_rosteritem/7,

	 delete_rosteritem/4,

	 process_rosteritems/5,

	 get_roster/2,

	 push_roster/3,

	 push_roster_all/1,

	 push_alltoall/2,

	 %% mod_last

	 set_last/4,

	 %% mod_private

	 private_get/4,

	 private_set/3,

	 %% mod_shared_roster

	 srg_create/5,

	 srg_delete/2,

	 srg_list/1,

	 srg_get_info/2,

	 srg_get_members/2,

	 srg_user_add/4,

	 srg_user_del/4,

	 %% Stanza

	 send_message_headline/4,

	 send_message_chat/3,

	 send_stanza_c2s/4,

	 privacy_set/3,

	 %% Stats

	 stats/1, stats/2

	]).

-include("ejabberd.hrl").

-include("ejabberd_commands.hrl").

-include("mod_roster.hrl").

-include("jlib.hrl").

%% Copied from ejabberd_sm.erl

-record(session, {sid, usr, us, priority, info}).

%%%

%%% gen_mod

%%%

start(_Host, _Opts) ->

    ejabberd_commands:register_commands(commands()).

stop(_Host) ->

    ejabberd_commands:unregister_commands(commands()).

%%%

%%% Register commands

%%%

commands() ->

    Vcard1FieldsString = "Some vcard field names in get/set_vcard are:\n"

	" FN		- Full Name\n"

	" NICKNAME	- Nickname\n"

	" BDAY		- Birthday\n"

	" TITLE		- Work: Position\n"

	" ROLE		- Work: Role",

    Vcard2FieldsString = "Some vcard field names and subnames in get/set_vcard2 are:\n"

	" N FAMILY	- Family name\n"

	" N GIVEN	- Given name\n"

	" N MIDDLE	- Middle name\n"

	" ADR CTRY	- Address: Country\n"

	" ADR LOCALITY	- Address: City\n"

	" EMAIL USERID	- E-Mail Address\n"

	" ORG ORGNAME	- Work: Company\n"

	" ORG ORGUNIT	- Work: Department",

    VcardXEP = "For a full list of vCard fields check XEP-0054: vcard-temp at "

	"http://www.xmpp.org/extensions/xep-0054.html",

    [

     #ejabberd_commands{name = compile, tags = [erlang],

			desc = "Recompile and reload Erlang source code file",

			module = ?MODULE, function = compile,

			args = [{file, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = load_config, tags = [server],

			desc = "Load ejabberd configuration file",

			module = ?MODULE, function = load_config,

			args = [{file, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = get_cookie, tags = [erlang],

			desc = "Get the Erlang cookie of this node",

			module = ?MODULE, function = get_cookie,

			args = [],

			result = {cookie, string}},

     #ejabberd_commands{name = remove_node, tags = [erlang],

			desc = "Remove an ejabberd node from Mnesia clustering config",

			module = ?MODULE, function = remove_node,

			args = [{node, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = export2odbc, tags = [mnesia],

			desc = "Export Mnesia tables to files in directory",

			module = ?MODULE, function = export2odbc,

			args = [{host, string}, {path, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = num_active_users, tags = [accounts, stats],

			desc = "Get number of users active in the last days",

			module = ?MODULE, function = num_active_users,

			args = [{host, string}, {days, integer}],

			result = {users, integer}},

     #ejabberd_commands{name = delete_old_users, tags = [accounts, purge],

			desc = "Delete users that didn't log in last days, or that never logged",

			module = ?MODULE, function = delete_old_users,

			args = [{days, integer}],

			result = {res, restuple}},

     #ejabberd_commands{name = delete_old_users_vhost, tags = [accounts, purge],

			desc = "Delete users that didn't log in last days in vhost, or that never logged",

			module = ?MODULE, function = delete_old_users_vhost,

			args = [{host, string}, {days, integer}],

			result = {res, restuple}},

     #ejabberd_commands{name = check_account, tags = [accounts],

			desc = "Check if an account exists or not",

			module = ejabberd_auth, function = is_user_exists,

			args = [{user, string}, {host, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = check_password, tags = [accounts],

			desc = "Check if a password is correct",

			module = ejabberd_auth, function = check_password,

			args = [{user, string}, {host, string}, {password, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = check_password_hash, tags = [accounts],

			desc = "Check if the password hash is correct",

			longdesc = "Allowed hash methods: md5, sha.",

			module = ?MODULE, function = check_password_hash,

			args = [{user, string}, {host, string}, {passwordhash, string}, {hashmethod, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = change_password, tags = [accounts],

			desc = "Change the password of an account",

			module = ?MODULE, function = set_password,

			args = [{user, string}, {host, string}, {newpass, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = ban_account, tags = [accounts],

			desc = "Ban an account: kick sessions and set random password",

			module = ?MODULE, function = ban_account,

			args = [{user, string}, {host, string}, {reason, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = num_resources, tags = [session],

			desc = "Get the number of resources of a user",

			module = ?MODULE, function = num_resources,

			args = [{user, string}, {host, string}],

			result = {resources, integer}},

     #ejabberd_commands{name = resource_num, tags = [session],

			desc = "Resource string of a session number",

			module = ?MODULE, function = resource_num,

			args = [{user, string}, {host, string}, {num, integer}],

			result = {resource, string}},

     #ejabberd_commands{name = kick_session, tags = [session],

			desc = "Kick a user session",

			module = ?MODULE, function = kick_session,

			args = [{user, string}, {host, string}, {resource, string}, {reason, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = status_num_host, tags = [session, stats],

			desc = "Number of logged users with this status in host",

			module = ?MODULE, function = status_num,

			args = [{host, string}, {status, string}],

			result = {users, integer}},

     #ejabberd_commands{name = status_num, tags = [session, stats],

			desc = "Number of logged users with this status",

			module = ?MODULE, function = status_num,

			args = [{status, string}],

			result = {users, integer}},

     #ejabberd_commands{name = status_list_host, tags = [session],

			desc = "List of users logged in host with their statuses",

			module = ?MODULE, function = status_list,

			args = [{host, string}, {status, string}],

			result = {users, {list,

					  {userstatus, {tuple, [

								{user, string},

								{host, string},

								{resource, string},

								{priority, integer},

								{status, string}

							       ]}}

					 }}},

     #ejabberd_commands{name = status_list, tags = [session],

			desc = "List of logged users with this status",

			module = ?MODULE, function = status_list,

			args = [{status, string}],

			result = {users, {list,

					  {userstatus, {tuple, [

								{user, string},

								{host, string},

								{resource, string},

								{priority, integer},

								{status, string}

							       ]}}

					 }}},

     #ejabberd_commands{name = connected_users_info,

			tags = [session],

			desc = "List all established sessions and their information",

			module = ?MODULE, function = connected_users_info,

			args = [],

			result = {connected_users_info,

				  {list,

				   {sessions, {tuple,

					       [{jid, string},

						{connection, string},

						{ip, string},

						{port, integer},

						{priority, integer},

						{node, string},

						{uptime, integer}

					       ]}}

				  }}},

     #ejabberd_commands{name = connected_users_vhost,

                       tags = [session],

                       desc = "Get the list of established sessions in a vhost",

                       module = ?MODULE, function = connected_users_vhost,

                       args = [{host, string}],

                       result = {connected_users_vhost, {list, {sessions, string}}}},

     #ejabberd_commands{name = user_sessions_info,

			tags = [session],

			desc = "Get information about all sessions of a user",

			module = ?MODULE, function = user_sessions_info,

			args = [{user, string}, {host, string}],

			result = {sessions_info,

				  {list,

				   {session, {tuple,

					      [{connection, string},

					       {ip, string},

					       {port, integer},

					       {priority, integer},

					       {node, string},

					       {uptime, integer},

					       {status, string},

					       {resource, string},

					       {statustext, string}

					      ]}}

				  }}},

     #ejabberd_commands{name = set_presence,

			tags = [session],

			desc = "Set presence of a session",

			module = ?MODULE, function = set_presence,

			args = [{user, string}, {host, string},

				{resource, string}, {type, string},

				{show, string}, {status, string},

				{priority, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = set_nickname, tags = [vcard],

			desc = "Set nickname in a user's vCard",

			module = ?MODULE, function = set_nickname,

			args = [{user, string}, {host, string}, {nickname, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = get_vcard, tags = [vcard],

			desc = "Get content from a vCard field",

			longdesc = Vcard1FieldsString ++ "\n" ++ Vcard2FieldsString ++ "\n\n" ++ VcardXEP,

			module = ?MODULE, function = get_vcard,

			args = [{user, string}, {host, string}, {name, string}],

			result = {content, string}},

     #ejabberd_commands{name = get_vcard2, tags = [vcard],

			desc = "Get content from a vCard field",

			longdesc = Vcard2FieldsString ++ "\n\n" ++ Vcard1FieldsString ++ "\n" ++ VcardXEP,

			module = ?MODULE, function = get_vcard,

			args = [{user, string}, {host, string}, {name, string}, {subname, string}],

			result = {content, string}},

     #ejabberd_commands{name = get_vcard2_multi, tags = [vcard],

			desc = "Get multiple contents from a vCard field (requires exmpp installed)",

			longdesc = Vcard2FieldsString ++ "\n\n" ++ Vcard1FieldsString ++ "\n" ++ VcardXEP,

			module = ?MODULE, function = get_vcard_multi,

			args = [{user, string}, {host, string}, {name, string}, {subname, string}],

			result = {contents, {list, string}}},

     #ejabberd_commands{name = set_vcard, tags = [vcard],

			desc = "Set content in a vCard field",

			longdesc = Vcard1FieldsString ++ "\n" ++ Vcard2FieldsString ++ "\n\n" ++ VcardXEP,

			module = ?MODULE, function = set_vcard,

			args = [{user, string}, {host, string}, {name, string}, {content, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = set_vcard2, tags = [vcard],

			desc = "Set content in a vCard subfield",

			longdesc = Vcard2FieldsString ++ "\n\n" ++ Vcard1FieldsString ++ "\n" ++ VcardXEP,

			module = ?MODULE, function = set_vcard,

			args = [{user, string}, {host, string}, {name, string}, {subname, string}, {content, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = set_vcard2_multi, tags = [vcard],

			desc = "Set multiple contents in a vCard subfield",

			longdesc = Vcard2FieldsString ++ "\n\n" ++ Vcard1FieldsString ++ "\n" ++ VcardXEP,

			module = ?MODULE, function = set_vcard,

			args = [{user, string}, {host, string}, {name, string}, {subname, string}, {contents, {list, string}}],

			result = {res, rescode}},

     #ejabberd_commands{name = add_rosteritem, tags = [roster],

			desc = "Add an item to a user's roster (supports ODBC)",

			module = ?MODULE, function = add_rosteritem,

			args = [{localuser, string}, {localserver, string},

				{user, string}, {server, string},

				{nick, string}, {group, string},

				{subs, string}],

			result = {res, rescode}},

     %%{"", "subs= none, from, to or both"},

     %%{"", "example: add-roster peter localhost mike server.com MiKe Employees both"},

     %%{"", "will add mike@server.com to peter@localhost roster"},

     #ejabberd_commands{name = delete_rosteritem, tags = [roster],

			desc = "Delete an item from a user's roster (supports ODBC)",

			module = ?MODULE, function = delete_rosteritem,

			args = [{localuser, string}, {localserver, string},

				{user, string}, {server, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = process_rosteritems, tags = [roster],

			desc = "List or delete rosteritems that match filtering options",

			longdesc = "Explanation of each argument:\n"

			" - action: what to do with each rosteritem that "

			"matches all the filtering options\n"

			" - subs: subscription type\n"

			" - asks: pending subscription\n"

			" - users: the JIDs of the local user\n"

			" - contacts: the JIDs of the contact in the roster\n"

			"\n"

			"Allowed values in the arguments:\n"

			"  ACTION = list | delete\n"

			"  SUBS = SUB[:SUB]* | any\n"

			"  SUB = none | from | to | both\n"

			"  ASKS = ASK[:ASK]* | any\n"

			"  ASK = none | out | in\n"

			"  USERS = JID[:JID]* | any\n"

			"  CONTACTS = JID[:JID]* | any\n"

			"  JID = characters valid in a JID, and can use the "

			"globs: *, ?, ! and [...]\n"

			"\n"

			"This example will list roster items with subscription "

			"'none', 'from' or 'to' that have any ask property, of "

			"local users which JID is in the virtual host "

			"'example.org' and that the contact JID is either a "

			"bare server name (without user part) or that has a "

			"user part and the server part contains the word 'icq'"

			":\n  list none:from:to any *@example.org *:*@*icq*",

			module = ?MODULE, function = process_rosteritems,

			args = [{action, string}, {subs, string},

				{asks, string}, {users, string},

				{contacts, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = get_roster, tags = [roster],

			desc = "Get roster of a local user",

			module = ?MODULE, function = get_roster,

			args = [{user, string}, {host, string}],

			result = {contacts, {list, {contact, {tuple, [

								      {jid, string},

								      {nick, string},

								      {subscription, string},

								      {ask, string},

								      {group, string}

								     ]}}}}},

     #ejabberd_commands{name = push_roster, tags = [roster],

			desc = "Push template roster from file to a user",

			module = ?MODULE, function = push_roster,

			args = [{file, string}, {user, string}, {host, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = push_roster_all, tags = [roster],

			desc = "Push template roster from file to all those users",

			module = ?MODULE, function = push_roster_all,

			args = [{file, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = push_alltoall, tags = [roster],

			desc = "Add all the users to all the users of Host in Group",

			module = ?MODULE, function = push_alltoall,

			args = [{host, string}, {group, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = set_last, tags = [last],

			desc = "Set last activity information",

			longdesc = "Timestamp is the seconds since"

			"1970-01-01 00:00:00 UTC, for example: date +%s",

			module = ?MODULE, function = set_last,

			args = [{user, string}, {host, string}, {timestamp, integer}, {status, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = private_get, tags = [private],

			desc = "Get some information from a user private storage",

			module = ?MODULE, function = private_get,

			args = [{user, string}, {host, string}, {element, string}, {ns, string}],

			result = {res, string}},

     #ejabberd_commands{name = private_set, tags = [private],

			desc = "Set to the user private storage",

			module = ?MODULE, function = private_set,

			args = [{user, string}, {host, string}, {element, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = srg_create, tags = [shared_roster_group],

			desc = "Create a Shared Roster Group",

			longdesc = "If you want to specify several group "

			"identifiers in the Display argument,\n"

			"put  \\ \" around the argument and\nseparate the "

			"identifiers with \\ \\ n\n"

			"For example:\n"

			"  ejabberdctl srg_create group3 localhost "

			"name desc \\\"group1\\\\ngroup2\\\"",

			module = ?MODULE, function = srg_create,

			args = [{group, string}, {host, string},

				{name, string}, {description, string}, {display, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = srg_delete, tags = [shared_roster_group],

			desc = "Delete a Shared Roster Group",

			module = ?MODULE, function = srg_delete,

			args = [{group, string}, {host, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = srg_list, tags = [shared_roster_group],

			desc = "List the Shared Roster Groups in Host",

			module = ?MODULE, function = srg_list,

			args = [{host, string}],

			result = {groups, {list, {id, string}}}},

     #ejabberd_commands{name = srg_get_info, tags = [shared_roster_group],

			desc = "Get info of a Shared Roster Group",

			module = ?MODULE, function = srg_get_info,

			args = [{group, string}, {host, string}],

			result = {informations, {list, {information, {tuple, [{key, string}, {value, string}]}}}}},

     #ejabberd_commands{name = srg_get_members, tags = [shared_roster_group],

			desc = "Get members of a Shared Roster Group",

			module = ?MODULE, function = srg_get_members,

			args = [{group, string}, {host, string}],

			result = {members, {list, {member, string}}}},

     #ejabberd_commands{name = srg_user_add, tags = [shared_roster_group],

			desc = "Add the JID user@host to the Shared Roster Group",

			module = ?MODULE, function = srg_user_add,

			args = [{user, string}, {host, string}, {group, string}, {grouphost, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = srg_user_del, tags = [shared_roster_group],

			desc = "Delete this JID user@host from the Shared Roster Group",

			module = ?MODULE, function = srg_user_del,

			args = [{user, string}, {host, string}, {group, string}, {grouphost, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = send_message_chat, tags = [stanza],

			desc = "Send a chat message to a local or remote bare of full JID",

			module = ?MODULE, function = send_message_chat,

			args = [{from, string}, {to, string}, {body, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = send_message_headline, tags = [stanza],

			desc = "Send a headline message to a local or remote bare of full JID",

			module = ?MODULE, function = send_message_headline,

			args = [{from, string}, {to, string},

				{subject, string}, {body, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = send_stanza_c2s, tags = [stanza],

			desc = "Send a stanza as if sent from a c2s session",

			module = ?MODULE, function = send_stanza_c2s,

			args = [{user, string}, {host, string}, {resource, string}, {stanza, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = privacy_set, tags = [stanza],

			desc = "Send a IQ set privacy stanza for a local account",

			module = ?MODULE, function = privacy_set,

			args = [{user, string}, {host, string}, {xmlquery, string}],

			result = {res, rescode}},

     #ejabberd_commands{name = stats, tags = [stats],

			desc = "Get statistical value: registeredusers onlineusers onlineusersnode uptimeseconds",

			module = ?MODULE, function = stats,

			args = [{name, string}],

			result = {stat, integer}},

     #ejabberd_commands{name = stats_host, tags = [stats],

			desc = "Get statistical value for this host: registeredusers onlineusers",

			module = ?MODULE, function = stats,

			args = [{name, string}, {host, string}],

			result = {stat, integer}}

    ].

%%%

%%% Node

%%%

compile(File) ->

    case compile:file(File) of

	ok -> ok;

	_ -> error

    end.

load_config(Path) ->

    ok = ejabberd_config:load_file(Path).

get_cookie() ->

    atom_to_list(erlang:get_cookie()).

remove_node(Node) ->

    mnesia:del_table_copy(schema, list_to_atom(Node)),

    ok.

export2odbc(Host, Directory) ->

    Tables = [

	      {export_last, last},

	      {export_offline, offline},

	      {export_passwd, passwd},

	      {export_private_storage, private_storage},

	      {export_roster, roster},

	      {export_vcard, vcard},

	      {export_vcard_search, vcard_search}],

    Export = fun({TableFun, Table}) ->

		     Filename = filename:join([Directory, atom_to_list(Table)++".txt"]),

		     io:format("Trying to export Mnesia table '~p' on Host '~s' to file '~s'~n", [Table, Host, Filename]),

		     Res = (catch ejd2odbc:TableFun(Host, Filename)),

		     io:format("  Result: ~p~n", [Res])

	     end,

    lists:foreach(Export, Tables),

    ok.

%%%

%%% Accounts

%%%

set_password(User, Host, Password) ->

    case ejabberd_auth:set_password(User, Host, Password) of

	ok ->

	    ok;

	_ ->

	    error

    end.

%% Copied some code from ejabberd_commands.erl

check_password_hash(User, Host, PasswordHash, HashMethod) ->

    AccountPass = ejabberd_auth:get_password_s(User, Host),

    AccountPassHash = case HashMethod of

			  "md5" -> get_md5(AccountPass);

			  "sha" -> get_sha(AccountPass);

			  _ -> undefined

		      end,

    case AccountPassHash of

	undefined -> error;

	PasswordHash -> ok;

	_ -> error

    end.

get_md5(AccountPass) ->

    lists:flatten([io_lib:format("~.16B", [X])

		   || X <- binary_to_list(crypto:md5(AccountPass))]).

get_sha(AccountPass) ->

    lists:flatten([io_lib:format("~.16B", [X])

		   || X <- binary_to_list(crypto:sha(AccountPass))]).

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 = Days - length(Hist),

			 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.

delete_old_users(Days) ->

    %% Get the list of registered users

    Users = ejabberd_auth:dirty_get_registered_users(),

    {removed, N, UR} = delete_old_users(Days, Users),

    {ok, io_lib:format("Deleted ~p users: ~p", [N, UR])}.

delete_old_users_vhost(Host, Days) ->

    %% Get the list of registered users

    Users = ejabberd_auth:get_vh_registered_users(Host),

    {removed, N, UR} = delete_old_users(Days, Users),

    {ok, io_lib:format("Deleted ~p users: ~p", [N, UR])}.

delete_old_users(Days, Users) ->

    %% Convert older time

    SecOlder = Days*24*60*60,

    %% Get current time

    {MegaSecs, Secs, _MicroSecs} = now(),

    TimeStamp_now = MegaSecs * 1000000 + Secs,

    %% 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 isnt

		    [] ->

			%% Look for his last_activity

			case (get_lastactivity_module(LServer)):get_last_info(LUser, LServer) of

			    %% If it is

			    %% existent:

			    {ok, TimeStamp, _Status} ->

				%% 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:

			    not_found ->

				%% 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}.

get_lastactivity_module(Server) ->

    case lists:member(mod_last, gen_mod:loaded_modules(Server)) of

        true -> mod_last;

        _ -> mod_last_odbc

    end.

%%

%% Ban account

ban_account(User, Host, ReasonText) ->

    Reason = prepare_reason(ReasonText),

    kick_sessions(User, Host, Reason),

    set_random_password(User, Host, Reason),

    ok.

kick_sessions(User, Server, Reason) ->

    lists:map(

      fun(Resource) ->

	      kick_this_session(User, Server, Resource, Reason)

      end,

      get_resources(User, Server)).

get_resources(User, Server) ->

    lists:map(

      fun(Session) ->

	      element(3, Session#session.usr)

      end,

      get_sessions(User, Server)).

get_sessions(User, Server) ->

    LUser = jlib:nodeprep(User),

    LServer = jlib:nameprep(Server),

    Sessions =  mnesia:dirty_index_read(session, {LUser, LServer}, #session.us),

    true = is_list(Sessions),

    Sessions.

set_random_password(User, Server, Reason) ->

    NewPass = build_random_password(Reason),

    set_password_auth(User, Server, NewPass).

build_random_password(Reason) ->

    Date = jlib:timestamp_to_iso(calendar:universal_time()),

    RandomString = randoms:get_string(),

    "BANNED_ACCOUNT--" ++ Date ++ "--" ++ RandomString ++ "--" ++ Reason.

set_password_auth(User, Server, Password) ->

    ok = ejabberd_auth:set_password(User, Server, Password).

prepare_reason([]) ->

    "Kicked by administrator";

prepare_reason([Reason]) ->

    Reason;

prepare_reason(Reason) when is_list(Reason) ->

    Reason;

prepare_reason(StringList) ->

    string:join(StringList, "_").

%%%

%%% Sessions

%%%

num_resources(User, Host) ->

    length(ejabberd_sm:get_user_resources(User, Host)).

resource_num(User, Host, Num) ->

    Resources = ejabberd_sm:get_user_resources(User, Host),

    case (0<Num) and (Num=<length(Resources)) of

	true ->

	    lists:nth(Num, Resources);

	false ->

	    lists:flatten(io_lib:format("Error: Wrong resource number: ~p", [Num]))

    end.

kick_session(User, Server, Resource, ReasonText) ->

    kick_this_session(User, Server, Resource, prepare_reason(ReasonText)),

    ok.

kick_this_session(User, Server, Resource, Reason) ->

    ejabberd_router:route(

      jlib:make_jid("", "", ""),

      jlib:make_jid(User, Server, Resource),

      {xmlelement, "broadcast", [], [{exit, Reason}]}).

status_num(Host, Status) ->

    length(get_status_list(Host, Status)).

status_num(Status) ->

    status_num("all", Status).

status_list(Host, Status) ->

    Res = get_status_list(Host, Status),

    [{U, S, R, P, St} || {U, S, R, P, St} <- Res].

status_list(Status) ->

    status_list("all", Status).

get_status_list(Host, Status_required) ->

    %% Get list of all logged users

    Sessions = ejabberd_sm:dirty_get_my_sessions_list(),

    %% Reformat the list

    Sessions2 = [ {Session#session.usr, Session#session.sid, Session#session.priority} || Session <- Sessions],

    Fhost = case Host of

		"all" ->

		    %% All hosts are requested, so dont filter at all

		    fun(_, _) -> true end;

		_ ->

		    %% Filter the list, only Host is interesting

		    fun(A, B) -> A == B end

	    end,

    Sessions3 = [ {Pid, Server, Priority} || {{_User, Server, _Resource}, {_, Pid}, Priority} <- Sessions2, apply(Fhost, [Server, Host])],

    %% For each Pid, get its presence

    Sessions4 = [ {ejabberd_c2s:get_presence(Pid), Server, Priority} || {Pid, Server, Priority} <- Sessions3],

    %% Filter by status

    Fstatus = case Status_required of

		  "all" ->

		      fun(_, _) -> true end;

		  _ ->

		      fun(A, B) -> A == B end

	      end,

    [{User, Server, Resource, Priority, stringize(Status_text)}

     || {{User, Resource, Status, Status_text}, Server, Priority} <- Sessions4,

	apply(Fstatus, [Status, Status_required])].

connected_users_info() ->

    USRIs = dirty_get_sessions_list2(),

    CurrentSec = calendar:datetime_to_gregorian_seconds({date(), time()}),

    lists:map(

      fun([{U, S, R}, {Now, Pid}, Priority, Info]) ->

	      Conn = proplists:get_value(conn, Info),

	      {Ip, Port} = proplists:get_value(ip, Info),

	      IPS = inet_parse:ntoa(Ip),

	      NodeS = atom_to_list(node(Pid)),

	      Uptime = CurrentSec - calendar:datetime_to_gregorian_seconds(

				      calendar:now_to_local_time(Now)),

	      {[U, $@, S, $/, R], atom_to_list(Conn), IPS, Port, Priority, NodeS, Uptime}

      end,

      USRIs).

connected_users_vhost(Host) ->

    USRs = ejabberd_sm:get_vh_session_list(Host),

    [ [U, $@, S, $/, R] || {U, S, R} <- USRs].

%% Code copied from ejabberd_sm.erl and customized

dirty_get_sessions_list2() ->

    mnesia:dirty_select(

      session,

      [{#session{usr = '$1', sid = '$2', priority = '$3', info = '$4', _ = '_'},

	[],

	[['$1', '$2', '$3', '$4']]}]).

%% Make string more print-friendly

stringize(String) ->

    %% Replace newline characters with other code

    ejabberd_regexp:greplace(String, "\n", "\\n").

set_presence(User, Host, Resource, Type, Show, Status, Priority) ->

    Pid = ejabberd_sm:get_session_pid(User, Host, Resource),

    USR = User ++ "@" ++ Host ++ "/" ++ Resource,

    US = User ++ "@" ++ Host,

    Message = {route_xmlstreamelement,

	       {xmlelement, "presence",

		[{"from", USR}, {"to", US}, {"type", Type}],

		[{xmlelement, "show", [], [{xmlcdata, Show}]},

		 {xmlelement, "status", [], [{xmlcdata, Status}]},

		 {xmlelement, "priority", [], [{xmlcdata, Priority}]}]}},

    Pid ! Message.

user_sessions_info(User, Host) ->

    CurrentSec = calendar:datetime_to_gregorian_seconds({date(), time()}),

    US = {User, Host},

    Sessions = case catch mnesia:dirty_index_read(session, US, #session.us) of

		   {'EXIT', _Reason} ->

		       [];

		   Ss ->

		       Ss

	       end,

    lists:map(

      fun(Session) ->

	      {_U, _S, Resource} = Session#session.usr,

	      {Now, Pid} = Session#session.sid,

	      {_U, _Resource, Status, StatusText} = ejabberd_c2s:get_presence(Pid),

	      Info = Session#session.info,

	      Priority = Session#session.priority,

	      Conn = proplists:get_value(conn, Info),

	      {Ip, Port} = proplists:get_value(ip, Info),

	      IPS = inet_parse:ntoa(Ip),

	      NodeS = atom_to_list(node(Pid)),

	      Uptime = CurrentSec - calendar:datetime_to_gregorian_seconds(

				      calendar:now_to_local_time(Now)),

	      {atom_to_list(Conn), IPS, Port, Priority, NodeS, Uptime, Status, Resource, StatusText}

      end,

      Sessions).

%%%

%%% Vcard

%%%

set_nickname(User, Host, Nickname) ->

    R = mod_vcard:process_sm_iq(

	  {jid, User, Host, "", User, Host, ""},

	  {jid, User, Host, "", User, Host, ""},

	  {iq, "", set, "", "en",

	   {xmlelement, "vCard",

	    [{"xmlns", "vcard-temp"}], [

					{xmlelement, "NICKNAME", [], [{xmlcdata, Nickname}]}

				       ]

	   }}),

    case R of

	{iq, [], result, [], _L, []} ->

	    ok;

	_ ->

	    error

    end.

get_vcard(User, Host, Name) ->

    [Res | _] = get_vcard_content(User, Host, [Name]),

    Res.

get_vcard(User, Host, Name, Subname) ->

    [Res | _] = get_vcard_content(User, Host, [Name, Subname]),

    Res.

get_vcard_multi(User, Host, Name, Subname) ->

    get_vcard_content(User, Host, [Name, Subname]).

set_vcard(User, Host, Name, SomeContent) ->

    set_vcard_content(User, Host, [Name], SomeContent).

set_vcard(User, Host, Name, Subname, SomeContent) ->

    set_vcard_content(User, Host, [Name, Subname], SomeContent).

%%

%% Internal vcard

get_module_resource(Server) ->

    case gen_mod:get_module_opt(Server, ?MODULE, module_resource, none) of

	none -> atom_to_list(?MODULE);

	R when is_list(R) -> R

    end.

get_vcard_content(User, Server, Data) ->

    [{_, Module, Function, _Opts}] = ets:lookup(sm_iqtable, {?NS_VCARD, Server}),

    JID = jlib:make_jid(User, Server, get_module_resource(Server)),

    IQ = #iq{type = get, xmlns = ?NS_VCARD},

    IQr = Module:Function(JID, JID, IQ),

    case IQr#iq.sub_el of

	[A1] ->

	    case get_vcard(Data, A1) of

		[] -> throw(error_no_value_found_in_vcard);

		ElemList -> [xml:get_tag_cdata(Elem) || Elem <- ElemList]

	    end;

	[] ->

	    throw(error_no_vcard_found)

    end.

get_vcard([Data1, Data2], A1) ->

    case get_subtag(A1, Data1) of

    	false -> false;

	A2List -> lists:flatten([get_vcard([Data2], A2) || A2 <- A2List])

    end;

get_vcard([Data], A1) ->

    get_subtag(A1, Data).

get_subtag(Xmlelement, Name) ->

    case code:ensure_loaded(exmpp_xml) of

	{error, _} ->

	    [get_subtag_xml(Xmlelement, Name)];

	{module, exmpp_xml} ->

	    get_subtag_exmpp(Xmlelement, Name)

    end.

get_subtag_xml(Xmlelement, Name) ->

    xml:get_subtag(Xmlelement, Name).

get_subtag_exmpp(Xmlelement, Name) ->

    Xmlel = exmpp_xml:xmlelement_to_xmlel(Xmlelement),

    XmlelList = exmpp_xml:get_elements(Xmlel, Name),

    [exmpp_xml:xmlel_to_xmlelement(Xmlel2) || Xmlel2 <- XmlelList].

set_vcard_content(User, Server, Data, SomeContent) ->

    ContentList = case SomeContent of

	[Char | _] when not is_list(Char) -> [SomeContent];

	[Char | _] when is_list(Char) -> SomeContent

    end,

    [{_, Module, Function, _Opts}] = ets:lookup(sm_iqtable, {?NS_VCARD, Server}),

    JID = jlib:make_jid(User, Server, get_module_resource(Server)),

    IQ = #iq{type = get, xmlns = ?NS_VCARD},

    IQr = Module:Function(JID, JID, IQ),

    %% Get old vcard

    A4 = case IQr#iq.sub_el of

	     [A1] ->

		 {_, _, _, A2} = A1,

		 update_vcard_els(Data, ContentList, A2);

	     [] ->

		 update_vcard_els(Data, ContentList, [])

	 end,

    %% Build new vcard

    SubEl = {xmlelement, "vCard", [{"xmlns","vcard-temp"}], A4},

    IQ2 = #iq{type=set, sub_el = SubEl},

    Module:Function(JID, JID, IQ2),

    ok.

update_vcard_els(Data, ContentList, Els1) ->

    Els2 = lists:keysort(2, Els1),

    [Data1 | Data2] = Data,

    NewEls = case Data2 of

		[] ->

		    [{xmlelement, Data1, [], [{xmlcdata,Content}]} || Content <- ContentList];

		[D2] ->

		    OldEl = case lists:keysearch(Data1, 2, Els2) of

				{value, A} -> A;

				false -> {xmlelement, Data1, [], []}

			    end,

		    {xmlelement, _, _, ContentOld1} = OldEl,

		    Content2 = [{xmlelement, D2, [], [{xmlcdata,Content}]} || Content <- ContentList],

		    ContentOld2 = [A || {_, X, _, _} = A <- ContentOld1, X/=D2],

		    ContentOld3 = lists:keysort(2, ContentOld2),

		    ContentNew = lists:keymerge(2, Content2, ContentOld3),

		    [{xmlelement, Data1, [], ContentNew}]

	    end,

    Els3 = lists:keydelete(Data1, 2, Els2),

    lists:keymerge(2, NewEls, Els3).

%%%

%%% Roster

%%%

add_rosteritem(LocalUser, LocalServer, User, Server, Nick, Group, Subs) ->

    case add_rosteritem(LocalUser, LocalServer, User, Server, Nick, Group, list_to_atom(Subs), []) of

	{atomic, ok} ->

	    push_roster_item(LocalUser, LocalServer, User, Server, {add, Nick, Subs, Group}),

	    ok;

	_ ->

	    error

    end.

add_rosteritem(LU, LS, User, Server, Nick, Group, Subscription, Xattrs) ->

    subscribe(LU, LS, User, Server, Nick, Group, Subscription, Xattrs).

subscribe(LU, LS, User, Server, Nick, Group, Subscription, _Xattrs) ->

    SubscriptionS = case is_atom(Subscription) of

	true -> atom_to_list(Subscription);

	false -> Subscription

    end,

    ItemEl = build_roster_item(User, Server, {add, Nick, SubscriptionS, Group}),

    {ok, M} = loaded_module(LS,[mod_roster_odbc,mod_roster]),

    M:set_items(

	LU, LS,

	{xmlelement,"query",

            [{"xmlns","jabber:iq:roster"}],

            [ItemEl]}).

delete_rosteritem(LocalUser, LocalServer, User, Server) ->

    case unsubscribe(LocalUser, LocalServer, User, Server) of

	{atomic, ok} ->

	    push_roster_item(LocalUser, LocalServer, User, Server, remove),

	    ok;

	_  ->

	    error

    end.

unsubscribe(LU, LS, User, Server) ->

    ItemEl = build_roster_item(User, Server, remove),

    {ok, M} = loaded_module(LS,[mod_roster_odbc,mod_roster]),

    M:set_items(

	LU, LS,

	{xmlelement,"query",

            [{"xmlns","jabber:iq:roster"}],

            [ItemEl]}).

loaded_module(Domain,Options) ->

    LoadedModules = gen_mod:loaded_modules(Domain),

    case lists:filter(fun(Module) ->

                              lists:member(Module, LoadedModules)

                      end, Options) of

        [M|_] -> {ok, M};

        [] -> {error,not_found}

    end.

%% -----------------------------

%% Get Roster

%% -----------------------------

get_roster(User, Server) ->

    Items = ejabberd_hooks:run_fold(roster_get, Server, [], [{User, Server}]),

    make_roster_xmlrpc(Items).

%% Note: if a contact is in several groups, the contact is returned

%% several times, each one in a different group.

make_roster_xmlrpc(Roster) ->

    lists:foldl(

      fun(Item, Res) ->

	      JIDS = jlib:jid_to_string(Item#roster.jid),

	      Nick = Item#roster.name,

	      Subs = atom_to_list(Item#roster.subscription),

	      Ask = atom_to_list(Item#roster.ask),

	      Groups = case Item#roster.groups of

			   [] -> [""];

			   Gs -> Gs

		       end,

	      ItemsX = [{JIDS, Nick, Subs, Ask, Group}

			|| Group <- Groups],

	      ItemsX ++ Res

      end,

      [],

      Roster).

%%-----------------------------

%% Push Roster from file

%%-----------------------------

push_roster(File, User, Server) ->

    {ok, [Roster]} = file:consult(File),

    subscribe_roster({User, Server, "", User}, Roster).

push_roster_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),

    ok.

build_list_users(_Group, [], Res) ->

    Res;

build_list_users(Group, [{User, Server}|Users], Res) ->

    build_list_users(Group, Users, [{User, Server, Group, User}|Res]).

%% @spec(LU, LS, U, S, Action) -> ok

%%       Action = {add, Nick, Subs, Group} | remove

%% @doc Push to the roster of account LU@LS the contact U@S.

%% The specific action to perform is defined in Action.

push_roster_item(LU, LS, U, S, Action) ->

    lists:foreach(fun(R) ->

			  push_roster_item(LU, LS, R, U, S, Action)

		  end, ejabberd_sm:get_user_resources(LU, LS)).

push_roster_item(LU, LS, R, U, S, Action) ->

    LJID = jlib:make_jid(LU, LS, R),

    BroadcastEl = build_broadcast(U, S, Action),

    ejabberd_router:route(LJID, LJID, BroadcastEl),

    Item = build_roster_item(U, S, Action),

    ResIQ = build_iq_roster_push(Item),

    ejabberd_router:route(LJID, LJID, ResIQ).

build_roster_item(U, S, {add, Nick, Subs, Group}) ->

    {xmlelement, "item",

     [{"jid", jlib:jid_to_string(jlib:make_jid(U, S, ""))},

      {"name", Nick},

      {"subscription", Subs}],

     [{xmlelement, "group", [], [{xmlcdata, Group}]}]

    };

build_roster_item(U, S, remove) ->

    {xmlelement, "item",

     [{"jid", jlib:jid_to_string(jlib:make_jid(U, S, ""))},

      {"subscription", "remove"}],

     []

    }.

build_iq_roster_push(Item) ->

    {xmlelement, "iq",

     [{"type", "set"}, {"id", "push"}],

     [{xmlelement, "query",

       [{"xmlns", ?NS_ROSTER}],

       [Item]

      }

     ]

    }.

build_broadcast(U, S, {add, _Nick, Subs, _Group}) ->

    build_broadcast(U, S, list_to_atom(Subs));

build_broadcast(U, S, remove) ->

    build_broadcast(U, S, none);

%% @spec (U::string(), S::string(), Subs::atom()) -> any()

%% Subs = both | from | to | none

build_broadcast(U, S, SubsAtom) when is_atom(SubsAtom) ->

    {xmlelement, "broadcast", [],

     [{item, {U, S, ""}, SubsAtom}]

    }.

%%%

%%% Last Activity

%%%

set_last(User, Server, Timestamp, Status) ->

    Mod = get_lastactivity_module(Server),

    Mod:store_last_info(User, Server, Timestamp, Status).

%%%

%%% Private Storage

%%%

%% Example usage:

%% $ ejabberdctl private_set badlop localhost "\<aa\ xmlns=\'bb\'\>Cluth\</aa\>"

%% $ ejabberdctl private_get badlop localhost aa bb

%% <aa xmlns='bb'>Cluth</aa>

private_get(Username, Host, Element, Ns) ->

    From = jlib:make_jid(Username, Host, ""),

    To = jlib:make_jid(Username, Host, ""),

    IQ = {iq, "", get, ?NS_PRIVATE, "",

	  {xmlelement,"query",

	   [{"xmlns",?NS_PRIVATE}],

	   [{xmlelement, Element, [{"xmlns", Ns}], []}]}},

    ResIq = mod_private:process_sm_iq(From, To, IQ),

    [{xmlelement,"query",

      [{"xmlns","jabber:iq:private"}],

      [SubEl]}] = ResIq#iq.sub_el,

    xml:element_to_string(SubEl).

private_set(Username, Host, ElementString) ->

    case xml_stream:parse_element(ElementString) of

	{error, Error} ->

	    io:format("Error found parsing the element:~n  ~p~nError: ~p~n",

		      [ElementString, Error]),

	    error;

	Xml ->

	    private_set2(Username, Host, Xml)

    end.

private_set2(Username, Host, Xml) ->

    From = jlib:make_jid(Username, Host, ""),

    To = jlib:make_jid(Username, Host, ""),

    IQ = {iq, "", set, ?NS_PRIVATE, "",

	  {xmlelement,"query",

	   [{"xmlns",?NS_PRIVATE}],

	   [Xml]}},

    mod_private:process_sm_iq(From, To, IQ),

    ok.

%%%

%%% Shared Roster Groups

%%%

srg_create(Group, Host, Name, Description, Display) ->

    DisplayList = case Display of

	[] -> [];

	_ -> ejabberd_regexp:split(Display, "\\\\n")

    end,

    Opts = [{name, Name},

	    {displayed_groups, DisplayList},

	    {description, Description}],

    {atomic, ok} = mod_shared_roster:create_group(Host, Group, Opts),

    ok.

srg_delete(Group, Host) ->

    {atomic, ok} = mod_shared_roster:delete_group(Host, Group),

    ok.

srg_list(Host) ->

    lists:sort(mod_shared_roster:list_groups(Host)).

srg_get_info(Group, Host) ->

    Opts = mod_shared_roster:get_group_opts(Host,Group),

    [{io_lib:format("~p", [Title]),

      io_lib:format("~p", [Value])} || {Title, Value} <- Opts].

srg_get_members(Group, Host) ->

    Members = mod_shared_roster:get_group_explicit_users(Host,Group),

    [jlib:jid_to_string(jlib:make_jid(MUser, MServer, ""))

     || {MUser, MServer} <- Members].

srg_user_add(User, Host, Group, GroupHost) ->

    {atomic, ok} = mod_shared_roster:add_user_to_group(GroupHost, {User, Host}, Group),

    ok.

srg_user_del(User, Host, Group, GroupHost) ->

    {atomic, ok} = mod_shared_roster:remove_user_from_group(GroupHost, {User, Host}, Group),

    ok.

%%%

%%% Stanza

%%%

%% @doc Send a chat message to a Jabber account.

%% @spec (From::string(), To::string(), Body::string()) -> ok

send_message_chat(From, To, Body) ->

    Packet = build_packet(message_chat, [Body]),

    send_packet_all_resources(From, To, Packet).

%% @doc Send a headline message to a Jabber account.

%% @spec (From::string(), To::string(), Subject::string(), Body::string()) -> ok

send_message_headline(From, To, Subject, Body) ->

    Packet = build_packet(message_headline, [Subject, Body]),

    send_packet_all_resources(From, To, Packet).

%% @doc Send a packet to a Jabber account.

%% If a resource was specified in the JID,

%% the packet is sent only to that specific resource.

%% If no resource was specified in the JID,

%% and the user is remote or local but offline,

%% the packet is sent to the bare JID.

%% If the user is local and is online in several resources,

%% the packet is sent to all its resources.

send_packet_all_resources(FromJIDString, ToJIDString, Packet) ->

    FromJID = jlib:string_to_jid(FromJIDString),

    ToJID = jlib:string_to_jid(ToJIDString),

    ToUser = ToJID#jid.user,

    ToServer = ToJID#jid.server,

    case ToJID#jid.resource of

	"" ->

	    send_packet_all_resources(FromJID, ToUser, ToServer, Packet);

	Res ->

	    send_packet_all_resources(FromJID, ToUser, ToServer, Res, Packet)

    end.

send_packet_all_resources(FromJID, ToUser, ToServer, Packet) ->

    case ejabberd_sm:get_user_resources(ToUser, ToServer) of

	[] ->

	    send_packet_all_resources(FromJID, ToUser, ToServer, "", Packet);

	ToResources ->

	    lists:foreach(

	      fun(ToResource) ->

		      send_packet_all_resources(FromJID, ToUser, ToServer,

						ToResource, Packet)

	      end,

	      ToResources)

    end.

send_packet_all_resources(FromJID, ToU, ToS, ToR, Packet) ->

    ToJID = jlib:make_jid(ToU, ToS, ToR),

    ejabberd_router:route(FromJID, ToJID, Packet).

build_packet(message_chat, [Body]) ->

    {xmlelement, "message",

     [{"type", "chat"}, {"id", randoms:get_string()}],

     [{xmlelement, "body", [], [{xmlcdata, Body}]}]

    };

build_packet(message_headline, [Subject, Body]) ->

    {xmlelement, "message",

     [{"type", "headline"}, {"id", randoms:get_string()}],

     [{xmlelement, "subject", [], [{xmlcdata, Subject}]},

      {xmlelement, "body", [], [{xmlcdata, Body}]}

     ]

    }.

send_stanza_c2s(Username, Host, Resource, Stanza) ->

    C2sPid = ejabberd_sm:get_session_pid(Username, Host, Resource),

    XmlEl = xml_stream:parse_element(Stanza),

    p1_fsm:send_event(C2sPid, {xmlstreamelement, XmlEl}).

privacy_set(Username, Host, QueryS) ->

    From = jlib:string_to_jid(Username ++ "@" ++ Host),

    To = jlib:string_to_jid(Host),

    QueryEl = xml_stream:parse_element(QueryS),

    StanzaEl = {xmlelement, "iq", [{"type", "set"}], [QueryEl]},

    IQ = jlib:iq_query_info(StanzaEl),

    ejabberd_hooks:run_fold(

		     privacy_iq_set,

		     Host,

		     {error, ?ERR_FEATURE_NOT_IMPLEMENTED},

		     [From, To, IQ]

		    ),

    ok.

%%%

%%% Stats

%%%

stats(Name) ->

    case Name of

	"uptimeseconds" -> trunc(element(1, erlang:statistics(wall_clock))/1000);

	"registeredusers" -> length(ejabberd_auth:dirty_get_registered_users());

	"onlineusersnode" -> length(ejabberd_sm:dirty_get_my_sessions_list());

	"onlineusers" -> length(ejabberd_sm:dirty_get_sessions_list())

    end.

stats(Name, Host) ->

    case Name of

	"registeredusers" -> length(ejabberd_auth:get_vh_registered_users(Host));

	"onlineusers" -> length(ejabberd_sm:get_vh_session_list(Host))

    end.

%%-----------------------------

%% Purge roster items

%%-----------------------------

process_rosteritems(ActionS, SubsS, AsksS, UsersS, ContactsS) ->

    Action = case ActionS of

		 "list" -> list;

		 "delete" -> delete

	     end,

    Subs = lists:foldl(

	     fun(any, _) -> [none, from, to, both];

		(Sub, Subs) -> [Sub | Subs]

	     end,

	     [],

	     [list_to_atom(S) || S <- string:tokens(SubsS, ":")]

	    ),

    Asks = lists:foldl(

	     fun(any, _) -> [none, out, in];

		(Ask, Asks) -> [Ask | Asks]

	     end,

	     [],

	     [list_to_atom(S) || S <- string:tokens(AsksS, ":")]

	    ),

    Users = lists:foldl(

	      fun("any", _) -> ["*", "*@*"];

		 (U, Us) -> [U | Us]

	      end,

	      [],

	      [S || S <- string:tokens(UsersS, ":")]

	     ),

    Contacts = lists:foldl(

		 fun("any", _) -> ["*", "*@*"];

		    (U, Us) -> [U | Us]

		 end,

		 [],

		 [S || S <- string:tokens(ContactsS, ":")]

		),

    case rosteritem_purge({Action, Subs, Asks, Users, Contacts}) of

	{atomic, ok} ->

	    ok;

	{error, Reason} ->

	    io:format("Error purging rosteritems: ~p~n", [Reason]),

	    error;

	{badrpc, Reason} ->

	    io:format("BadRPC purging rosteritems: ~p~n", [Reason]),

	    error

    end.

%% @spec ({Action::atom(), Subs::[atom()], Asks::[atom()], User::string(), Contact::string()}) -> {atomic, ok}

rosteritem_purge(Options) ->

    Num_rosteritems = mnesia:table_info(roster, size),

    io:format("There are ~p roster items in total.~n", [Num_rosteritems]),

    Key = mnesia:dirty_first(roster),

    ok = rip(Key, Options, {0, Num_rosteritems, 0, 0}),

    {atomic, ok}.

rip('$end_of_table', _Options, Counters) ->

    print_progress_line(Counters),

    ok;

rip(Key, Options, {Pr, NT, NV, ND}) ->

    Key_next = mnesia:dirty_next(roster, Key),

    {Action, _, _, _, _} = Options,

    ND2 = case decide_rip(Key, Options) of

	      true ->

		  apply_action(Action, Key),

		  ND+1;

	      false ->

		  ND

	  end,

    NV2 = NV+1,

    Pr2 = print_progress_line({Pr, NT, NV2, ND2}),

    rip(Key_next, Options, {Pr2, NT, NV2, ND2}).

apply_action(list, Key) ->

    {User, Server, JID} = Key,

    {RUser, RServer, _} = JID,

    io:format("Matches: ~s@~s ~s@~s~n", [User, Server, RUser, RServer]);

apply_action(delete, Key) ->

    apply_action(list, Key),

    mnesia:dirty_delete(roster, Key).

print_progress_line({Pr, NT, NV, ND}) ->

    Pr2 = trunc((NV/NT)*100),

    case Pr == Pr2 of

	true ->

	    ok;

	false ->

	    io:format("Progress ~p% - visited ~p - deleted ~p~n", [Pr2, NV, ND])

    end,

    Pr2.

decide_rip(Key, {_Action, Subs, Asks, User, Contact}) ->

    case catch mnesia:dirty_read(roster, Key) of

	[RI] ->

	    lists:member(RI#roster.subscription, Subs)

		andalso lists:member(RI#roster.ask, Asks)

		andalso decide_rip_jid(RI#roster.us, User)

		andalso decide_rip_jid(RI#roster.jid, Contact);

	_ ->

	    false

    end.

%% Returns true if the server of the JID is included in the servers

decide_rip_jid({UName, UServer, _UResource}, Match_list) ->

    decide_rip_jid({UName, UServer}, Match_list);

decide_rip_jid({UName, UServer}, Match_list) ->

    lists:any(

      fun(Match_string) ->

	      MJID = jlib:string_to_jid(Match_string),

	      MName = MJID#jid.luser,

	      MServer = MJID#jid.lserver,

	      Is_server = is_glob_match(UServer, MServer),

	      case MName of

		  [] when UName == [] ->

		      Is_server;

		  [] ->

		      false;

		  _ ->

		      Is_server

			  andalso is_glob_match(UName, MName)

	      end

      end,

      Match_list).

%% Copied from ejabberd-2.0.0/src/acl.erl

is_regexp_match(String, RegExp) ->

    case ejabberd_regexp:run(String, RegExp) of

	nomatch ->

	    false;

	match ->

	    true;

	{error, ErrDesc} ->

	    io:format(

	      "Wrong regexp ~p in ACL: ~p",

	      [RegExp, ErrDesc]),

	    false

    end.

is_glob_match(String, [$! | Glob]) ->

    not is_regexp_match(String, ejabberd_regexp:sh_to_awk(Glob));

is_glob_match(String, Glob) ->

    is_regexp_match(String, ejabberd_regexp:sh_to_awk(Glob)).

%%%-------------------------------------------------------------------

%%% File    : mod_ecomm_test.erl

%%% Author  : Badlop <badlop@process-one.net>

%%% Purpose : Simple commands for testing

%%% Created : 10 Aug 2008 by Badlop <badlop@process-one.net>

%%%

%%%

%%% ejabberd, Copyright (C) 2002-2008   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_ecomm_test).

-author('badlop@process-one.net').

-behaviour(gen_mod).

-export([start/2, stop/1,

	 %% Take: test arguments

	 take_integer/1,

	 take_string/1,

	 take_integer_string/2,

	 take_tuple_2integer/1,

	 take_tuple_2string/1,

	 take_list_integer/1,

	 take_list_string/1,

	 %% Echo: test arguments and result

	 echo_integer/1,

	 echo_string/1,

	 echo_integer_string/2,

	 echo_list_integer/1,

	 echo_list_string/1,

	 echo_integer_list_string/2,

	 echo_isatils/4,

	 %% Tell: test result

	 tell_atom/1,

	 tell_rescode/1,

	 tell_restuple/1,

	 tell_tuple_3integer/0,

	 tell_tuple_3string/0,

	 tell_tuple_3atom/0,

	 tell_tuple_3list/0,

	 tell_list_3integer/0,

	 tell_list_3string/0,

	 tell_list_3atom/0,

	 tell_list_3tuple/0,

	 %% Realistic

	 this_crashes/1,

	 this_wrong_args/1,

	 this_wrong_return/0,

	 pow/2, seq/2, substrs/1, splitjid/1, splitjids/1

	]).

-include("ejabberd.hrl").

-include("ejabberd_commands.hrl").

-include("jlib.hrl").

start(_Host, _Opts) ->

    ejabberd_commands:register_commands(commands()).

stop(_Host) ->

    ejabberd_commands:unregister_commands(commands()).

%%%

%%% ejabberd commands

%%%

commands() ->

    [

     #ejabberd_commands{name = take_integer, tags = [test],

		       desc = "Take Integer in args, give Integer zero",

		       module = ?MODULE, function = take_integer,

		       args = [{thisinteger, integer}],

		       result = {zero, integer}},

     #ejabberd_commands{name = take_string, tags = [test],

		       desc = "Take String, give Integer zero",

		       module = ?MODULE, function = take_string,

		       args = [{thisstring, string}],

		       result = {zero, integer}},

     #ejabberd_commands{name = take_integer_string, tags = [test],

		       desc = "Take integer and string, give Integer zero",

		       module = ?MODULE, function = take_integer_string,

		       args = [{thisinteger, integer}, {thisstring, string}],

		       result = {zero, integer}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = take_tuple_2integer, tags = [test],

		       desc = "Take Tuple of two integers, give Integer zero",

		       module = ?MODULE, function = take_tuple_2integer,

		       args = [{thistuple, {tuple, [{thisinteger1, integer}, {thisinteger2, integer}]}}],

		       result = {zero, integer}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = take_tuple_2string, tags = [test],

		       desc = "Take Tuple of two strings, give Integer zero",

		       module = ?MODULE, function = take_tuple_2string,

		       args = [{thistuple, {tuple, [{thisstring1, string}, {thisstring2, string}]}}],

		       result = {zero, integer}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = take_list_integer, tags = [test],

		       desc = "Take List of integers, give Integer zero",

		       module = ?MODULE, function = take_list_integer,

		       args = [{thislist, {list, {thisinteger, integer}}}],

		       result = {zero, integer}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = take_list_string, tags = [test],

		       desc = "Take List of strings, give Integer zero",

		       module = ?MODULE, function = take_list_string,

		       args = [{thislist, {list, {thisstring, string}}}],

		       result = {zero, integer}},

     #ejabberd_commands{name = echo_integer, tags = [test],

		       desc = "Echo Integer",

		       module = ?MODULE, function = echo_integer,

		       args = [{thisinteger, integer}],

		       result = {thatinteger, integer}},

     #ejabberd_commands{name = echo_string, tags = [test],

		       desc = "Echo String",

		       module = ?MODULE, function = echo_string,

		       args = [{thisstring, string}],

		       result = {thatstring, string}},

     #ejabberd_commands{name = echo_integer_string, tags = [test],

		       desc = "Echo integer and string, in result as a tuple",

		       module = ?MODULE, function = echo_integer_string,

		       args = [{thisinteger, integer}, {thisstring, string}],

		       result = {thistuple, {tuple, [{thisinteger, integer}, {thisstring, string}]}}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = echo_list_integer, tags = [test],

		       desc = "Echo List of integers",

		       module = ?MODULE, function = echo_list_integer,

		       args = [{thislist, {list, {thisinteger, integer}}}],

		       result = {thatlist, {list, {thatinteger, integer}}}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = echo_list_string, tags = [test],

		       desc = "Echo List of strings",

		       module = ?MODULE, function = echo_list_string,

		       args = [{thislist, {list, {thisstring, string}}}],

		       result = {thatlist, {list, {thatstring, string}}}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = echo_integer_list_string, tags = [test],

		       desc = "Echo an integer and List of strings",

		       module = ?MODULE, function = echo_integer_list_string,

		       args = [{thisinteger, integer}, {thislist, {list, {thisstring, string}}}],

		       result = {thistuple, {tuple, [{thatinteger, integer}, {thatlist, {list, {thatstring, string}}}]}}},

     %% Not supported by ejabberd_ctl

     #ejabberd_commands{name = echo_isatils, tags = [test],

		       desc = "Echo integer, string, atom and tuple of integer and list of strings",

		       module = ?MODULE, function = echo_isatils,

		       args = [{thisinteger, integer},

			       {thisstring, string},

			       {thisatom, atom},

			       {thistuple, {tuple, [

						    {listlen, integer},

						    {thislist, {list, {contentstring, string}}}

						   ]}}

			      ],

		       result = {results, {tuple, [{thatinteger, integer},

						   {thatstring, string},

						   {thatatom, atom},

						   {thattuple, {tuple, [

									{listlen, integer},

									{thatlist, {list, {contentstring, string}}}

								       ]}}

						  ]}}},

     #ejabberd_commands{name = tell_atom, tags = [test],

		       desc = "Tell Atom, give Integer zero",

		       module = ?MODULE, function = tell_atom,

		       args = [{thisinteger, integer}],

		       result = {thisatom, atom}},

     #ejabberd_commands{name = tell_rescode, tags = [test],

		       desc = "Tell rescode",

		       module = ?MODULE, function = tell_rescode,

		       args = [{thisinteger, integer}],

		       result = {res, rescode}},

     #ejabberd_commands{name = tell_restuple, tags = [test],

		       desc = "Tell restuple",

		       module = ?MODULE, function = tell_restuple,

		       args = [{thisinteger, integer}],

		       result = {res, restuple}},

     #ejabberd_commands{name = tell_tuple_3integer, tags = [test],

		       desc = "Tell a tuple with 3 integers",

		       module = ?MODULE, function = tell_tuple_3integer,

		       args = [],

		       result = {thattuple, {tuple, [{first, integer},

						     {second, integer},

						     {third, integer}]}}},

     #ejabberd_commands{name = tell_tuple_3string, tags = [test],

		       desc = "Tell a tuple with 3 strings",

		       module = ?MODULE, function = tell_tuple_3string,

		       args = [],

		       result = {thattuple, {tuple, [{first, string},

						     {second, string},

						     {third, string}]}}},

     #ejabberd_commands{name = tell_tuple_3atom, tags = [test],

		       desc = "Tell a tuple with 3 atoms",

		       module = ?MODULE, function = tell_tuple_3atom,

		       args = [],

		       result = {thattuple, {tuple, [{first, atom},

						     {second, atom},

						     {third, atom}]}}},

     #ejabberd_commands{name = tell_tuple_3list, tags = [test],

		       desc = "Tell a tuple with 3 lists",

		       module = ?MODULE, function = tell_tuple_3list,

		       args = [],

		       result = {thattuple, {tuple,

					     [{first, {list,

						       {thisinteger, integer}}},

					      {second, {list,

							{thisstring, string}}},

					      {third, {list,

						       {thisatom, atom}}}]}}},

     #ejabberd_commands{name = tell_list_3integer, tags = [test],

		       desc = "Tell a list with 3 integers",

		       module = ?MODULE, function = tell_list_3integer,

		       args = [],

		       result = {thatlist, {list, {thisinteger, integer}}}},

     #ejabberd_commands{name = tell_list_3string, tags = [test],

		       desc = "Tell a list with 3 strings",

		       module = ?MODULE, function = tell_list_3string,

		       args = [],

		       result = {thatlist, {list, {thisstring, string}}}},

     #ejabberd_commands{name = tell_list_3atom, tags = [test],

		       desc = "Tell a list with 3 atoms",

		       module = ?MODULE, function = tell_list_3atom,

		       args = [],

		       result = {thatlist, {list, {thisatom, atom}}}},

     #ejabberd_commands{name = tell_list_3tuple, tags = [test],

		       desc = "Tell a list with 3 tuples",

		       module = ?MODULE, function = tell_list_3tuple,

		       args = [],

		       result = {thatlist, {list, {thistuple,

						   {tuple,

						    [{thisinteger, integer},

						     {thistring, string},

						     {thisatom, atom}]}}}}},

     #ejabberd_commands{name = this_crashes, tags = [test],

		       desc = "This command crashes: test+5",

		       module = ?MODULE, function = this_crashes,

		       args = [{aninteger, integer}],

		       result = {result, integer}},

     #ejabberd_commands{name = this_wrong_args, tags = [test],

		       desc = "This problematic command defines 2 arguments but function expects 1",

		       module = ?MODULE, function = this_wrong_args,

		       args = [{a, integer}, {b, integer}],

		       result = {result, integer}},

     #ejabberd_commands{name = this_wrong_return, tags = [test],

		       desc = "This problematic command doesn't give a proper return",

		       module = ?MODULE, function = this_wrong_return,

		       args = [],

		       result = {result, integer}},

     #ejabberd_commands{name = pow, tags = [test],

			desc = "Return the power of base for exponent",

			longdesc = "This is an example command. The formula is:\n"

			" power = base ^ exponent",

			module = ?MODULE, function = pow,

			args = [{base, integer}, {exponent, integer}],

			result = {power, integer}},

     #ejabberd_commands{name = seq, tags = [test],

		       desc = "Return list of integers between two integers",

		       module = ?MODULE, function = seq,

		       args = [{from, integer}, {to, integer}],

		       result = {sequence, {list, {intermediate, integer}}}},

     #ejabberd_commands{name = substrs, tags = [test],

		       desc = "Return list of substrings of length increasing",

		       module = ?MODULE, function = substrs,

		       args = [{word, string}],

		       result = {substrings, {list, {miniword, string}}}},

     #ejabberd_commands{name = splitjid, tags = [test],

		       desc = "Split JID in parts: user, server, resource",

		       module = ?MODULE, function = splitjid,

		       args = [{jid, string}],

		       result = {jidparts, {tuple, [{user, string},

						    {server, string},

						    {resource, string}]}}},

     %% Not supported by ejabberd_ctl because uses 'list' in the arguments

     #ejabberd_commands{name = splitjids, tags = [test],

		       desc = "Split JIDs in parts: user, server, resource",

		       module = ?MODULE, function = splitjids,

		       args = [{jids, {list, {jid, string}}}],

		       result = {jidsparts,

				 {list, {jidparts,

					 {tuple, [{user, string},

						  {server, string},

						  {resource, string}]}}}}}

    ].

%%%

%%% Take

%%%

take_integer(A) when is_integer(A) -> 0.

take_string(A) when is_list(A) -> 0.

take_integer_string(A, B)

  when is_integer(A) and is_list(B) ->

    0.

take_tuple_2integer({A, B})

  when is_integer(A) and is_integer(B) ->

    0.

take_tuple_2string({A, B})

  when is_list(A) and is_list(B) ->

    0.

take_list_integer(L)

  when is_list(L) ->

    true = lists:all(fun(A) -> is_integer(A) end, L),

    0.

take_list_string(L)

  when is_list(L) ->

    true = lists:all(fun(A) -> is_list(A) end, L),

    0.

%%%

%%% Echo

%%%

echo_integer(A) when is_integer(A) -> A.

echo_string(A) when is_list(A) -> A.

echo_integer_string(A, B) when is_integer(A) and is_list(B) -> {A, B}.

echo_list_integer(L)

  when is_list(L) ->

    true = lists:all(fun(A) -> is_integer(A) end, L),

    L.

echo_list_string(L)

  when is_list(L) ->

    true = lists:all(fun(A) -> is_list(A) end, L),

    L.

echo_integer_list_string(I, L)

  when is_integer(I) and is_list(L) ->

    true = lists:all(fun(A) -> is_list(A) end, L),

    {I, L}.

echo_isatils(I, S, A, {II, L})

  when is_integer(I) and is_list(S) and is_atom(A) and is_integer(II) and is_list(L) ->

    true = lists:all(fun(SS) -> is_list(SS) end, L),

    {I, S, A, {I, L}}.

%%%

%%% Tell

%%%

tell_atom(0) -> zero;

tell_atom(1) -> one;

tell_atom(A) when is_integer(A) -> greater_than_one.

tell_rescode(0) -> ok;

tell_rescode(1) -> true;

tell_rescode(2) -> error;

tell_rescode(3) -> false;

tell_rescode(4) -> whatever.

tell_restuple(0) -> {ok, "All OK"};

tell_restuple(1) -> {true, "Successful result"};

tell_restuple(2) -> {error, "This is an error message"}.

tell_tuple_3integer() -> {123, 456, 789}.

tell_tuple_3string() -> {"Tell", "me", "a tuple please"}.

tell_tuple_3atom() -> {ok, works, perfectly}.

tell_tuple_3list() -> {[1, 23, 456], ["Tell", "me"], [all, is, ok]}.

tell_list_3integer() -> [123, 456, 789].

tell_list_3string() -> ["Tell", "me", "a tuple please"].

tell_list_3atom() -> [ok, works, perfectly].

tell_list_3tuple() ->

    [{123, "abcdefghijkl", first},

     {593, "this string", morning},

     {999, "Sleeping dog", not_seen}].

%%%

%%% Realistic

%%%

%% This function will crash for sure

this_crashes(Integer) ->

    test + Integer.