1 |
slords |
1.1 |
%%%---------------------------------------------------------------------- |
2 |
|
|
%%% File : mod_ctlextra.erl |
3 |
|
|
%%% Author : Badlop <badlop@ono.com> |
4 |
|
|
%%% Purpose : Adds more commands to ejabberd_ctl |
5 |
|
|
%%% Created : 30 Nov 2006 by Badlop <badlop@ono.com> |
6 |
slords |
1.4 |
%%% Id : $Id: mod_ctlextra.erl 873 2009-02-09 18:30:21Z badlop $ |
7 |
slords |
1.1 |
%%%---------------------------------------------------------------------- |
8 |
|
|
|
9 |
|
|
-module(mod_ctlextra). |
10 |
|
|
-author('badlop@ono.com'). |
11 |
|
|
|
12 |
|
|
-behaviour(gen_mod). |
13 |
|
|
|
14 |
|
|
-export([start/2, |
15 |
|
|
stop/1, |
16 |
|
|
ctl_process/2, |
17 |
|
|
ctl_process/3 |
18 |
|
|
]). |
19 |
|
|
|
20 |
|
|
-include("ejabberd.hrl"). |
21 |
|
|
-include("ejabberd_ctl.hrl"). |
22 |
|
|
-include("jlib.hrl"). |
23 |
|
|
-include("mod_roster.hrl"). |
24 |
|
|
|
25 |
slords |
1.4 |
%% Copied from ejabberd_sm.erl |
26 |
|
|
-record(session, {sid, usr, us, priority, info}). |
27 |
|
|
|
28 |
|
|
-compile(export_all). |
29 |
|
|
|
30 |
|
|
%%------------- |
31 |
|
|
%% gen_mod |
32 |
|
|
%%------------- |
33 |
slords |
1.1 |
|
34 |
|
|
start(Host, _Opts) -> |
35 |
slords |
1.4 |
ejabberd_ctl:register_commands(commands_global(), ?MODULE, ctl_process), |
36 |
|
|
ejabberd_ctl:register_commands(Host, commands_host(), ?MODULE, ctl_process). |
37 |
|
|
|
38 |
|
|
stop(Host) -> |
39 |
|
|
ejabberd_ctl:unregister_commands(commands_global(), ?MODULE, ctl_process), |
40 |
|
|
ejabberd_ctl:unregister_commands(Host, commands_host(), ?MODULE, ctl_process). |
41 |
|
|
|
42 |
|
|
commands_global() -> |
43 |
|
|
[ |
44 |
|
|
{"compile file", "recompile and reload file"}, |
45 |
|
|
{"load-config file", "load config from file"}, |
46 |
|
|
{"remove-node nodename", "remove an ejabberd node from the database"}, |
47 |
|
|
|
48 |
|
|
%% ejabberd_auth |
49 |
|
|
{"delete-older-users days", "delete users that have not logged in the last 'days'"}, |
50 |
|
|
{"delete-older-users-vhost host days", "delete users that not logged in last 'days' in 'host'"}, |
51 |
|
|
{"set-password user server password", "set password to user@server"}, |
52 |
|
|
|
53 |
|
|
%% ejd2odbc |
54 |
|
|
{"export2odbc server output", "export Mnesia tables on server to files on output directory"}, |
55 |
|
|
|
56 |
|
|
%% mod_shared_roster |
57 |
|
|
{"srg-create group host name description display", "create the group with options"}, |
58 |
|
|
{"srg-delete group host", "delete the group"}, |
59 |
|
|
{"srg-user-add user server group host", "add user@server to group on host"}, |
60 |
|
|
{"srg-user-del user server group host", "delete user@server from group on host"}, |
61 |
|
|
{"srg-list-groups host", "list the shared roster groups from host"}, |
62 |
|
|
{"srg-get-info group host", "get info of a specific group on host"}, |
63 |
|
|
|
64 |
|
|
%% mod_vcard |
65 |
|
|
{"vcard-get user host data [data2]", "get data from the vCard of the user"}, |
66 |
|
|
{"vcard-set user host data [data2] content", "set data to content on the vCard"}, |
67 |
|
|
|
68 |
|
|
%% mod_announce |
69 |
|
|
%% announce_send_online host message |
70 |
|
|
%% announce_send_all host, message |
71 |
|
|
|
72 |
|
|
%% mod_roster |
73 |
|
|
{"add-rosteritem user1 server1 user2 server2 nick group subs", "Add user2@server2 to user1@server1's roster"}, |
74 |
|
|
%%{"", "subs= none, from, to or both"}, |
75 |
|
|
%%{"", "example: add-roster peter localhost mike server.com MiKe Employees both"}, |
76 |
|
|
%%{"", "will add mike@server.com to peter@localhost roster"}, |
77 |
|
|
{"rem-rosteritem user1 server1 user2 server2", "Remove user2@server2 from user1@server1's roster"}, |
78 |
|
|
{"rosteritem-purge [options]", "Purge all rosteritems that match filtering options"}, |
79 |
|
|
{"pushroster file user server", "push template roster in file to user@server"}, |
80 |
|
|
{"pushroster-all file", "push template roster in file to all those users"}, |
81 |
|
|
{"push-alltoall server group", "adds all the users to all the users in Group"}, |
82 |
|
|
|
83 |
|
|
{"status-list status", "list the logged users with status"}, |
84 |
|
|
{"status-num status", "number of logged users with status"}, |
85 |
|
|
|
86 |
|
|
{"stats registeredusers", "number of registered users"}, |
87 |
|
|
{"stats onlineusers", "number of logged users"}, |
88 |
|
|
{"stats onlineusersnode", "number of logged users in the ejabberd node"}, |
89 |
|
|
{"stats uptime-seconds", "uptime of ejabberd node in seconds"}, |
90 |
|
|
|
91 |
|
|
%% misc |
92 |
|
|
{"get-cookie", "get the Erlang cookie of this node"}, |
93 |
|
|
{"killsession user server resource", "kill a user session"} |
94 |
|
|
]. |
95 |
|
|
|
96 |
|
|
commands_host() -> |
97 |
|
|
[ |
98 |
|
|
%% mod_last |
99 |
|
|
{"num-active-users days", "number of users active in the last 'days'"}, |
100 |
|
|
{"status-list status", "list the logged users with status"}, |
101 |
|
|
{"status-num status", "number of logged users with status"}, |
102 |
|
|
{"stats registeredusers", "number of registered users"}, |
103 |
|
|
{"stats onlineusers", "number of logged users"}, |
104 |
|
|
|
105 |
|
|
%% misc |
106 |
|
|
{"ban-account username [reason]", "ban account: kick sessions and change password"} |
107 |
|
|
]. |
108 |
|
|
|
109 |
slords |
1.1 |
|
110 |
slords |
1.4 |
%%------------- |
111 |
|
|
%% Commands global |
112 |
|
|
%%------------- |
113 |
slords |
1.1 |
|
114 |
|
|
ctl_process(_Val, ["delete-older-users", Days]) -> |
115 |
|
|
{removed, N, UR} = delete_older_users(list_to_integer(Days)), |
116 |
|
|
io:format("Deleted ~p users: ~p~n", [N, UR]), |
117 |
|
|
?STATUS_SUCCESS; |
118 |
|
|
|
119 |
slords |
1.4 |
ctl_process(_Val, ["delete-older-users-vhost", Host, Days]) -> |
120 |
|
|
{removed, N, UR} = delete_older_users_vhost(Host, list_to_integer(Days)), |
121 |
|
|
io:format("Deleted ~p users: ~p~n", [N, UR]), |
122 |
|
|
?STATUS_SUCCESS; |
123 |
|
|
|
124 |
slords |
1.1 |
ctl_process(_Val, ["export2odbc", Server, Output]) -> |
125 |
|
|
Tables = [ |
126 |
|
|
{export_last, last}, |
127 |
|
|
{export_offline, offline}, |
128 |
|
|
{export_passwd, passwd}, |
129 |
|
|
{export_private_storage, private_storage}, |
130 |
|
|
{export_roster, roster}, |
131 |
|
|
{export_vcard, vcard}, |
132 |
|
|
{export_vcard_search, vcard_search}], |
133 |
|
|
Export = fun({TableFun, Table}) -> |
134 |
|
|
Filename = filename:join([Output, atom_to_list(Table)++".txt"]), |
135 |
|
|
io:format("Trying to export Mnesia table '~p' on server '~s' to file '~s'~n", [Table, Server, Filename]), |
136 |
slords |
1.4 |
Res = (catch ejd2odbc:TableFun(Server, Filename)), |
137 |
|
|
io:format(" Result: ~p~n", [Res]) |
138 |
slords |
1.1 |
end, |
139 |
|
|
lists:foreach(Export, Tables), |
140 |
|
|
?STATUS_SUCCESS; |
141 |
|
|
|
142 |
|
|
ctl_process(_Val, ["set-password", User, Server, Password]) -> |
143 |
|
|
ejabberd_auth:set_password(User, Server, Password), |
144 |
|
|
?STATUS_SUCCESS; |
145 |
|
|
|
146 |
|
|
ctl_process(_Val, ["vcard-get", User, Server, Data]) -> |
147 |
|
|
{ok, Res} = vcard_get(User, Server, [Data]), |
148 |
|
|
io:format("~s~n", [Res]), |
149 |
|
|
?STATUS_SUCCESS; |
150 |
|
|
|
151 |
|
|
ctl_process(_Val, ["vcard-get", User, Server, Data1, Data2]) -> |
152 |
|
|
{ok, Res} = vcard_get(User, Server, [Data1, Data2]), |
153 |
|
|
io:format("~s~n", [Res]), |
154 |
|
|
?STATUS_SUCCESS; |
155 |
|
|
|
156 |
|
|
ctl_process(_Val, ["vcard-set", User, Server, Data1, Content]) -> |
157 |
|
|
{ok, Res} = vcard_set(User, Server, [Data1], Content), |
158 |
|
|
io:format("~s~n", [Res]), |
159 |
|
|
?STATUS_SUCCESS; |
160 |
|
|
|
161 |
|
|
ctl_process(_Val, ["vcard-set", User, Server, Data1, Data2, Content]) -> |
162 |
|
|
{ok, Res} = vcard_set(User, Server, [Data1, Data2], Content), |
163 |
|
|
io:format("~s~n", [Res]), |
164 |
|
|
?STATUS_SUCCESS; |
165 |
|
|
|
166 |
|
|
ctl_process(_Val, ["compile", Module]) -> |
167 |
|
|
compile:file(Module), |
168 |
|
|
?STATUS_SUCCESS; |
169 |
|
|
|
170 |
|
|
ctl_process(_Val, ["remove-node", Node]) -> |
171 |
|
|
mnesia:del_table_copy(schema, list_to_atom(Node)), |
172 |
|
|
?STATUS_SUCCESS; |
173 |
|
|
|
174 |
slords |
1.4 |
ctl_process(_Val, ["srg-create" | Parameters]) -> |
175 |
|
|
[Group, Host, Name, Description, Display] = group_parameters(Parameters, "'"), |
176 |
slords |
1.1 |
Opts = [{name, Name}, {displayed_groups, [Display]}, {description, Description}], |
177 |
|
|
{atomic, ok} = mod_shared_roster:create_group(Host, Group, Opts), |
178 |
|
|
?STATUS_SUCCESS; |
179 |
|
|
|
180 |
|
|
ctl_process(_Val, ["srg-delete", Group, Host]) -> |
181 |
|
|
{atomic, ok} = mod_shared_roster:delete_group(Host, Group), |
182 |
|
|
?STATUS_SUCCESS; |
183 |
|
|
|
184 |
|
|
ctl_process(_Val, ["srg-user-add", User, Server, Group, Host]) -> |
185 |
|
|
{atomic, ok} = mod_shared_roster:add_user_to_group(Host, {User, Server}, Group), |
186 |
|
|
?STATUS_SUCCESS; |
187 |
|
|
|
188 |
|
|
ctl_process(_Val, ["srg-user-del", User, Server, Group, Host]) -> |
189 |
|
|
{atomic, ok} = mod_shared_roster:remove_user_from_group(Host, {User, Server}, Group), |
190 |
|
|
?STATUS_SUCCESS; |
191 |
|
|
|
192 |
slords |
1.4 |
ctl_process(_Val, ["srg-list-groups", Host]) -> |
193 |
|
|
lists:foreach( |
194 |
|
|
fun(SrgGroup) -> |
195 |
|
|
io:format("~s~n",[SrgGroup]) |
196 |
|
|
end, |
197 |
|
|
lists:sort(mod_shared_roster:list_groups(Host))), |
198 |
slords |
1.1 |
?STATUS_SUCCESS; |
199 |
|
|
|
200 |
slords |
1.4 |
ctl_process(_Val, ["srg-get-info", Group, Host]) -> |
201 |
|
|
Opts = mod_shared_roster:get_group_opts(Host,Group), |
202 |
|
|
[io:format("~s: ~p~n", [Title, Value]) || {Title , Value} <- Opts], |
203 |
|
|
|
204 |
|
|
Members = mod_shared_roster:get_group_explicit_users(Host,Group), |
205 |
|
|
Members_string = [ " " ++ jlib:jid_to_string(jlib:make_jid(MUser, MServer, "")) |
206 |
|
|
|| {MUser, MServer} <- Members], |
207 |
|
|
io:format("members:~s~n", [Members_string]), |
208 |
|
|
|
209 |
slords |
1.1 |
?STATUS_SUCCESS; |
210 |
|
|
|
211 |
|
|
ctl_process(_Val, ["add-rosteritem", LocalUser, LocalServer, RemoteUser, RemoteServer, Nick, Group, Subs]) -> |
212 |
|
|
case add_rosteritem(LocalUser, LocalServer, RemoteUser, RemoteServer, Nick, Group, list_to_atom(Subs), []) of |
213 |
|
|
{atomic, ok} -> |
214 |
|
|
?STATUS_SUCCESS; |
215 |
|
|
{error, Reason} -> |
216 |
|
|
io:format("Can't add ~p@~p to ~p@~p: ~p~n", |
217 |
|
|
[RemoteUser, RemoteServer, LocalUser, LocalServer, Reason]), |
218 |
|
|
?STATUS_ERROR; |
219 |
|
|
{badrpc, Reason} -> |
220 |
|
|
io:format("Can't add roster item to user ~p: ~p~n", |
221 |
|
|
[LocalUser, Reason]), |
222 |
|
|
?STATUS_BADRPC |
223 |
|
|
end; |
224 |
|
|
|
225 |
|
|
ctl_process(_Val, ["rem-rosteritem", LocalUser, LocalServer, RemoteUser, RemoteServer]) -> |
226 |
|
|
case rem_rosteritem(LocalUser, LocalServer, RemoteUser, RemoteServer) of |
227 |
|
|
{atomic, ok} -> |
228 |
|
|
?STATUS_SUCCESS; |
229 |
|
|
{error, Reason} -> |
230 |
|
|
io:format("Can't remove ~p@~p to ~p@~p: ~p~n", |
231 |
|
|
[RemoteUser, RemoteServer, LocalUser, LocalServer, Reason]), |
232 |
|
|
?STATUS_ERROR; |
233 |
|
|
{badrpc, Reason} -> |
234 |
|
|
io:format("Can't remove roster item to user ~p: ~p~n", |
235 |
|
|
[LocalUser, Reason]), |
236 |
|
|
?STATUS_BADRPC |
237 |
|
|
end; |
238 |
|
|
|
239 |
slords |
1.4 |
ctl_process(_Val, ["rosteritem-purge"]) -> |
240 |
|
|
io:format("Rosteritems that match all the filtering will be removed.~n"), |
241 |
|
|
io:format("Options for filtering:~n"), |
242 |
|
|
io:format("~n"), |
243 |
|
|
io:format(" -subs none|from|to|both~n"), |
244 |
|
|
io:format(" Subscription type. By default all values~n"), |
245 |
|
|
io:format("~n"), |
246 |
|
|
io:format(" -ask none|out|in~n"), |
247 |
|
|
io:format(" Pending subscription. By default all values~n"), |
248 |
|
|
io:format("~n"), |
249 |
|
|
io:format(" -user JID~n"), |
250 |
|
|
io:format(" The JID of the local user.~n"), |
251 |
|
|
io:format(" Can use these globs: *, ? and [...].~n"), |
252 |
|
|
io:format(" By default it is: * *@*~n"), |
253 |
|
|
io:format("~n"), |
254 |
|
|
io:format(" -contact JID~n"), |
255 |
|
|
io:format(" Similar to 'user', but for the contact JID.~n"), |
256 |
|
|
io:format("~n"), |
257 |
|
|
io:format("Example:~n"), |
258 |
|
|
io:format(" ejabberdctl rosteritem-purge -subs none from to -ask out in -contact *@*icq*~n"), |
259 |
|
|
io:format("~n"), |
260 |
|
|
?STATUS_SUCCESS; |
261 |
|
|
ctl_process(_Val, ["rosteritem-purge" | Options_list]) -> |
262 |
|
|
Options_prop_list = lists:foldl( |
263 |
|
|
fun(O, R) -> |
264 |
|
|
case O of |
265 |
|
|
[$- | K] -> |
266 |
|
|
[{K, []} | R]; |
267 |
|
|
V -> |
268 |
|
|
[{K, Vs} | RT] = R, |
269 |
|
|
[{K, [V|Vs]} | RT] |
270 |
|
|
end |
271 |
|
|
end, |
272 |
|
|
[], |
273 |
|
|
Options_list), |
274 |
|
|
|
275 |
|
|
Subs = [list_to_atom(S) |
276 |
|
|
|| S <- proplists:get_value("subs", |
277 |
|
|
Options_prop_list, |
278 |
|
|
["none", "from", "to", "both"])], |
279 |
|
|
Asks = [list_to_atom(S) |
280 |
|
|
|| S <- |
281 |
|
|
proplists:get_value("ask", |
282 |
|
|
Options_prop_list, |
283 |
|
|
["none", "out", "in"])], |
284 |
|
|
User = proplists:get_value("user", Options_prop_list, ["*", "*@*"]), |
285 |
|
|
Contact = proplists:get_value("contact", Options_prop_list, ["*", "*@*"]), |
286 |
|
|
|
287 |
|
|
case rosteritem_purge({Subs, Asks, User, Contact}) of |
288 |
|
|
{atomic, ok} -> |
289 |
|
|
?STATUS_SUCCESS; |
290 |
|
|
{error, Reason} -> |
291 |
|
|
io:format("Error purging rosteritems: ~p~n", |
292 |
|
|
[Reason]), |
293 |
|
|
?STATUS_ERROR; |
294 |
|
|
{badrpc, Reason} -> |
295 |
|
|
io:format("BadRPC purging rosteritems: ~p~n", |
296 |
|
|
[Reason]), |
297 |
|
|
?STATUS_BADRPC |
298 |
|
|
end; |
299 |
|
|
|
300 |
slords |
1.1 |
ctl_process(_Val, ["pushroster", File, User, Server]) -> |
301 |
|
|
case pushroster(File, User, Server) of |
302 |
|
|
ok -> |
303 |
|
|
?STATUS_SUCCESS; |
304 |
|
|
{error, Reason} -> |
305 |
|
|
io:format("Can't push roster ~p to ~p@~p: ~p~n", |
306 |
|
|
[File, User, Server, Reason]), |
307 |
|
|
?STATUS_ERROR; |
308 |
|
|
{badrpc, Reason} -> |
309 |
|
|
io:format("Can't push roster ~p: ~p~n", |
310 |
|
|
[File, Reason]), |
311 |
|
|
?STATUS_BADRPC |
312 |
|
|
end; |
313 |
|
|
|
314 |
|
|
ctl_process(_Val, ["pushroster-all", File]) -> |
315 |
|
|
case pushroster_all([File]) of |
316 |
|
|
ok -> |
317 |
|
|
?STATUS_SUCCESS; |
318 |
|
|
{error, Reason} -> |
319 |
|
|
io:format("Can't push roster ~p: ~p~n", |
320 |
|
|
[File, Reason]), |
321 |
|
|
?STATUS_ERROR; |
322 |
|
|
{badrpc, Reason} -> |
323 |
|
|
io:format("Can't push roster ~p: ~p~n", |
324 |
|
|
[File, Reason]), |
325 |
|
|
?STATUS_BADRPC |
326 |
|
|
end; |
327 |
|
|
|
328 |
|
|
ctl_process(_Val, ["push-alltoall", Server, Group]) -> |
329 |
|
|
case push_alltoall(Server, Group) of |
330 |
|
|
ok -> |
331 |
|
|
?STATUS_SUCCESS; |
332 |
|
|
{error, Reason} -> |
333 |
|
|
io:format("Can't push all to all: ~p~n", |
334 |
|
|
[Reason]), |
335 |
|
|
?STATUS_ERROR; |
336 |
|
|
{badrpc, Reason} -> |
337 |
|
|
io:format("Can't push all to all: ~p~n", |
338 |
|
|
[Reason]), |
339 |
|
|
?STATUS_BADRPC |
340 |
|
|
end; |
341 |
|
|
|
342 |
|
|
ctl_process(_Val, ["load-config", Path]) -> |
343 |
|
|
case ejabberd_config:load_file(Path) of |
344 |
|
|
{atomic, ok} -> |
345 |
|
|
?STATUS_SUCCESS; |
346 |
|
|
{error, Reason} -> |
347 |
|
|
io:format("Can't load config file ~p: ~p~n", |
348 |
|
|
[filename:absname(Path), Reason]), |
349 |
|
|
?STATUS_ERROR; |
350 |
|
|
{badrpc, Reason} -> |
351 |
|
|
io:format("Can't load config file ~p: ~p~n", |
352 |
|
|
[filename:absname(Path), Reason]), |
353 |
|
|
?STATUS_BADRPC |
354 |
|
|
end; |
355 |
|
|
|
356 |
|
|
ctl_process(_Val, ["stats", Stat]) -> |
357 |
|
|
Res = case Stat of |
358 |
|
|
"uptime-seconds" -> uptime_seconds(); |
359 |
slords |
1.4 |
"registeredusers" -> length(ejabberd_auth:dirty_get_registered_users()); |
360 |
|
|
"onlineusersnode" -> length(ejabberd_sm:dirty_get_my_sessions_list()); |
361 |
|
|
"onlineusers" -> length(ejabberd_sm:dirty_get_sessions_list()) |
362 |
slords |
1.1 |
end, |
363 |
|
|
io:format("~p~n", [Res]), |
364 |
|
|
?STATUS_SUCCESS; |
365 |
|
|
|
366 |
|
|
ctl_process(_Val, ["status-num", Status_required]) -> |
367 |
|
|
ctl_process(_Val, "all", ["status-num", Status_required]); |
368 |
|
|
|
369 |
|
|
ctl_process(_Val, ["status-list", Status_required]) -> |
370 |
|
|
ctl_process(_Val, "all", ["status-list", Status_required]); |
371 |
|
|
|
372 |
|
|
ctl_process(_Val, ["get-cookie"]) -> |
373 |
|
|
io:format("~s~n", [atom_to_list(erlang:get_cookie())]), |
374 |
|
|
?STATUS_SUCCESS; |
375 |
|
|
|
376 |
slords |
1.4 |
ctl_process(_Val, ["killsession", User, Server, Resource | Tail]) -> |
377 |
|
|
kick_session(User, Server, Resource, prepare_reason(Tail)), |
378 |
slords |
1.1 |
?STATUS_SUCCESS; |
379 |
|
|
|
380 |
|
|
ctl_process(Val, _Args) -> |
381 |
|
|
Val. |
382 |
|
|
|
383 |
|
|
|
384 |
slords |
1.4 |
%%------------- |
385 |
|
|
%% Commands vhost |
386 |
|
|
%%------------- |
387 |
slords |
1.1 |
|
388 |
|
|
ctl_process(_Val, Host, ["num-active-users", Days]) -> |
389 |
|
|
Number = num_active_users(Host, list_to_integer(Days)), |
390 |
|
|
io:format("~p~n", [Number]), |
391 |
|
|
?STATUS_SUCCESS; |
392 |
|
|
|
393 |
|
|
ctl_process(_Val, Host, ["stats", Stat]) -> |
394 |
|
|
Res = case Stat of |
395 |
|
|
"registeredusers" -> length(ejabberd_auth:get_vh_registered_users(Host)); |
396 |
|
|
"onlineusers" -> length(ejabberd_sm:get_vh_session_list(Host)) |
397 |
|
|
end, |
398 |
|
|
io:format("~p~n", [Res]), |
399 |
|
|
?STATUS_SUCCESS; |
400 |
|
|
|
401 |
|
|
ctl_process(_Val, Host, ["status-num", Status_required]) -> |
402 |
|
|
Num = length(get_status_list(Host, Status_required)), |
403 |
|
|
io:format("~p~n", [Num]), |
404 |
|
|
?STATUS_SUCCESS; |
405 |
|
|
|
406 |
|
|
ctl_process(_Val, Host, ["status-list", Status_required]) -> |
407 |
|
|
Res = get_status_list(Host, Status_required), |
408 |
|
|
[ io:format("~s@~s ~s ~p \"~s\"~n", [U, S, R, P, St]) || {U, S, R, P, St} <- Res], |
409 |
|
|
?STATUS_SUCCESS; |
410 |
|
|
|
411 |
slords |
1.4 |
ctl_process(_Val, Host, ["ban-account", User | Tail]) -> |
412 |
|
|
ban_account(User, Host, prepare_reason(Tail)), |
413 |
|
|
?STATUS_SUCCESS; |
414 |
|
|
|
415 |
slords |
1.1 |
ctl_process(Val, _Host, _Args) -> |
416 |
|
|
Val. |
417 |
|
|
|
418 |
|
|
|
419 |
|
|
%%------------- |
420 |
slords |
1.4 |
%% Utils |
421 |
slords |
1.1 |
%%------------- |
422 |
|
|
|
423 |
slords |
1.4 |
uptime_seconds() -> |
424 |
|
|
trunc(element(1, erlang:statistics(wall_clock))/1000). |
425 |
|
|
|
426 |
slords |
1.1 |
get_status_list(Host, Status_required) -> |
427 |
|
|
%% Get list of all logged users |
428 |
|
|
Sessions = ejabberd_sm:dirty_get_my_sessions_list(), |
429 |
|
|
%% Reformat the list |
430 |
|
|
Sessions2 = [ {Session#session.usr, Session#session.sid, Session#session.priority} || Session <- Sessions], |
431 |
|
|
Fhost = case Host of |
432 |
|
|
"all" -> |
433 |
|
|
%% All hosts are requested, so dont filter at all |
434 |
|
|
fun(_, _) -> true end; |
435 |
|
|
_ -> |
436 |
|
|
%% Filter the list, only Host is interesting |
437 |
|
|
fun(A, B) -> A == B end |
438 |
|
|
end, |
439 |
|
|
Sessions3 = [ {Pid, Server, Priority} || {{_User, Server, _Resource}, {_, Pid}, Priority} <- Sessions2, apply(Fhost, [Server, Host])], |
440 |
|
|
%% For each Pid, get its presence |
441 |
|
|
Sessions4 = [ {ejabberd_c2s:get_presence(Pid), Server, Priority} || {Pid, Server, Priority} <- Sessions3], |
442 |
|
|
%% Filter by status |
443 |
|
|
Fstatus = case Status_required of |
444 |
|
|
"all" -> |
445 |
|
|
fun(_, _) -> true end; |
446 |
|
|
_ -> |
447 |
|
|
fun(A, B) -> A == B end |
448 |
|
|
end, |
449 |
|
|
[{User, Server, Resource, Priority, stringize(Status_text)} |
450 |
|
|
|| {{User, Resource, Status, Status_text}, Server, Priority} <- Sessions4, |
451 |
|
|
apply(Fstatus, [Status, Status_required])]. |
452 |
|
|
|
453 |
|
|
%% Make string more print-friendly |
454 |
|
|
stringize(String) -> |
455 |
|
|
%% Replace newline characters with other code |
456 |
|
|
element(2, regexp:gsub(String, "\n", "\\n")). |
457 |
|
|
|
458 |
|
|
add_rosteritem(LU, LS, RU, RS, Nick, Group, Subscription, Xattrs) -> |
459 |
|
|
subscribe(LU, LS, RU, RS, Nick, Group, Subscription, Xattrs), |
460 |
|
|
route_rosteritem(LU, LS, RU, RS, Nick, Group, Subscription), |
461 |
|
|
{atomic, ok}. |
462 |
|
|
|
463 |
|
|
subscribe(LocalUser, LocalServer, RemoteUser, RemoteServer, Nick, Group, Subscription, Xattrs) -> |
464 |
|
|
R = #roster{usj = {LocalUser,LocalServer,{RemoteUser,RemoteServer,[]}}, |
465 |
|
|
us = {LocalUser,LocalServer}, |
466 |
|
|
jid = {RemoteUser,RemoteServer,[]}, |
467 |
|
|
name = Nick, |
468 |
|
|
subscription = Subscription, % none, to=you see him, from=he sees you, both |
469 |
|
|
ask = none, % out=send request, in=somebody requests you, none |
470 |
|
|
groups = [Group], |
471 |
|
|
askmessage = Xattrs, % example: [{"category","conference"}] |
472 |
|
|
xs = []}, |
473 |
|
|
mnesia:transaction(fun() -> mnesia:write(R) end). |
474 |
|
|
|
475 |
|
|
rem_rosteritem(LU, LS, RU, RS) -> |
476 |
|
|
unsubscribe(LU, LS, RU, RS), |
477 |
|
|
route_rosteritem(LU, LS, RU, RS, "", "", "remove"), |
478 |
|
|
{atomic, ok}. |
479 |
|
|
|
480 |
|
|
unsubscribe(LocalUser, LocalServer, RemoteUser, RemoteServer) -> |
481 |
|
|
Key = {{LocalUser,LocalServer,{RemoteUser,RemoteServer,[]}}, |
482 |
|
|
{LocalUser,LocalServer}}, |
483 |
|
|
mnesia:transaction(fun() -> mnesia:delete(roster, Key, write) end). |
484 |
|
|
|
485 |
|
|
route_rosteritem(LocalUser, LocalServer, RemoteUser, RemoteServer, Nick, Group, Subscription) -> |
486 |
|
|
LJID = jlib:make_jid(LocalUser, LocalServer, ""), |
487 |
|
|
RJID = jlib:make_jid(RemoteUser, RemoteServer, ""), |
488 |
|
|
ToS = jlib:jid_to_string(LJID), |
489 |
|
|
ItemJIDS = jlib:jid_to_string(RJID), |
490 |
|
|
GroupXML = {xmlelement, "group", [], [{xmlcdata, Group}]}, |
491 |
|
|
Item = {xmlelement, "item", |
492 |
|
|
[{"jid", ItemJIDS}, |
493 |
|
|
{"name", Nick}, |
494 |
|
|
{"subscription", Subscription}], |
495 |
|
|
[GroupXML]}, |
496 |
|
|
Query = {xmlelement, "query", [{"xmlns", ?NS_ROSTER}], [Item]}, |
497 |
|
|
Packet = {xmlelement, "iq", [{"type", "set"}, {"to", ToS}], [Query]}, |
498 |
|
|
ejabberd_router:route(LJID, LJID, Packet). |
499 |
|
|
|
500 |
slords |
1.4 |
|
501 |
|
|
%%----------------------------- |
502 |
|
|
%% Ban user |
503 |
|
|
%%----------------------------- |
504 |
|
|
|
505 |
|
|
ban_account(User, Server, Reason) -> |
506 |
|
|
kick_sessions(User, Server, Reason), |
507 |
|
|
set_random_password(User, Server, Reason). |
508 |
|
|
|
509 |
|
|
kick_sessions(User, Server, Reason) -> |
510 |
|
|
lists:map( |
511 |
|
|
fun(Resource) -> |
512 |
|
|
kick_session(User, Server, Resource, Reason) |
513 |
|
|
end, |
514 |
|
|
get_resources(User, Server)). |
515 |
|
|
|
516 |
|
|
kick_session(User, Server, Resource, Reason) -> |
517 |
|
|
ejabberd_router:route( |
518 |
|
|
jlib:make_jid("", "", ""), |
519 |
|
|
jlib:make_jid(User, Server, Resource), |
520 |
|
|
{xmlelement, "broadcast", [], [{exit, Reason}]}). |
521 |
|
|
|
522 |
|
|
get_resources(User, Server) -> |
523 |
|
|
lists:map( |
524 |
|
|
fun(Session) -> |
525 |
|
|
element(3, Session#session.usr) |
526 |
|
|
end, |
527 |
|
|
get_sessions(User, Server)). |
528 |
|
|
|
529 |
|
|
get_sessions(User, Server) -> |
530 |
|
|
LUser = jlib:nodeprep(User), |
531 |
|
|
LServer = jlib:nameprep(Server), |
532 |
|
|
Sessions = mnesia:dirty_index_read(session, {LUser, LServer}, #session.us), |
533 |
|
|
true = is_list(Sessions), |
534 |
|
|
Sessions. |
535 |
|
|
|
536 |
|
|
set_random_password(User, Server, Reason) -> |
537 |
|
|
NewPass = build_random_password(Reason), |
538 |
|
|
set_password(User, Server, NewPass). |
539 |
|
|
|
540 |
|
|
build_random_password(Reason) -> |
541 |
|
|
Date = jlib:timestamp_to_iso(calendar:universal_time()), |
542 |
|
|
RandomString = randoms:get_string(), |
543 |
|
|
"BANNED_ACCOUNT--" ++ Date ++ "--" ++ RandomString ++ "--" ++ Reason. |
544 |
|
|
|
545 |
|
|
set_password(User, Server, Password) -> |
546 |
|
|
{atomic, ok} = ejabberd_auth:set_password(User, Server, Password). |
547 |
|
|
|
548 |
|
|
prepare_reason([]) -> |
549 |
|
|
"Kicked by administrator"; |
550 |
|
|
prepare_reason([Reason]) -> |
551 |
|
|
Reason; |
552 |
|
|
prepare_reason(StringList) -> |
553 |
|
|
string:join(StringList, "_"). |
554 |
|
|
|
555 |
|
|
|
556 |
|
|
%%----------------------------- |
557 |
|
|
%% Purge roster items |
558 |
|
|
%%----------------------------- |
559 |
|
|
|
560 |
|
|
rosteritem_purge(Options) -> |
561 |
|
|
Num_rosteritems = mnesia:table_info(roster, size), |
562 |
|
|
io:format("There are ~p roster items in total.~n", [Num_rosteritems]), |
563 |
|
|
Key = mnesia:dirty_first(roster), |
564 |
|
|
ok = rip(Key, Options, {0, Num_rosteritems, 0, 0}), |
565 |
|
|
{atomic, ok}. |
566 |
|
|
|
567 |
|
|
rip('$end_of_table', _Options, Counters) -> |
568 |
|
|
print_progress_line(Counters), |
569 |
|
|
ok; |
570 |
|
|
rip(Key, Options, {Pr, NT, NV, ND}) -> |
571 |
|
|
Key_next = mnesia:dirty_next(roster, Key), |
572 |
|
|
ND2 = case decide_rip(Key, Options) of |
573 |
|
|
true -> |
574 |
|
|
mnesia:dirty_delete(roster, Key), |
575 |
|
|
ND+1; |
576 |
|
|
false -> |
577 |
|
|
ND |
578 |
|
|
end, |
579 |
|
|
NV2 = NV+1, |
580 |
|
|
Pr2 = print_progress_line({Pr, NT, NV2, ND2}), |
581 |
|
|
rip(Key_next, Options, {Pr2, NT, NV2, ND2}). |
582 |
|
|
|
583 |
|
|
print_progress_line({Pr, NT, NV, ND}) -> |
584 |
|
|
Pr2 = trunc((NV/NT)*100), |
585 |
|
|
case Pr == Pr2 of |
586 |
|
|
true -> |
587 |
|
|
ok; |
588 |
|
|
false -> |
589 |
|
|
io:format("Progress ~p% - visited ~p - deleted ~p~n", [Pr2, NV, ND]) |
590 |
|
|
end, |
591 |
|
|
Pr2. |
592 |
|
|
|
593 |
|
|
decide_rip(Key, {Subs, Asks, User, Contact}) -> |
594 |
|
|
case catch mnesia:dirty_read(roster, Key) of |
595 |
|
|
[RI] -> |
596 |
|
|
lists:member(RI#roster.subscription, Subs) |
597 |
|
|
andalso lists:member(RI#roster.ask, Asks) |
598 |
|
|
andalso decide_rip_jid(RI#roster.us, User) |
599 |
|
|
andalso decide_rip_jid(RI#roster.jid, Contact); |
600 |
|
|
_ -> |
601 |
|
|
false |
602 |
|
|
end. |
603 |
|
|
|
604 |
|
|
%% Returns true if the server of the JID is included in the servers |
605 |
|
|
decide_rip_jid({UName, UServer, _UResource}, Match_list) -> |
606 |
|
|
decide_rip_jid({UName, UServer}, Match_list); |
607 |
|
|
decide_rip_jid({UName, UServer}, Match_list) -> |
608 |
|
|
lists:any( |
609 |
|
|
fun(Match_string) -> |
610 |
|
|
MJID = jlib:string_to_jid(Match_string), |
611 |
|
|
MName = MJID#jid.luser, |
612 |
|
|
MServer = MJID#jid.lserver, |
613 |
|
|
Is_server = is_glob_match(UServer, MServer), |
614 |
|
|
case MName of |
615 |
|
|
[] when UName == [] -> |
616 |
|
|
Is_server; |
617 |
|
|
[] -> |
618 |
|
|
false; |
619 |
|
|
_ -> |
620 |
|
|
Is_server |
621 |
|
|
andalso is_glob_match(UName, MName) |
622 |
|
|
end |
623 |
|
|
end, |
624 |
|
|
Match_list). |
625 |
|
|
|
626 |
|
|
%% Copied from ejabberd-2.0.0/src/acl.erl |
627 |
|
|
is_regexp_match(String, RegExp) -> |
628 |
|
|
case regexp:first_match(String, RegExp) of |
629 |
|
|
nomatch -> |
630 |
|
|
false; |
631 |
|
|
{match, _, _} -> |
632 |
|
|
true; |
633 |
|
|
{error, ErrDesc} -> |
634 |
|
|
io:format( |
635 |
|
|
"Wrong regexp ~p in ACL: ~p", |
636 |
|
|
[RegExp, lists:flatten(regexp:format_error(ErrDesc))]), |
637 |
|
|
false |
638 |
|
|
end. |
639 |
|
|
is_glob_match(String, Glob) -> |
640 |
|
|
is_regexp_match(String, regexp:sh_to_awk(Glob)). |
641 |
|
|
|
642 |
|
|
|
643 |
|
|
%%----------------------------- |
644 |
|
|
%% Push Roster from file |
645 |
|
|
%%----------------------------- |
646 |
|
|
|
647 |
slords |
1.1 |
pushroster(File, User, Server) -> |
648 |
|
|
{ok, [Roster]} = file:consult(File), |
649 |
|
|
subscribe_roster({User, Server, "", User}, Roster). |
650 |
|
|
|
651 |
|
|
pushroster_all(File) -> |
652 |
|
|
{ok, [Roster]} = file:consult(File), |
653 |
|
|
subscribe_all(Roster). |
654 |
|
|
|
655 |
|
|
subscribe_all(Roster) -> |
656 |
|
|
subscribe_all(Roster, Roster). |
657 |
|
|
subscribe_all([], _) -> |
658 |
|
|
ok; |
659 |
|
|
subscribe_all([User1 | Users], Roster) -> |
660 |
|
|
subscribe_roster(User1, Roster), |
661 |
|
|
subscribe_all(Users, Roster). |
662 |
|
|
|
663 |
|
|
subscribe_roster(_, []) -> |
664 |
|
|
ok; |
665 |
|
|
%% Do not subscribe a user to itself |
666 |
|
|
subscribe_roster({Name, Server, Group, Nick}, [{Name, Server, _, _} | Roster]) -> |
667 |
|
|
subscribe_roster({Name, Server, Group, Nick}, Roster); |
668 |
|
|
%% Subscribe Name2 to Name1 |
669 |
|
|
subscribe_roster({Name1, Server1, Group1, Nick1}, [{Name2, Server2, Group2, Nick2} | Roster]) -> |
670 |
|
|
subscribe(Name1, Server1, Name2, Server2, Nick2, Group2, both, []), |
671 |
|
|
subscribe_roster({Name1, Server1, Group1, Nick1}, Roster). |
672 |
|
|
|
673 |
|
|
push_alltoall(S, G) -> |
674 |
|
|
Users = ejabberd_auth:get_vh_registered_users(S), |
675 |
|
|
Users2 = build_list_users(G, Users, []), |
676 |
|
|
subscribe_all(Users2). |
677 |
|
|
|
678 |
|
|
build_list_users(_Group, [], Res) -> |
679 |
|
|
Res; |
680 |
|
|
build_list_users(Group, [{User, Server}|Users], Res) -> |
681 |
|
|
build_list_users(Group, Users, [{User, Server, Group, User}|Res]). |
682 |
|
|
|
683 |
|
|
vcard_get(User, Server, Data) -> |
684 |
|
|
[{_, Module, Function, _Opts}] = ets:lookup(sm_iqtable, {?NS_VCARD, Server}), |
685 |
|
|
JID = jlib:make_jid(User, Server, ""), |
686 |
|
|
IQ = #iq{type = get, xmlns = ?NS_VCARD}, |
687 |
|
|
IQr = Module:Function(JID, JID, IQ), |
688 |
|
|
Res = case IQr#iq.sub_el of |
689 |
|
|
[A1] -> |
690 |
|
|
case vcard_get(Data, A1) of |
691 |
|
|
false -> no_value; |
692 |
|
|
Elem -> xml:get_tag_cdata(Elem) |
693 |
|
|
end; |
694 |
|
|
[] -> |
695 |
|
|
no_vcard |
696 |
|
|
end, |
697 |
|
|
{ok, Res}. |
698 |
|
|
|
699 |
|
|
vcard_get([Data1, Data2], A1) -> |
700 |
|
|
case xml:get_subtag(A1, Data1) of |
701 |
|
|
false -> false; |
702 |
|
|
A2 -> vcard_get([Data2], A2) |
703 |
|
|
end; |
704 |
|
|
|
705 |
|
|
vcard_get([Data], A1) -> |
706 |
|
|
xml:get_subtag(A1, Data). |
707 |
|
|
|
708 |
|
|
vcard_set(User, Server, Data, Content) -> |
709 |
|
|
[{_, Module, Function, _Opts}] = ets:lookup(sm_iqtable, {?NS_VCARD, Server}), |
710 |
|
|
JID = jlib:make_jid(User, Server, ""), |
711 |
|
|
IQ = #iq{type = get, xmlns = ?NS_VCARD}, |
712 |
|
|
IQr = Module:Function(JID, JID, IQ), |
713 |
|
|
|
714 |
|
|
%% Get old vcard |
715 |
|
|
A4 = case IQr#iq.sub_el of |
716 |
|
|
[A1] -> |
717 |
|
|
{_, _, _, A2} = A1, |
718 |
|
|
update_vcard_els(Data, Content, A2); |
719 |
|
|
[] -> |
720 |
|
|
update_vcard_els(Data, Content, []) |
721 |
|
|
end, |
722 |
|
|
|
723 |
|
|
%% Build new vcard |
724 |
|
|
SubEl = {xmlelement, "vCard", [{"xmlns","vcard-temp"}], A4}, |
725 |
|
|
IQ2 = #iq{type=set, sub_el = SubEl}, |
726 |
|
|
|
727 |
|
|
Module:Function(JID, JID, IQ2), |
728 |
|
|
{ok, "done"}. |
729 |
|
|
|
730 |
|
|
update_vcard_els(Data, Content, Els1) -> |
731 |
|
|
Els2 = lists:keysort(2, Els1), |
732 |
|
|
[Data1 | Data2] = Data, |
733 |
|
|
NewEl = case Data2 of |
734 |
|
|
[] -> |
735 |
|
|
{xmlelement, Data1, [], [{xmlcdata,Content}]}; |
736 |
|
|
[D2] -> |
737 |
|
|
OldEl = case lists:keysearch(Data1, 2, Els2) of |
738 |
|
|
{value, A} -> A; |
739 |
|
|
false -> {xmlelement, Data1, [], []} |
740 |
|
|
end, |
741 |
|
|
{xmlelement, _, _, ContentOld1} = OldEl, |
742 |
|
|
Content2 = [{xmlelement, D2, [], [{xmlcdata,Content}]}], |
743 |
|
|
ContentOld2 = lists:keysort(2, ContentOld1), |
744 |
|
|
ContentOld3 = lists:keydelete(D2, 2, ContentOld2), |
745 |
|
|
ContentNew = lists:keymerge(2, Content2, ContentOld3), |
746 |
|
|
{xmlelement, Data1, [], ContentNew} |
747 |
|
|
end, |
748 |
|
|
Els3 = lists:keydelete(Data1, 2, Els2), |
749 |
|
|
lists:keymerge(2, [NewEl], Els3). |
750 |
|
|
|
751 |
|
|
-record(last_activity, {us, timestamp, status}). |
752 |
|
|
|
753 |
|
|
delete_older_users(Days) -> |
754 |
slords |
1.4 |
%% Get the list of registered users |
755 |
|
|
Users = ejabberd_auth:dirty_get_registered_users(), |
756 |
|
|
delete_older_users(Days, Users). |
757 |
|
|
|
758 |
|
|
delete_older_users_vhost(Host, Days) -> |
759 |
|
|
%% Get the list of registered users |
760 |
|
|
Users = ejabberd_auth:get_vh_registered_users(Host), |
761 |
|
|
delete_older_users(Days, Users). |
762 |
|
|
|
763 |
|
|
delete_older_users(Days, Users) -> |
764 |
slords |
1.1 |
%% Convert older time |
765 |
|
|
SecOlder = Days*24*60*60, |
766 |
|
|
|
767 |
|
|
%% Get current time |
768 |
|
|
{MegaSecs, Secs, _MicroSecs} = now(), |
769 |
|
|
TimeStamp_now = MegaSecs * 1000000 + Secs, |
770 |
|
|
|
771 |
|
|
%% For a user, remove if required and answer true |
772 |
|
|
F = fun({LUser, LServer}) -> |
773 |
|
|
%% Check if the user is logged |
774 |
|
|
case ejabberd_sm:get_user_resources(LUser, LServer) of |
775 |
|
|
%% If it isnt |
776 |
|
|
[] -> |
777 |
|
|
%% Look for his last_activity |
778 |
|
|
case mnesia:dirty_read(last_activity, {LUser, LServer}) of |
779 |
|
|
%% If it is |
780 |
|
|
%% existent: |
781 |
|
|
[#last_activity{timestamp = TimeStamp}] -> |
782 |
|
|
%% get his age |
783 |
|
|
Sec = TimeStamp_now - TimeStamp, |
784 |
|
|
%% If he is |
785 |
|
|
if |
786 |
|
|
%% younger than SecOlder: |
787 |
|
|
Sec < SecOlder -> |
788 |
|
|
%% do nothing |
789 |
|
|
false; |
790 |
|
|
%% older: |
791 |
|
|
true -> |
792 |
|
|
%% remove the user |
793 |
|
|
ejabberd_auth:remove_user(LUser, LServer), |
794 |
|
|
true |
795 |
|
|
end; |
796 |
|
|
%% nonexistent: |
797 |
|
|
[] -> |
798 |
|
|
%% remove the user |
799 |
|
|
ejabberd_auth:remove_user(LUser, LServer), |
800 |
|
|
true |
801 |
|
|
end; |
802 |
|
|
%% Else |
803 |
|
|
_ -> |
804 |
|
|
%% do nothing |
805 |
|
|
false |
806 |
|
|
end |
807 |
|
|
end, |
808 |
|
|
%% Apply the function to every user in the list |
809 |
|
|
Users_removed = lists:filter(F, Users), |
810 |
|
|
{removed, length(Users_removed), Users_removed}. |
811 |
|
|
|
812 |
|
|
num_active_users(Host, Days) -> |
813 |
|
|
list_last_activity(Host, true, Days). |
814 |
|
|
|
815 |
|
|
%% Code based on ejabberd/src/web/ejabberd_web_admin.erl |
816 |
|
|
list_last_activity(Host, Integral, Days) -> |
817 |
|
|
{MegaSecs, Secs, _MicroSecs} = now(), |
818 |
|
|
TimeStamp = MegaSecs * 1000000 + Secs, |
819 |
|
|
TS = TimeStamp - Days * 86400, |
820 |
|
|
case catch mnesia:dirty_select( |
821 |
|
|
last_activity, [{{last_activity, {'_', Host}, '$1', '_'}, |
822 |
|
|
[{'>', '$1', TS}], |
823 |
|
|
[{'trunc', {'/', |
824 |
|
|
{'-', TimeStamp, '$1'}, |
825 |
|
|
86400}}]}]) of |
826 |
|
|
{'EXIT', _Reason} -> |
827 |
|
|
[]; |
828 |
|
|
Vals -> |
829 |
|
|
Hist = histogram(Vals, Integral), |
830 |
|
|
if |
831 |
|
|
Hist == [] -> |
832 |
|
|
0; |
833 |
|
|
true -> |
834 |
|
|
Left = if |
835 |
|
|
Days == infinity -> |
836 |
|
|
0; |
837 |
|
|
true -> |
838 |
|
|
Days - length(Hist) |
839 |
|
|
end, |
840 |
|
|
Tail = if |
841 |
|
|
Integral -> |
842 |
|
|
lists:duplicate(Left, lists:last(Hist)); |
843 |
|
|
true -> |
844 |
|
|
lists:duplicate(Left, 0) |
845 |
|
|
end, |
846 |
|
|
lists:nth(Days, Hist ++ Tail) |
847 |
|
|
end |
848 |
|
|
end. |
849 |
|
|
histogram(Values, Integral) -> |
850 |
|
|
histogram(lists:sort(Values), Integral, 0, 0, []). |
851 |
|
|
histogram([H | T], Integral, Current, Count, Hist) when Current == H -> |
852 |
|
|
histogram(T, Integral, Current, Count + 1, Hist); |
853 |
|
|
histogram([H | _] = Values, Integral, Current, Count, Hist) when Current < H -> |
854 |
|
|
if |
855 |
|
|
Integral -> |
856 |
|
|
histogram(Values, Integral, Current + 1, Count, [Count | Hist]); |
857 |
|
|
true -> |
858 |
|
|
histogram(Values, Integral, Current + 1, 0, [Count | Hist]) |
859 |
|
|
end; |
860 |
|
|
histogram([], _Integral, _Current, Count, Hist) -> |
861 |
|
|
if |
862 |
|
|
Count > 0 -> |
863 |
|
|
lists:reverse([Count | Hist]); |
864 |
|
|
true -> |
865 |
|
|
lists:reverse(Hist) |
866 |
|
|
end. |
867 |
|
|
|
868 |
slords |
1.4 |
group_parameters(Ps, [Char]) -> |
869 |
|
|
{none, Grouped_Ps} = lists:foldl( |
870 |
|
|
fun(P, {State, Res}) -> |
871 |
|
|
case State of |
872 |
|
|
none -> |
873 |
|
|
case P of |
874 |
|
|
[Char | PTail]-> |
875 |
|
|
{building, [PTail | Res]}; |
876 |
|
|
_ -> |
877 |
|
|
{none, [P | Res]} |
878 |
|
|
end; |
879 |
|
|
building -> |
880 |
|
|
[ResHead | ResTail] = Res, |
881 |
|
|
case lists:last(P) of |
882 |
|
|
Char -> |
883 |
|
|
P2 = lists:sublist(P, length(P)-1), |
884 |
|
|
{none, [ResHead ++ " " ++ P2 | ResTail]}; |
885 |
|
|
_ -> |
886 |
|
|
{building, [ResHead ++ " " ++ P | ResTail]} |
887 |
|
|
end |
888 |
|
|
end |
889 |
|
|
end, |
890 |
|
|
{none, []}, |
891 |
|
|
Ps), |
892 |
|
|
lists:reverse(Grouped_Ps). |