2004-04-26 17:38:07 +02:00
%%%----------------------------------------------------------------------
%%% File : ejabberd_web_admin.erl
2007-08-31 18:13:35 +02:00
%%% Author : Alexey Shchepin <alexey@process-one.net>
2004-05-22 21:48:35 +02:00
%%% Purpose : Administration web interface
2007-08-31 18:13:35 +02:00
%%% Created : 9 Apr 2004 by Alexey Shchepin <alexey@process-one.net>
2007-12-24 12:41:41 +01:00
%%%
%%%
2010-01-12 17:11:32 +01:00
%%% ejabberd, Copyright (C) 2002-2010 ProcessOne
2007-12-24 12:41:41 +01:00
%%%
%%% 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.
2009-01-12 15:44:42 +01:00
%%%
2007-12-24 12:41:41 +01:00
%%% 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
%%%
2004-10-05 21:31:17 +02:00
%%%----------------------------------------------------------------------
2004-04-26 17:38:07 +02:00
2009-06-23 22:45:39 +02:00
%%%% definitions
2004-04-26 17:38:07 +02:00
- module ( ejabberd_web_admin ) .
2007-08-31 18:13:35 +02:00
- author ( 'alexey@process-one.net' ) .
2004-04-26 17:38:07 +02:00
%% External exports
2007-01-25 06:53:58 +01:00
- export ( [ process / 2 ,
2005-09-29 03:04:24 +02:00
list_users / 4 ,
2007-08-23 02:51:54 +02:00
list_users_in_diapason / 4 ,
2007-08-24 18:15:05 +02:00
pretty_print_xml / 1 ,
term_to_id / 1 ] ) .
2004-04-26 17:38:07 +02:00
- include ( " ejabberd.hrl " ) .
- include ( " jlib.hrl " ) .
- include ( " ejabberd_http.hrl " ) .
2007-08-23 02:51:54 +02:00
- include ( " ejabberd_web_admin.hrl " ) .
2004-04-26 17:38:07 +02:00
2009-05-27 19:28:55 +02:00
- define ( INPUTATTRS ( Type , Name , Value , Attrs ) ,
? XA ( " input " , Attrs ++
[ { " type " , Type } ,
{ " name " , Name } ,
{ " value " , Value } ] ) ) .
2009-06-23 23:00:43 +02:00
%%%==================================
%%%% get_acl_access
2010-05-10 16:12:48 +02:00
%% @spec (Path::[string()], Method) -> {HostOfRule, [AccessRule]}
%% where Method = 'GET' | 'POST'
2009-06-23 23:00:43 +02:00
%% All accounts can access those URLs
2010-04-27 23:16:48 +02:00
get_acl_rule ( [ ] , _ ) - > { " localhost " , [ all ] } ;
get_acl_rule ( [ " style.css " ] , _ ) - > { " localhost " , [ all ] } ;
get_acl_rule ( [ " logo.png " ] , _ ) - > { " localhost " , [ all ] } ;
get_acl_rule ( [ " logo-fill.png " ] , _ ) - > { " localhost " , [ all ] } ;
get_acl_rule ( [ " favicon.ico " ] , _ ) - > { " localhost " , [ all ] } ;
get_acl_rule ( [ " additions.js " ] , _ ) - > { " localhost " , [ all ] } ;
2009-06-23 23:00:43 +02:00
%% This page only displays vhosts that the user is admin:
2010-04-27 23:16:48 +02:00
get_acl_rule ( [ " vhosts " ] , _ ) - > { " localhost " , [ all ] } ;
2009-06-23 23:00:43 +02:00
%% The pages of a vhost are only accesible if the user is admin of that vhost:
2010-04-27 23:16:48 +02:00
get_acl_rule ( [ " server " , VHost | _ RPath ] , 'GET' ) - > { VHost , [ configure , webadmin_view ] } ;
get_acl_rule ( [ " server " , VHost | _ RPath ] , 'POST' ) - > { VHost , [ configure ] } ;
2009-06-23 23:00:43 +02:00
%% Default rule: only global admins can access any other random page
2010-04-27 23:16:48 +02:00
get_acl_rule ( _ RPath , 'GET' ) - > { global , [ configure , webadmin_view ] } ;
get_acl_rule ( _ RPath , 'POST' ) - > { global , [ configure ] } .
is_acl_match ( Host , Rules , Jid ) - >
lists : any (
fun ( Rule ) - >
allow == acl : match_rule ( Host , Rule , Jid )
end ,
Rules ) .
2009-06-23 23:00:43 +02:00
%%%==================================
%%%% Menu Items Access
2010-04-27 23:16:48 +02:00
get_jid ( Auth , HostHTTP , Method ) - >
case get_auth_admin ( Auth , HostHTTP , [ ] , Method ) of
2009-06-23 23:00:43 +02:00
{ ok , { User , Server } } - >
jlib : make_jid ( User , Server , " " ) ;
{ unauthorized , Error } - >
? ERROR_MSG ( " Unauthorized ~p : ~p " , [ Auth , Error ] ) ,
throw ( { unauthorized , Auth } )
end .
get_menu_items ( global , cluster , Lang , JID ) - >
{ Base , _ , Items } = make_server_menu ( [ ] , [ ] , Lang , JID ) ,
lists : map (
fun ( { URI , Name } ) - >
{ Base ++ URI ++ " / " , Name } ;
( { URI , Name , _ SubMenu } ) - >
{ Base ++ URI ++ " / " , Name }
end ,
Items
) ;
get_menu_items ( Host , cluster , Lang , JID ) - >
{ Base , _ , Items } = make_host_menu ( Host , [ ] , Lang , JID ) ,
lists : map (
fun ( { URI , Name } ) - >
{ Base ++ URI ++ " / " , Name } ;
( { URI , Name , _ SubMenu } ) - >
{ Base ++ URI ++ " / " , Name }
end ,
Items
) ;
get_menu_items ( Host , Node , Lang , JID ) - >
{ Base , _ , Items } = make_host_node_menu ( Host , Node , Lang , JID ) ,
lists : map (
fun ( { URI , Name } ) - >
{ Base ++ URI ++ " / " , Name } ;
( { URI , Name , _ SubMenu } ) - >
{ Base ++ URI ++ " / " , Name }
end ,
Items
) .
is_allowed_path ( BasePath , { Path , _ } , JID ) - >
is_allowed_path ( BasePath ++ [ Path ] , JID ) ;
is_allowed_path ( BasePath , { Path , _ , _ } , JID ) - >
is_allowed_path ( BasePath ++ [ Path ] , JID ) .
is_allowed_path ( [ " admin " | Path ] , JID ) - >
is_allowed_path ( Path , JID ) ;
is_allowed_path ( Path , JID ) - >
2010-04-27 23:16:48 +02:00
{ HostOfRule , AccessRule } = get_acl_rule ( Path , 'GET' ) ,
is_acl_match ( HostOfRule , AccessRule , JID ) .
2009-06-23 23:00:43 +02:00
%% @spec(Path) -> URL
%% where Path = [string()]
%% URL = string()
%% Convert ["admin", "user", "tom"] -> "/admin/user/tom/"
%%path_to_url(Path) ->
%% "/" ++ string:join(Path, "/") ++ "/".
%% @spec(URL) -> Path
%% where Path = [string()]
%% URL = string()
%% Convert "admin/user/tom" -> ["admin", "user", "tom"]
url_to_path ( URL ) - >
string : tokens ( URL , " / " ) .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% process/2
2009-01-07 01:55:02 +01:00
process ( [ " doc " , LocalFile ] , _ Request ) - >
2009-01-20 20:42:08 +01:00
DocPath = case os : getenv ( " EJABBERD_DOC_PATH " ) of
2009-01-07 01:55:02 +01:00
P when is_list ( P ) - > P ;
2009-01-20 20:42:08 +01:00
false - > " /share/doc/ejabberd/ "
2009-01-07 01:55:02 +01:00
end ,
%% Code based in mod_http_fileserver
FileName = filename : join ( DocPath , LocalFile ) ,
case file : read_file ( FileName ) of
{ ok , FileContents } - >
? DEBUG ( " Delivering content. " , [ ] ) ,
{ 200 ,
[ { " Server " , " ejabberd " } ] ,
FileContents } ;
{ error , Error } - >
? DEBUG ( " Delivering error: ~p " , [ Error ] ) ,
2009-01-20 20:42:08 +01:00
Help = " " ++ FileName ++ " - Try to specify the path to ejabberd documentation "
" with the environment variable EJABBERD_DOC_PATH. Check the ejabberd Guide for more information. " ,
2009-01-07 01:55:02 +01:00
case Error of
eacces - > { 403 , [ ] , " Forbidden " ++ Help } ;
enoent - > { 404 , [ ] , " Not found " ++ Help } ;
_ Else - > { 404 , [ ] , atom_to_list ( Error ) ++ Help }
end
end ;
2010-04-27 23:16:48 +02:00
process ( [ " server " , SHost | RPath ] = Path , #request { auth = Auth , lang = Lang , host = HostHTTP , method = Method } = Request ) - >
2007-01-25 06:53:58 +01:00
Host = jlib : nameprep ( SHost ) ,
case lists : member ( Host , ? MYHOSTS ) of
true - >
2010-04-27 23:16:48 +02:00
case get_auth_admin ( Auth , HostHTTP , Path , Method ) of
2009-06-23 00:58:52 +02:00
{ ok , { User , Server } } - >
2010-04-27 23:16:48 +02:00
AJID = get_jid ( Auth , HostHTTP , Method ) ,
2009-06-23 00:58:52 +02:00
process_admin ( Host , Request #request { path = RPath ,
2009-06-23 23:00:43 +02:00
auth = { auth_jid , Auth , AJID } ,
2009-06-23 00:58:52 +02:00
us = { User , Server } } ) ;
{ unauthorized , " no-auth-provided " } - >
2007-01-25 06:53:58 +01:00
{ 401 ,
[ { " WWW-Authenticate " , " basic realm= \" ejabberd \" " } ] ,
2009-06-23 00:58:52 +02:00
ejabberd_web : make_xhtml ( [ ? XCT ( " h1 " , " Unauthorized " ) ] ) } ;
{ unauthorized , Error } - >
2010-05-12 10:27:47 +02:00
{ BadUser , _ BadPass } = Auth ,
{ IPT , _ Port } = Request #request.ip ,
IPS = inet_parse : ntoa ( IPT ) ,
? WARNING_MSG ( " Access of ~p from ~p failed with error: ~p " ,
[ BadUser , IPS , Error ] ) ,
2009-06-23 00:58:52 +02:00
{ 401 ,
[ { " WWW-Authenticate " ,
" basic realm= \" auth error, retry login to ejabberd \" " } ] ,
ejabberd_web : make_xhtml ( [ ? XCT ( " h1 " , " Unauthorized " ) ] ) }
2007-01-25 06:53:58 +01:00
end ;
false - >
ejabberd_web : error ( not_found )
end ;
2010-04-27 23:16:48 +02:00
process ( RPath , #request { auth = Auth , lang = Lang , host = HostHTTP , method = Method } = Request ) - >
case get_auth_admin ( Auth , HostHTTP , RPath , Method ) of
2009-06-23 00:58:52 +02:00
{ ok , { User , Server } } - >
2010-04-27 23:16:48 +02:00
AJID = get_jid ( Auth , HostHTTP , Method ) ,
2009-06-23 00:58:52 +02:00
process_admin ( global , Request #request { path = RPath ,
2009-06-23 23:00:43 +02:00
auth = { auth_jid , Auth , AJID } ,
2009-06-23 00:58:52 +02:00
us = { User , Server } } ) ;
{ unauthorized , " no-auth-provided " } - >
{ 401 ,
2007-01-25 06:53:58 +01:00
[ { " WWW-Authenticate " , " basic realm= \" ejabberd \" " } ] ,
2009-06-23 00:58:52 +02:00
ejabberd_web : make_xhtml ( [ ? XCT ( " h1 " , " Unauthorized " ) ] ) } ;
{ unauthorized , Error } - >
2010-05-12 10:27:47 +02:00
{ BadUser , _ BadPass } = Auth ,
{ IPT , _ Port } = Request #request.ip ,
IPS = inet_parse : ntoa ( IPT ) ,
? WARNING_MSG ( " Access of ~p from ~p failed with error: ~p " ,
[ BadUser , IPS , Error ] ) ,
2009-06-23 00:58:52 +02:00
{ 401 ,
[ { " WWW-Authenticate " ,
" basic realm= \" auth error, retry login to ejabberd \" " } ] ,
ejabberd_web : make_xhtml ( [ ? XCT ( " h1 " , " Unauthorized " ) ] ) }
2007-01-25 06:53:58 +01:00
end .
2010-04-27 23:16:48 +02:00
get_auth_admin ( Auth , HostHTTP , RPath , Method ) - >
2007-01-25 06:53:58 +01:00
case Auth of
2009-06-23 00:58:52 +02:00
{ SJID , Pass } - >
2010-04-27 23:16:48 +02:00
{ HostOfRule , AccessRule } = get_acl_rule ( RPath , Method ) ,
2007-01-25 06:53:58 +01:00
case jlib : string_to_jid ( SJID ) of
error - >
2009-06-23 00:58:52 +02:00
{ unauthorized , " badformed-jid " } ;
#jid { user = " " , server = User } - >
%% If the user only specified username, not username@server
2009-06-23 23:00:43 +02:00
get_auth_account ( HostOfRule , AccessRule , User , HostHTTP , Pass ) ;
2009-06-23 00:58:52 +02:00
#jid { user = User , server = Server } - >
2009-06-23 23:00:43 +02:00
get_auth_account ( HostOfRule , AccessRule , User , Server , Pass )
2007-01-25 06:53:58 +01:00
end ;
2009-06-23 00:58:52 +02:00
undefined - >
{ unauthorized , " no-auth-provided " }
end .
2009-06-23 23:00:43 +02:00
get_auth_account ( HostOfRule , AccessRule , User , Server , Pass ) - >
2009-06-23 00:58:52 +02:00
case ejabberd_auth : check_password ( User , Server , Pass ) of
true - >
2010-04-27 23:16:48 +02:00
case is_acl_match ( HostOfRule , AccessRule ,
2009-06-23 00:58:52 +02:00
jlib : make_jid ( User , Server , " " ) ) of
2010-04-27 23:16:48 +02:00
false - >
2009-06-23 00:58:52 +02:00
{ unauthorized , " unprivileged-account " } ;
2010-04-27 23:16:48 +02:00
true - >
2009-06-23 00:58:52 +02:00
{ ok , { User , Server } }
end ;
false - >
case ejabberd_auth : is_user_exists ( User , Server ) of
true - >
{ unauthorized , " bad-password " } ;
false - >
{ unauthorized , " inexistent-account " }
end
2007-01-25 06:53:58 +01:00
end .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% make_xhtml
2009-06-23 23:00:43 +02:00
make_xhtml ( Els , Host , Lang , JID ) - >
make_xhtml ( Els , Host , cluster , Lang , JID ) .
2008-10-12 15:58:05 +02:00
2009-06-23 23:00:43 +02:00
%% @spec (Els, Host, Node, Lang, JID) -> {200, [html], xmlelement()}
2008-10-12 15:58:05 +02:00
%% where Host = global | string()
%% Node = cluster | atom()
2009-06-23 23:00:43 +02:00
%% JID = jid()
make_xhtml ( Els , Host , Node , Lang , JID ) - >
2008-10-12 15:58:05 +02:00
Base = get_base_path ( Host , cluster ) , %% Enforcing 'cluster' on purpose here
2009-06-23 23:00:43 +02:00
MenuItems = make_navigation ( Host , Node , Lang , JID ) ,
2005-06-20 05:18:13 +02:00
{ 200 , [ html ] ,
{ xmlelement , " html " , [ { " xmlns " , " http://www.w3.org/1999/xhtml " } ,
{ " xml:lang " , Lang } ,
{ " lang " , Lang } ] ,
[ { xmlelement , " head " , [ ] ,
2008-01-01 19:20:57 +01:00
[ ? XCT ( " title " , " ejabberd Web Admin " ) ,
2005-11-26 19:56:39 +01:00
{ xmlelement , " meta " , [ { " http-equiv " , " Content-Type " } ,
2005-06-20 05:18:13 +02:00
{ " content " , " text/html; charset=utf-8 " } ] , [ ] } ,
2009-05-27 19:28:55 +02:00
{ xmlelement , " script " , [ { " src " , Base ++ " /additions.js " } ,
{ " type " , " text/javascript " } ] , [ ? C ( " " ) ] } ,
2008-10-12 15:58:05 +02:00
{ xmlelement , " link " , [ { " href " , Base ++ " favicon.ico " } ,
2007-11-26 16:12:34 +01:00
{ " type " , " image/x-icon " } ,
{ " rel " , " shortcut icon " } ] , [ ] } ,
2005-06-20 05:18:13 +02:00
{ xmlelement , " link " , [ { " href " , Base ++ " style.css " } ,
{ " type " , " text/css " } ,
{ " rel " , " stylesheet " } ] , [ ] } ] } ,
? XE ( " body " ,
[ ? XAE ( " div " ,
[ { " id " , " container " } ] ,
[ ? XAE ( " div " ,
[ { " id " , " header " } ] ,
[ ? XE ( " h1 " ,
2009-01-12 22:48:34 +01:00
[ ? ACT ( " /admin/ " , " ejabberd Web Admin " ) ]
2005-06-20 05:18:13 +02:00
) ] ) ,
? XAE ( " div " ,
[ { " id " , " navigation " } ] ,
[ ? XE ( " ul " ,
2008-10-12 15:58:05 +02:00
MenuItems
2005-05-09 01:39:46 +02:00
) ] ) ,
? XAE ( " div " ,
[ { " id " , " content " } ] ,
Els ) ,
? XAE ( " div " ,
[ { " id " , " clearcopyright " } ] ,
[ { xmlcdata , " " } ] ) ] ) ,
? XAE ( " div " ,
[ { " id " , " copyrightouter " } ] ,
[ ? XAE ( " div " ,
[ { " id " , " copyright " } ] ,
2007-12-19 19:26:32 +01:00
[ ? XC ( " p " ,
2010-01-12 17:11:32 +01:00
" ejabberd (c) 2002-2010 ProcessOne " )
2005-05-09 01:39:46 +02:00
] ) ] ) ] )
2004-04-26 17:38:07 +02:00
] } } .
2008-10-12 15:58:05 +02:00
get_base_path ( global , cluster ) - > " /admin/ " ;
get_base_path ( Host , cluster ) - > " /admin/server/ " ++ Host ++ " / " ;
get_base_path ( global , Node ) - > " /admin/node/ " ++ atom_to_list ( Node ) ++ " / " ;
get_base_path ( Host , Node ) - > " /admin/server/ " ++ Host ++ " /node/ " ++ atom_to_list ( Node ) ++ " / " .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% css & images
2009-05-27 19:28:55 +02:00
additions_js ( ) - >
"
function selectAll ( ) {
for ( i = 0 ; i < document . forms [ 0 ] . elements . length ; i ++ )
{ var e = document . forms [ 0 ] . elements [ i ] ;
if ( e . type == 'checkbox' )
{ e . checked = true ; }
}
}
function unSelectAll ( ) {
for ( i = 0 ; i < document . forms [ 0 ] . elements . length ; i ++ )
{ var e = document . forms [ 0 ] . elements [ i ] ;
if ( e . type == 'checkbox' )
{ e . checked = false ; }
}
}
" .
2005-06-20 05:18:13 +02:00
css ( Host ) - >
2008-10-12 15:58:05 +02:00
Base = get_base_path ( Host , cluster ) ,
2005-06-20 05:18:13 +02:00
"
2005-05-09 01:39:46 +02:00
html , body {
background : white ;
margin : 0 ;
padding : 0 ;
height : 100 %;
2004-05-04 21:47:24 +02:00
}
2005-05-09 01:39:46 +02:00
#container {
padding : 0 ;
margin : 0 ;
min - height : 100 %;
2004-05-07 17:19:51 +02:00
height : 100 %;
2005-05-09 01:39:46 +02:00
margin - bottom : - 30 px ;
}
html > body #container {
height : auto ;
}
#header h1 {
width : 100 %;
height : 55 px ;
2004-05-07 17:19:51 +02:00
padding : 0 ;
2005-05-09 01:39:46 +02:00
margin : 0 ;
2005-06-20 05:18:13 +02:00
background : transparent url ( \ " " ++ Base ++ " logo-fill.png \" );
2004-05-07 17:19:51 +02:00
}
2005-05-09 01:39:46 +02:00
#header h1 a {
position : absolute ;
top : 0 ;
left : 0 ;
width : 100 %;
height : 55 px ;
2004-05-07 17:19:51 +02:00
padding : 0 ;
2005-05-09 01:39:46 +02:00
margin : 0 ;
2005-06-20 05:18:13 +02:00
background : transparent url ( \ " " ++ Base ++ " logo.png \" ) no-repeat;
2005-05-09 01:39:46 +02:00
display : block ;
text - indent : - 700 em ;
2004-05-07 17:19:51 +02:00
}
2005-05-09 01:39:46 +02:00
#clearcopyright {
display : block ;
2004-05-04 21:47:24 +02:00
width : 100 %;
2005-05-09 01:39:46 +02:00
height : 30 px ;
2004-05-04 21:47:24 +02:00
}
2005-05-09 01:39:46 +02:00
#copyrightouter {
display : table ;
2004-05-07 17:19:51 +02:00
width : 100 %;
2005-05-09 01:39:46 +02:00
height : 30 px ;
2004-05-07 17:19:51 +02:00
}
2005-05-09 01:39:46 +02:00
#copyright {
display : table - cell ;
vertical - align : bottom ;
width : 100 %;
height : 30 px ;
2004-05-04 21:47:24 +02:00
}
2005-05-09 01:39:46 +02:00
#copyright p {
margin - left : 0 ;
margin - right : 0 ;
margin - top : 5 px ;
margin - bottom : 0 ;
padding - left : 0 ;
padding - right : 0 ;
padding - top : 1 px ;
padding - bottom : 1 px ;
width : 100 %;
color : #ffffff ;
background - color : #fe8a00 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 7 pt ;
font - weight : bold ;
text - align : center ;
2004-05-07 17:19:51 +02:00
}
2005-05-09 01:39:46 +02:00
#navigation ul {
position : absolute ;
2008-10-12 15:58:05 +02:00
top : 65 px ;
2005-05-09 01:39:46 +02:00
left : 0 ;
2005-05-23 02:30:29 +02:00
padding : 0 1 px 1 px 1 px ;
2005-05-09 01:39:46 +02:00
margin : 0 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
2005-05-23 02:30:29 +02:00
font - size : 8 pt ;
2005-05-09 01:39:46 +02:00
font - weight : bold ;
2009-05-27 19:29:01 +02:00
border - top : 1 px solid #d47911 ;
2008-10-12 15:58:05 +02:00
width : 17 em ;
2004-05-07 17:19:51 +02:00
}
2004-05-04 21:47:24 +02:00
2005-05-09 01:39:46 +02:00
#navigation ul li {
list - style : none ;
margin : 0 ;
text - align : left ;
display : inline ;
2004-05-04 21:47:24 +02:00
}
2005-05-09 01:39:46 +02:00
#navigation ul li a {
margin : 0 ;
display : block ;
2005-05-23 02:30:29 +02:00
padding : 3 px 6 px 3 px 9 px ;
2005-05-09 01:39:46 +02:00
border - left : 1 em solid #ffc78c ;
2009-05-27 19:29:01 +02:00
border - right : 1 px solid #d47911 ;
border - bottom : 1 px solid #d47911 ;
2005-05-09 01:39:46 +02:00
background : #ffe3c9 ;
text - decoration : none ;
2004-05-09 20:38:49 +02:00
}
2005-05-09 01:39:46 +02:00
#navigation ul li a : link {
color : # 844 ;
2004-05-04 21:47:24 +02:00
}
2005-05-09 01:39:46 +02:00
#navigation ul li a : visited {
color : # 766 ;
2004-05-04 21:47:24 +02:00
}
2005-05-09 01:39:46 +02:00
#navigation ul li a : hover {
border - color : #fc8800 ;
color : # FFF ;
background : # 332 ;
}
2008-10-12 15:58:05 +02:00
ul li #navhead a , ul li #navheadsub a , ul li #navheadsubsub a {
text - align : center ;
2009-05-27 19:29:01 +02:00
border - top : 1 px solid #d47911 ;
border - bottom : 2 px solid #d47911 ;
2009-01-12 22:48:34 +01:00
background : # FED6A6 ;
2008-10-12 15:58:05 +02:00
}
#navheadsub , #navitemsub {
border - left : 7 px solid white ;
2009-05-27 19:29:01 +02:00
margin - left : 2 px ;
2008-10-12 15:58:05 +02:00
}
#navheadsubsub , #navitemsubsub {
border - left : 14 px solid white ;
2009-05-27 19:29:01 +02:00
margin - left : 4 px ;
2007-06-22 16:04:45 +02:00
}
2005-05-09 01:39:46 +02:00
#lastactivity li {
font - weight : bold ;
border : 1 px solid #d6760e ;
background - color : #fff2e8 ;
padding : 2 px ;
margin - bottom : - 1 px ;
}
td . copy {
2004-05-07 17:19:51 +02:00
color : #ffffff ;
2004-05-04 21:47:24 +02:00
background - color : #fe8a00 ;
2004-05-07 17:19:51 +02:00
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 7 pt ;
font - weight : bold ;
2004-05-04 21:47:24 +02:00
text - align : center ;
}
2004-04-26 17:38:07 +02:00
input {
2005-05-09 01:39:46 +02:00
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
border : 1 px solid #d6760e ;
color : # 723202 ;
background - color : #fff2e8 ;
vertical - align : middle ;
margin - bottom : 0 px ;
padding : 0 . 1 em ;
2004-04-26 17:38:07 +02:00
}
2004-05-14 16:46:53 +02:00
input [ type = submit ] {
2004-04-26 17:38:07 +02:00
font - family : Verdana , Arial , Helvetica , sans - serif ;
2005-05-23 02:30:29 +02:00
font - size : 8 pt ;
2004-04-26 17:38:07 +02:00
font - weight : bold ;
2004-05-14 16:46:53 +02:00
color : #ffffff ;
background - color : #fe8a00 ;
border : 1 px solid #d6760e ;
2004-04-26 17:38:07 +02:00
}
textarea {
2005-05-09 01:39:46 +02:00
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
border : 1 px solid #d6760e ;
color : # 723202 ;
background - color : #fff2e8 ;
2004-04-26 17:38:07 +02:00
}
select {
2005-05-09 01:39:46 +02:00
border : 1 px solid #d6760e ;
color : # 723202 ;
background - color : #fff2e8 ;
vertical - align : middle ;
margin - bottom : 0 px ;
padding : 0 . 1 em ;
2004-04-26 17:38:07 +02:00
}
2004-10-08 22:40:29 +02:00
thead {
color : # 000000 ;
background - color : #ffffff ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
font - weight : bold ;
}
2004-04-26 17:38:07 +02:00
2004-05-04 21:47:24 +02:00
tr . head {
2004-04-26 17:38:07 +02:00
color : #ffffff ;
background - color : # 3 b547a ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 9 pt ;
font - weight : bold ;
text - align : center ;
}
2004-05-04 21:47:24 +02:00
tr . oddraw {
2004-04-26 17:38:07 +02:00
color : # 412 c75 ;
background - color : #ccd4df ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 9 pt ;
font - weight : normal ;
text - align : center ;
}
2004-05-04 21:47:24 +02:00
tr . evenraw {
2004-04-26 17:38:07 +02:00
color : # 412 c75 ;
background - color : #dbe0e8 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 9 pt ;
font - weight : normal ;
text - align : center ;
}
2004-05-04 21:47:24 +02:00
td . leftheader {
2004-04-26 17:38:07 +02:00
color : # 412 c75 ;
background - color : #ccccc1 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 9 pt ;
font - weight : bold ;
padding - left : 5 px ;
padding - top : 2 px ;
padding - bottom : 2 px ;
margin - top : 0 px ;
margin - bottom : 0 px ;
}
2004-05-04 21:47:24 +02:00
td . leftcontent {
2004-04-26 17:38:07 +02:00
color : # 000044 ;
background - color : #e6e6df ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 7 pt ;
font - weight : normal ;
padding - left : 5 px ;
padding - right : 5 px ;
padding - top : 2 px ;
padding - bottom : 2 px ;
margin - top : 0 px ;
margin - bottom : 0 px ;
}
2004-05-04 21:47:24 +02:00
td . rightcontent {
2004-04-26 17:38:07 +02:00
color : # 000044 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
font - weight : normal ;
text - align : justify ;
padding - left : 10 px ;
padding - right : 10 px ;
padding - bottom : 5 px ;
}
2004-05-04 21:47:24 +02:00
h1 {
2004-04-26 17:38:07 +02:00
color : # 000044 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 14 pt ;
font - weight : bold ;
text - align : center ;
padding - top : 2 px ;
padding - bottom : 2 px ;
margin - top : 0 px ;
margin - bottom : 0 px ;
}
2004-05-04 21:47:24 +02:00
h2 {
2004-04-26 17:38:07 +02:00
color : # 000044 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 12 pt ;
font - weight : bold ;
text - align : center ;
padding - top : 2 px ;
padding - bottom : 2 px ;
margin - top : 0 px ;
margin - bottom : 0 px ;
}
2004-05-04 21:47:24 +02:00
h3 {
2004-04-26 17:38:07 +02:00
color : # 000044 ;
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
font - weight : bold ;
text - align : left ;
padding - top : 20 px ;
padding - bottom : 2 px ;
margin - top : 0 px ;
margin - bottom : 0 px ;
}
2004-05-04 21:47:24 +02:00
#content a : link {
2005-05-09 01:39:46 +02:00
color : # 990000 ;
2004-04-26 17:38:07 +02:00
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
font - weight : bold ;
2005-07-31 03:18:17 +02:00
text - decoration : underline ;
2004-04-26 17:38:07 +02:00
}
2004-05-04 21:47:24 +02:00
#content a : visited {
2005-05-09 01:39:46 +02:00
color : # 990000 ;
2004-04-26 17:38:07 +02:00
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
font - weight : bold ;
2005-07-31 03:18:17 +02:00
text - decoration : underline ;
2004-04-26 17:38:07 +02:00
}
2004-05-04 21:47:24 +02:00
#content a : hover {
2005-05-09 01:39:46 +02:00
color : #cc6600 ;
2004-04-26 17:38:07 +02:00
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
font - weight : bold ;
2005-07-31 03:18:17 +02:00
text - decoration : underline ;
2004-04-26 17:38:07 +02:00
}
2005-05-09 01:39:46 +02:00
#content ul li {
2005-07-31 03:18:17 +02:00
list - style - type : disc ;
2004-05-09 20:38:49 +02:00
font - size : 10 pt ;
/ * font - size : 7 pt ; * /
2004-04-26 17:38:07 +02:00
padding - left : 10 px ;
}
2009-05-27 19:28:55 +02:00
#content ul . nolistyle > li {
list - style - type : none ;
}
2004-05-04 21:47:24 +02:00
#content li . big {
2004-04-26 17:38:07 +02:00
font - size : 10 pt ;
}
2005-05-09 01:39:46 +02:00
#content {
font - family : Verdana , Arial , Helvetica , sans - serif ;
font - size : 10 pt ;
2008-10-12 15:58:05 +02:00
padding - left : 17 em ;
2005-05-09 01:39:46 +02:00
padding - top : 5 px ;
2004-05-04 21:47:24 +02:00
}
2004-04-26 17:38:07 +02:00
2009-01-07 01:55:02 +01:00
div . guidelink {
2004-05-16 22:13:38 +02:00
text - align : right ;
2009-01-07 01:55:02 +01:00
padding - right : 1 em ;
}
2009-01-12 22:48:34 +01:00
table . withtextareas > tbody > tr > td {
vertical - align : top ;
}
p . result {
border : 1 px ;
border - style : dashed ;
border - color : # FE8A02 ;
padding : 1 em ;
margin - right : 1 em ;
background : # FFE3C9 ;
}
2009-01-07 01:55:02 +01:00
* . alignright {
font - size : 10 pt ;
2009-02-02 11:12:44 +01:00
text - align : right ;
2004-05-16 22:13:38 +02:00
}
2004-04-26 17:38:07 +02:00
" .
2007-11-26 16:12:34 +01:00
favicon ( ) - >
jlib : decode_base64 (
" AAABAAEAEBAQAAEABAAoAQAAFgAAACgAAAAQAAAAIAAAAAEABAAAAAAAAAA "
" AAAAAAAAAAAAAAAAAAAAAAAAJf+cAAIPsAAGC8gAVhecAAIr8ACiR7wBBmO "
" cAUKPsAFun8ABhqeoAgLryAJLB8ACz1PcAv9r7AMvi+gAAAAAAAgICARMhI "
" CAkJCQkQkFCQgICN2d2cSMgJCRevdvVQkICAlqYh5MgICQkXrRCQkJCMgI7 "
" kiAjICAUFF2swkFBQRQUXazCQUFBAgI7kiAgICAkJF60QkJCQgICOpiHkyA "
" gJCRevdvlQkICAjdndnMgICQkJCRCQkJCAgICARAgICAAAAAAAAAAAAAAAA "
" AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA "
" AAAAAAAAAAA " ) .
2004-04-26 17:38:07 +02:00
logo ( ) - >
jlib : decode_base64 (
2009-01-12 20:24:25 +01:00
" iVBORw0KGgoAAAANSUhEUgAAAVcAAAA3CAMAAACPbPnEAAAAAXNSR0IArs4c "
" 6QAAAEtQTFRFcTIA1XcE/YsA/40E/pIH/JYc/5kg/54i/KIu/6U6/apE/61H "
" /61P/bFX/7Vh/bda/rpq/L5s/8J2/cJ8/8qI/86Y/9aj/9mt/+bJ7EGiPwAA "
" AZRJREFUeNrt28lug0AQhGHajrPv+/s/aVwpDlgE0gQ3tqO/DhxihMg33VJ7 "
" JmmCVKSJlVJ4bZQ93Jl/zjJv+8tzcMUVV1xxLXIlRfPAZptYrbf5YeW618PW "
" yvG8w/g9ZwquuJ6Y6+bbdY0rrifhSmrmgUulVXbVDq3H39Zy6Cf9+8c7JNM/ "
" mXeY8+SMRmuIK6644oprkSupmQdulLhQdup1qJKmrmWmVpb5NN9LUyddu7nn "
" LYkrrrjiimuVK6mZB+6VuFbiXJk8v/bnv0PVa+Yd5tdr/x7vCfqbgPsfV1xx "
" xRXXKldSMw+8KPGgxJWyU7WZE538p0vOr/lOm/q7dPf+bOVKvVXiUcEVV1xx "
" xbXMldTMA29KPCtxp7T6XpvxE6/9nm/l987mnG9l5u/8jO4Ot9uTEq8Krrji "
" iiuuZa6kZh74UFpli3sO61btMfyHyWGv/RMs7wB67ne32/BdwRVXXHHFtcyV "
" 1MwDn0qrbHHvyPT/Dsarla/R/1GpQydYPhf0bqC/A7jz7YkrrrjiimuVK6nI "
" F5dWoNvcLcs/AAAAAElFTkSuQmCC " ) .
2004-04-26 17:38:07 +02:00
logo_fill ( ) - >
jlib : decode_base64 (
2009-01-12 20:24:25 +01:00
" iVBORw0KGgoAAAANSUhEUgAAAAYAAAA3BAMAAADdxCZzAAAAAXNSR0IArs4c "
" 6QAAAB5QTFRF1nYO/ooC/o4O/pIS/p4q/q5K/rpq/sqM/tam/ubGzn/S/AAA "
" AEFJREFUCNdlw0sRwCAQBUE+gSRHLGABC1jAAhbWAhZwC+88XdXOXb4UlFAr "
" SmwN5ekdJY2BkudEec1QvrVQ/r3xOlK9HsTvertmAAAAAElFTkSuQmCC " ) .
2004-04-26 17:38:07 +02:00
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% process_admin
2008-10-12 15:58:05 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( global ,
2007-12-07 02:40:24 +01:00
#request { path = [ ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2009-06-23 23:00:43 +02:00
%%Base = get_base_path(global, cluster),
2009-01-07 01:55:02 +01:00
make_xhtml ( ? H1GL ( ? T ( " Administration " ) , " toc " , " Contents " ) ++
[ ? XE ( " ul " ,
2009-06-23 23:00:43 +02:00
[ ? LI ( [ ? ACT ( MIU , MIN ) ] ) | | { MIU , MIN } < - get_menu_items ( global , cluster , Lang , AJID ) ]
2005-06-20 05:18:13 +02:00
)
2009-06-23 23:00:43 +02:00
] , global , Lang , AJID ) ;
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2009-06-23 23:00:43 +02:00
%%Base = get_base_path(Host, cluster),
2006-02-18 20:56:16 +01:00
make_xhtml ( [ ? XCT ( " h1 " , " Administration " ) ,
2005-06-20 05:18:13 +02:00
? XE ( " ul " ,
2009-06-23 23:00:43 +02:00
[ ? LI ( [ ? ACT ( MIU , MIN ) ] ) | | { MIU , MIN } < - get_menu_items ( Host , cluster , Lang , AJID ) ]
2005-04-18 22:03:07 +02:00
)
2009-06-23 23:00:43 +02:00
] , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2007-12-07 02:40:24 +01:00
process_admin ( Host , #request { path = [ " style.css " ] } ) - >
2008-04-12 10:09:05 +02:00
{ 200 , [ { " Content-Type " , " text/css " } , last_modified ( ) , cache_control_public ( ) ] , css ( Host ) } ;
2004-04-26 17:38:07 +02:00
2007-12-07 02:40:24 +01:00
process_admin ( _ Host , #request { path = [ " favicon.ico " ] } ) - >
2008-04-12 10:09:05 +02:00
{ 200 , [ { " Content-Type " , " image/x-icon " } , last_modified ( ) , cache_control_public ( ) ] , favicon ( ) } ;
2007-11-26 16:12:34 +01:00
2007-12-07 02:40:24 +01:00
process_admin ( _ Host , #request { path = [ " logo.png " ] } ) - >
2008-04-12 10:09:05 +02:00
{ 200 , [ { " Content-Type " , " image/png " } , last_modified ( ) , cache_control_public ( ) ] , logo ( ) } ;
2004-04-26 17:38:07 +02:00
2007-12-07 02:40:24 +01:00
process_admin ( _ Host , #request { path = [ " logo-fill.png " ] } ) - >
2008-04-12 10:09:05 +02:00
{ 200 , [ { " Content-Type " , " image/png " } , last_modified ( ) , cache_control_public ( ) ] , logo_fill ( ) } ;
2004-04-26 17:38:07 +02:00
2009-05-27 19:28:55 +02:00
process_admin ( _ Host , #request { path = [ " additions.js " ] } ) - >
{ 200 , [ { " Content-Type " , " text/javascript " } , last_modified ( ) , cache_control_public ( ) ] , additions_js ( ) } ;
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " acls-raw " ] ,
2004-04-26 17:38:07 +02:00
q = Query ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2009-01-12 22:48:34 +01:00
2004-04-26 17:38:07 +02:00
Res = case lists : keysearch ( " acls " , 1 , Query ) of
{ value , { _ , String } } - >
case erl_scan : string ( String ) of
{ ok , Tokens , _ } - >
case erl_parse : parse_term ( Tokens ) of
{ ok , NewACLs } - >
2005-06-20 05:18:13 +02:00
case acl : add_list ( Host , NewACLs , true ) of
2004-04-26 17:38:07 +02:00
ok - >
ok ;
_ - >
error
end ;
_ - >
error
end ;
_ - >
error
end ;
_ - >
nothing
end ,
2009-01-12 22:48:34 +01:00
ACLs = lists : keysort ( 2 , ets : select ( acl , [ { { acl , { '$1' , Host } , '$2' } ,
[ ] , [ { { acl , '$1' , '$2' } } ] } ] ) ) ,
{ NumLines , ACLsP } = term_to_paragraph ( ACLs , 80 ) ,
2009-01-07 01:55:02 +01:00
make_xhtml ( ? H1GL ( ? T ( " Access Control Lists " ) , " ACLDefinition " , " ACL Definition " ) ++
2004-04-26 17:38:07 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2009-01-12 22:48:34 +01:00
[ ? TEXTAREA ( " acls " , integer_to_list ( lists : max ( [ 16 , NumLines ] ) ) , " 80 " , ACLsP ++ " . " ) ,
2004-04-26 17:38:07 +02:00
? BR ,
2005-04-24 21:25:47 +02:00
? INPUTT ( " submit " , " submit " , " Submit " )
2004-04-26 17:38:07 +02:00
] )
2009-06-23 23:00:43 +02:00
] , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
#request { method = Method ,
2004-04-26 17:38:07 +02:00
path = [ " acls " ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2004-04-26 17:38:07 +02:00
q = Query ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2007-12-06 12:24:57 +01:00
? DEBUG ( " query: ~p " , [ Query ] ) ,
2004-04-26 17:38:07 +02:00
Res = case Method of
'POST' - >
2005-06-20 05:18:13 +02:00
case catch acl_parse_query ( Host , Query ) of
2004-04-26 17:38:07 +02:00
{ 'EXIT' , _ } - >
error ;
NewACLs - >
2005-06-20 05:18:13 +02:00
? INFO_MSG ( " NewACLs at ~s : ~p " , [ Host , NewACLs ] ) ,
case acl : add_list ( Host , NewACLs , true ) of
2004-04-26 17:38:07 +02:00
ok - >
? INFO_MSG ( " NewACLs: ok " , [ ] ) ,
ok ;
_ - >
error
end
end ;
_ - >
nothing
end ,
2005-06-20 05:18:13 +02:00
ACLs = lists : keysort (
2 , ets : select ( acl , [ { { acl , { '$1' , Host } , '$2' } ,
[ ] , [ { { acl , '$1' , '$2' } } ] } ] ) ) ,
2009-01-07 01:55:02 +01:00
make_xhtml ( ? H1GL ( ? T ( " Access Control Lists " ) , " ACLDefinition " , " ACL Definition " ) ++
2004-04-26 17:38:07 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2006-02-18 20:56:16 +01:00
[ ? XE ( " p " , [ ? ACT ( " ../acls-raw/ " , " Raw " ) ] ) ] ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-04-26 17:38:07 +02:00
[ acls_to_xhtml ( ACLs ) ,
? BR ,
2004-05-01 22:10:25 +02:00
? INPUTT ( " submit " , " delete " , " Delete Selected " ) ,
2004-04-26 17:38:07 +02:00
? C ( " " ) ,
2004-05-01 22:10:25 +02:00
? INPUTT ( " submit " , " submit " , " Submit " )
2004-04-26 17:38:07 +02:00
] )
2009-06-23 23:00:43 +02:00
] , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " access-raw " ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2004-04-26 17:38:07 +02:00
q = Query ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2004-04-26 17:38:07 +02:00
SetAccess =
fun ( Rs ) - >
mnesia : transaction (
fun ( ) - >
2005-06-20 05:18:13 +02:00
Os = mnesia : select (
config ,
[ { { config , { access , '$1' , Host } , '$2' } ,
[ ] ,
[ '$_' ] } ] ) ,
2004-04-26 17:38:07 +02:00
lists : foreach ( fun ( O ) - >
mnesia : delete_object ( O )
end , Os ) ,
lists : foreach (
fun ( { access , Name , Rules } ) - >
mnesia : write ( { config ,
2005-06-20 05:18:13 +02:00
{ access , Name , Host } ,
2004-04-26 17:38:07 +02:00
Rules } )
end , Rs )
end )
end ,
Res = case lists : keysearch ( " access " , 1 , Query ) of
{ value , { _ , String } } - >
case erl_scan : string ( String ) of
{ ok , Tokens , _ } - >
case erl_parse : parse_term ( Tokens ) of
{ ok , Rs } - >
case SetAccess ( Rs ) of
{ atomic , _ } - >
ok ;
_ - >
error
end ;
_ - >
error
end ;
_ - >
error
end ;
_ - >
nothing
end ,
Access =
2009-01-12 22:48:34 +01:00
ets : select ( config ,
2005-06-20 05:18:13 +02:00
[ { { config , { access , '$1' , Host } , '$2' } ,
2004-04-26 17:38:07 +02:00
[ ] ,
2009-01-12 22:48:34 +01:00
[ { { access , '$1' , '$2' } } ] } ] ) ,
{ NumLines , AccessP } = term_to_paragraph ( Access , 80 ) ,
2009-01-07 01:55:02 +01:00
make_xhtml ( ? H1GL ( ? T ( " Access Rules " ) , " AccessRights " , " Access Rights " ) ++
2004-04-26 17:38:07 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2009-01-12 22:48:34 +01:00
[ ? TEXTAREA ( " access " , integer_to_list ( lists : max ( [ 16 , NumLines ] ) ) , " 80 " , AccessP ++ " . " ) ,
2004-04-26 17:38:07 +02:00
? BR ,
2005-04-24 21:25:47 +02:00
? INPUTT ( " submit " , " submit " , " Submit " )
2004-04-26 17:38:07 +02:00
] )
2009-06-23 23:00:43 +02:00
] , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
#request { method = Method ,
2004-04-26 17:38:07 +02:00
path = [ " access " ] ,
q = Query ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2007-12-06 12:24:57 +01:00
? DEBUG ( " query: ~p " , [ Query ] ) ,
2004-04-26 17:38:07 +02:00
Res = case Method of
'POST' - >
2005-06-20 05:18:13 +02:00
case catch access_parse_query ( Host , Query ) of
2004-04-26 17:38:07 +02:00
{ 'EXIT' , _ } - >
error ;
ok - >
ok
end ;
_ - >
nothing
end ,
AccessRules =
ets : select ( config ,
2005-06-20 05:18:13 +02:00
[ { { config , { access , '$1' , Host } , '$2' } ,
2004-04-26 17:38:07 +02:00
[ ] ,
[ { { access , '$1' , '$2' } } ] } ] ) ,
2009-01-07 01:55:02 +01:00
make_xhtml ( ? H1GL ( ? T ( " Access Rules " ) , " AccessRights " , " Access Rights " ) ++
2004-04-26 17:38:07 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2006-04-01 23:43:52 +02:00
[ ? XE ( " p " , [ ? ACT ( " ../access-raw/ " , " Raw " ) ] ) ] ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-05-01 22:10:25 +02:00
[ access_rules_to_xhtml ( AccessRules , Lang ) ,
2004-04-26 17:38:07 +02:00
? BR ,
2004-05-01 22:10:25 +02:00
? INPUTT ( " submit " , " delete " , " Delete Selected " )
2004-04-26 17:38:07 +02:00
] )
2009-06-23 23:00:43 +02:00
] , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " access " , SName ] ,
2004-04-26 17:38:07 +02:00
q = Query ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2007-12-06 12:24:57 +01:00
? DEBUG ( " query: ~p " , [ Query ] ) ,
2004-04-26 17:38:07 +02:00
Name = list_to_atom ( SName ) ,
Res = case lists : keysearch ( " rules " , 1 , Query ) of
{ value , { _ , String } } - >
case parse_access_rule ( String ) of
{ ok , Rs } - >
ejabberd_config : add_global_option (
2005-06-20 05:18:13 +02:00
{ access , Name , Host } , Rs ) ,
2004-04-26 17:38:07 +02:00
ok ;
_ - >
error
end ;
_ - >
nothing
end ,
2005-06-20 05:18:13 +02:00
Rules = case ejabberd_config : get_global_option ( { access , Name , Host } ) of
2004-04-26 17:38:07 +02:00
undefined - >
[ ] ;
Rs1 - >
Rs1
end ,
make_xhtml ( [ ? XC ( " h1 " ,
2004-07-13 13:28:28 +02:00
io_lib : format ( ? T ( " ~s access rule configuration " ) , [ SName ] ) ) ] ++
2004-04-26 17:38:07 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-04-26 17:38:07 +02:00
[ access_rule_to_xhtml ( Rules ) ,
? BR ,
2004-07-13 13:28:28 +02:00
? INPUTT ( " submit " , " submit " , " Submit " )
2004-04-26 17:38:07 +02:00
] )
2009-06-23 23:00:43 +02:00
] , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-07-29 22:34:57 +02:00
process_admin ( global ,
2007-12-07 02:40:24 +01:00
#request { path = [ " vhosts " ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2009-06-23 23:00:43 +02:00
Res = list_vhosts ( Lang , AJID ) ,
make_xhtml ( ? H1GL ( ? T ( " ejabberd virtual hosts " ) , " virtualhost " , " Virtual Hosting " ) ++ Res , global , Lang , AJID ) ;
2005-07-29 22:34:57 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " users " ] ,
2005-07-29 22:34:57 +02:00
q = Query ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) when is_list ( Host ) - >
2005-09-29 03:04:24 +02:00
Res = list_users ( Host , Query , Lang , fun url_func / 1 ) ,
2009-06-23 23:00:43 +02:00
make_xhtml ( [ ? XCT ( " h1 " , " Users " ) ] ++ Res , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " users " , Diap ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) when is_list ( Host ) - >
2005-09-29 03:04:24 +02:00
Res = list_users_in_diapason ( Host , Diap , Lang , fun url_func / 1 ) ,
2009-06-23 23:00:43 +02:00
make_xhtml ( [ ? XCT ( " h1 " , " Users " ) ] ++ Res , Host , Lang , AJID ) ;
2004-10-05 21:31:17 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request {
2005-07-29 22:34:57 +02:00
path = [ " online-users " ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) when is_list ( Host ) - >
2005-06-20 05:18:13 +02:00
Res = list_online_users ( Host , Lang ) ,
2009-06-23 23:00:43 +02:00
make_xhtml ( [ ? XCT ( " h1 " , " Online Users " ) ] ++ Res , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " last-activity " ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2005-05-09 01:39:46 +02:00
q = Query ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) when is_list ( Host ) - >
2007-12-06 12:24:57 +01:00
? DEBUG ( " query: ~p " , [ Query ] ) ,
2005-05-09 01:39:46 +02:00
Month = case lists : keysearch ( " period " , 1 , Query ) of
{ value , { _ , Val } } - >
Val ;
_ - >
" month "
end ,
Res = case lists : keysearch ( " ordinary " , 1 , Query ) of
{ value , { _ , _ } } - >
2005-06-20 05:18:13 +02:00
list_last_activity ( Host , Lang , false , Month ) ;
2005-05-09 01:39:46 +02:00
_ - >
2005-06-20 05:18:13 +02:00
list_last_activity ( Host , Lang , true , Month )
2005-05-09 01:39:46 +02:00
end ,
2006-02-18 20:56:16 +01:00
make_xhtml ( [ ? XCT ( " h1 " , " Users Last Activity " ) ] ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2005-05-09 01:39:46 +02:00
[ ? CT ( " Period: " ) ,
? XAE ( " select " , [ { " name " , " period " } ] ,
lists : map (
fun ( { O , V } ) - >
Sel = if
O == Month - > [ { " selected " , " selected " } ] ;
true - > [ ]
end ,
? XAC ( " option " ,
Sel ++ [ { " value " , O } ] , V )
end , [ { " month " , ? T ( " Last month " ) } ,
{ " year " , ? T ( " Last year " ) } ,
{ " all " , ? T ( " All activity " ) } ] ) ) ,
? C ( " " ) ,
? INPUTT ( " submit " , " ordinary " , " Show Ordinary Table " ) ,
? C ( " " ) ,
? INPUTT ( " submit " , " integral " , " Show Integral Table " )
] ) ] ++
2009-06-23 23:00:43 +02:00
Res , Host , Lang , AJID ) ;
2005-05-09 01:39:46 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " stats " ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2005-06-20 05:18:13 +02:00
Res = get_stats ( Host , Lang ) ,
2009-06-23 23:00:43 +02:00
make_xhtml ( [ ? XCT ( " h1 " , " Statistics " ) ] ++ Res , Host , Lang , AJID ) ;
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " user " , U ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2004-05-04 21:47:24 +02:00
q = Query ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2008-10-13 10:32:04 +02:00
case ejabberd_auth : is_user_exists ( U , Host ) of
true - >
Res = user_info ( U , Host , Query , Lang ) ,
2009-06-23 23:00:43 +02:00
make_xhtml ( Res , Host , Lang , AJID ) ;
2008-10-13 10:32:04 +02:00
false - >
2009-06-23 23:00:43 +02:00
make_xhtml ( [ ? XCT ( " h1 " , " Not Found " ) ] , Host , Lang , AJID )
2008-10-13 10:32:04 +02:00
end ;
2004-05-04 21:47:24 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " nodes " ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2004-05-09 20:38:49 +02:00
Res = get_nodes ( Lang ) ,
2009-06-23 23:00:43 +02:00
make_xhtml ( Res , Host , Lang , AJID ) ;
2004-05-09 20:38:49 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ " node " , SNode | NPath ] ,
2009-06-23 23:00:43 +02:00
auth = { _ , _ Auth , AJID } ,
2004-05-14 16:46:53 +02:00
q = Query ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2004-05-14 16:46:53 +02:00
case search_running_node ( SNode ) of
false - >
2009-06-23 23:00:43 +02:00
make_xhtml ( [ ? XCT ( " h1 " , " Node not found " ) ] , Host , Lang , AJID ) ;
2004-05-14 16:46:53 +02:00
Node - >
2005-06-20 05:18:13 +02:00
Res = get_node ( Host , Node , NPath , Query , Lang ) ,
2009-06-23 23:00:43 +02:00
make_xhtml ( Res , Host , Node , Lang , AJID )
2004-05-14 16:46:53 +02:00
end ;
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% process_admin default case
2009-06-23 23:00:43 +02:00
process_admin ( Host , #request { lang = Lang ,
auth = { _ , _ Auth , AJID }
} = Request ) - >
2007-08-23 02:51:54 +02:00
{ Hook , Opts } = case Host of
global - > { webadmin_page_main , [ Request ] } ;
Host - > { webadmin_page_host , [ Host , Request ] }
end ,
case ejabberd_hooks : run_fold ( Hook , Host , [ ] , Opts ) of
2009-06-23 23:00:43 +02:00
[ ] - > setelement ( 1 , make_xhtml ( [ ? XC ( " h1 " , " Not Found " ) ] , Host , Lang , AJID ) , 404 ) ;
Res - > make_xhtml ( Res , Host , Lang , AJID )
2007-08-23 02:51:54 +02:00
end .
2004-04-26 17:38:07 +02:00
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% acl
2004-04-26 17:38:07 +02:00
acls_to_xhtml ( ACLs ) - >
? XAE ( " table " , [ ] ,
[ ? XE ( " tbody " ,
lists : map (
fun ( { acl , Name , Spec } = ACL ) - >
SName = atom_to_list ( Name ) ,
ID = term_to_id ( ACL ) ,
? XE ( " tr " ,
[ ? XE ( " td " , [ ? INPUT ( " checkbox " , " selected " , ID ) ] ) ,
? XC ( " td " , SName ) ] ++
acl_spec_to_xhtml ( ID , Spec )
)
end , ACLs ) ++
[ ? XE ( " tr " ,
[ ? X ( " td " ) ,
? XE ( " td " , [ ? INPUT ( " text " , " namenew " , " " ) ] )
] ++
acl_spec_to_xhtml ( " new " , { user , " " } )
) ]
) ] ) .
acl_spec_to_text ( { user , U } ) - >
{ user , U } ;
acl_spec_to_text ( { server , S } ) - >
{ server , S } ;
acl_spec_to_text ( { user , U , S } ) - >
2008-02-12 02:16:11 +01:00
{ user , U ++ " @ " ++ S } ;
2004-04-26 17:38:07 +02:00
2007-12-06 19:54:18 +01:00
acl_spec_to_text ( { user_regexp , RU } ) - >
{ user_regexp , RU } ;
acl_spec_to_text ( { user_regexp , RU , S } ) - >
{ user_regexp , RU ++ " @ " ++ S } ;
acl_spec_to_text ( { server_regexp , RS } ) - >
{ server_regexp , RS } ;
acl_spec_to_text ( { node_regexp , RU , RS } ) - >
{ node_regexp , RU ++ " @ " ++ RS } ;
acl_spec_to_text ( { user_glob , RU } ) - >
{ user_glob , RU } ;
acl_spec_to_text ( { user_glob , RU , S } ) - >
{ user_glob , RU ++ " @ " ++ S } ;
acl_spec_to_text ( { server_glob , RS } ) - >
{ server_glob , RS } ;
acl_spec_to_text ( { node_glob , RU , RS } ) - >
{ node_glob , RU ++ " @ " ++ RS } ;
2008-02-12 02:16:11 +01:00
acl_spec_to_text ( all ) - >
{ all , " " } ;
2004-04-26 17:38:07 +02:00
acl_spec_to_text ( Spec ) - >
{ raw , term_to_string ( Spec ) } .
acl_spec_to_xhtml ( ID , Spec ) - >
{ Type , Str } = acl_spec_to_text ( Spec ) ,
[ acl_spec_select ( ID , Type ) , ? ACLINPUT ( Str ) ] .
acl_spec_select ( ID , Opt ) - >
? XE ( " td " ,
[ ? XAE ( " select " , [ { " name " , " type " ++ ID } ] ,
lists : map (
fun ( O ) - >
Sel = if
O == Opt - > [ { " selected " , " selected " } ] ;
true - > [ ]
end ,
? XAC ( " option " ,
Sel ++ [ { " value " , atom_to_list ( O ) } ] ,
atom_to_list ( O ) )
2008-02-12 02:16:11 +01:00
end , [ user , server , user_regexp , server_regexp ,
node_regexp , user_glob , server_glob , node_glob , all , raw ] ) ) ] ) .
2004-04-26 17:38:07 +02:00
2009-01-12 22:48:34 +01:00
%% @spec (T::any()) -> StringLine::string()
2004-04-26 17:38:07 +02:00
term_to_string ( T ) - >
2008-03-12 23:29:53 +01:00
StringParagraph = lists : flatten ( io_lib : format ( " ~1000000p " , [ T ] ) ) ,
%% Remove from the string all the carriage returns characters
{ ok , StringLine , _ } = regexp : gsub ( StringParagraph , " \\ n " , " " ) ,
StringLine .
2004-04-26 17:38:07 +02:00
2009-01-21 20:49:26 +01:00
%% @spec (T::any(), Cols::integer()) -> {NumLines::integer(), Paragraph::string()}
2009-01-12 22:48:34 +01:00
term_to_paragraph ( T , Cols ) - >
2009-01-21 20:49:26 +01:00
Paragraph = erl_prettypr : format ( erl_syntax : abstract ( T ) , [ { paper , Cols } ] ) ,
{ ok , FieldList } = regexp : split ( Paragraph , " \n " ) ,
NumLines = length ( FieldList ) ,
{ NumLines , Paragraph } .
2009-01-12 22:48:34 +01:00
2004-04-26 17:38:07 +02:00
term_to_id ( T ) - >
jlib : encode_base64 ( binary_to_list ( term_to_binary ( T ) ) ) .
2005-06-20 05:18:13 +02:00
acl_parse_query ( Host , Query ) - >
ACLs = ets : select ( acl , [ { { acl , { '$1' , Host } , '$2' } ,
[ ] , [ { { acl , '$1' , '$2' } } ] } ] ) ,
2004-04-26 17:38:07 +02:00
case lists : keysearch ( " submit " , 1 , Query ) of
{ value , _ } - >
acl_parse_submit ( ACLs , Query ) ;
_ - >
case lists : keysearch ( " delete " , 1 , Query ) of
{ value , _ } - >
acl_parse_delete ( ACLs , Query )
end
end .
acl_parse_submit ( ACLs , Query ) - >
NewACLs =
lists : map (
fun ( { acl , Name , Spec } = ACL ) - >
2007-12-07 02:40:24 +01:00
%%SName = atom_to_list(Name),
2004-04-26 17:38:07 +02:00
ID = term_to_id ( ACL ) ,
case { lists : keysearch ( " type " ++ ID , 1 , Query ) ,
lists : keysearch ( " value " ++ ID , 1 , Query ) } of
{ { value , { _ , T } } , { value , { _ , V } } } - >
{ Type , Str } = acl_spec_to_text ( Spec ) ,
case { atom_to_list ( Type ) , Str } of
{ T , V } - >
ACL ;
_ - >
NewSpec = string_to_spec ( T , V ) ,
{ acl , Name , NewSpec }
end ;
_ - >
ACL
end
end , ACLs ) ,
NewACL = case { lists : keysearch ( " namenew " , 1 , Query ) ,
lists : keysearch ( " typenew " , 1 , Query ) ,
lists : keysearch ( " valuenew " , 1 , Query ) } of
{ { value , { _ , " " } } , _ , _ } - >
[ ] ;
{ { value , { _ , N } } , { value , { _ , T } } , { value , { _ , V } } } - >
NewName = list_to_atom ( N ) ,
NewSpec = string_to_spec ( T , V ) ,
[ { acl , NewName , NewSpec } ] ;
_ - >
[ ]
end ,
NewACLs ++ NewACL .
string_to_spec ( " user " , Val ) - >
2008-02-12 02:16:11 +01:00
string_to_spec2 ( user , Val ) ;
2004-04-26 17:38:07 +02:00
string_to_spec ( " server " , Val ) - >
{ server , Val } ;
2007-12-06 19:54:18 +01:00
string_to_spec ( " user_regexp " , Val ) - >
2008-02-12 02:16:11 +01:00
string_to_spec2 ( user_regexp , Val ) ;
2007-12-06 19:54:18 +01:00
string_to_spec ( " server_regexp " , Val ) - >
{ server_regexp , Val } ;
string_to_spec ( " node_regexp " , Val ) - >
#jid { luser = U , lserver = S , resource = " " } = jlib : string_to_jid ( Val ) ,
{ node_regexp , U , S } ;
string_to_spec ( " user_glob " , Val ) - >
2008-02-12 02:16:11 +01:00
string_to_spec2 ( user_glob , Val ) ;
2007-12-06 19:54:18 +01:00
string_to_spec ( " server_glob " , Val ) - >
{ server_glob , Val } ;
string_to_spec ( " node_glob " , Val ) - >
#jid { luser = U , lserver = S , resource = " " } = jlib : string_to_jid ( Val ) ,
{ node_glob , U , S } ;
2008-02-12 02:16:11 +01:00
string_to_spec ( " all " , _ ) - >
all ;
2004-04-26 17:38:07 +02:00
string_to_spec ( " raw " , Val ) - >
{ ok , Tokens , _ } = erl_scan : string ( Val ++ " . " ) ,
{ ok , NewSpec } = erl_parse : parse_term ( Tokens ) ,
NewSpec .
2008-02-12 02:16:11 +01:00
string_to_spec2 ( ACLName , Val ) - >
#jid { luser = U , lserver = S , resource = " " } = jlib : string_to_jid ( Val ) ,
case U of
" " - >
{ ACLName , S } ;
_ - >
{ ACLName , U , S }
end .
2004-04-26 17:38:07 +02:00
acl_parse_delete ( ACLs , Query ) - >
NewACLs =
lists : filter (
2007-12-07 02:40:24 +01:00
fun ( { acl , _ Name , _ Spec } = ACL ) - >
2004-04-26 17:38:07 +02:00
ID = term_to_id ( ACL ) ,
not lists : member ( { " selected " , ID } , Query )
end , ACLs ) ,
NewACLs .
2004-05-01 22:10:25 +02:00
access_rules_to_xhtml ( AccessRules , Lang ) - >
2004-04-26 17:38:07 +02:00
? XAE ( " table " , [ ] ,
[ ? XE ( " tbody " ,
lists : map (
fun ( { access , Name , Rules } = Access ) - >
SName = atom_to_list ( Name ) ,
ID = term_to_id ( Access ) ,
? XE ( " tr " ,
[ ? XE ( " td " , [ ? INPUT ( " checkbox " , " selected " , ID ) ] ) ,
? XE ( " td " , [ ? AC ( SName ++ " / " , SName ) ] ) ,
? XC ( " td " , term_to_string ( Rules ) )
]
)
end , AccessRules ) ++
[ ? XE ( " tr " ,
[ ? X ( " td " ) ,
? XE ( " td " , [ ? INPUT ( " text " , " namenew " , " " ) ] ) ,
2004-05-01 22:10:25 +02:00
? XE ( " td " , [ ? INPUTT ( " submit " , " addnew " , " Add New " ) ] )
2004-04-26 17:38:07 +02:00
]
) ]
) ] ) .
2005-06-20 05:18:13 +02:00
access_parse_query ( Host , Query ) - >
2004-04-26 17:38:07 +02:00
AccessRules =
ets : select ( config ,
2005-06-20 05:18:13 +02:00
[ { { config , { access , '$1' , Host } , '$2' } ,
2004-04-26 17:38:07 +02:00
[ ] ,
[ { { access , '$1' , '$2' } } ] } ] ) ,
case lists : keysearch ( " addnew " , 1 , Query ) of
{ value , _ } - >
2005-06-20 05:18:13 +02:00
access_parse_addnew ( AccessRules , Host , Query ) ;
2004-04-26 17:38:07 +02:00
_ - >
case lists : keysearch ( " delete " , 1 , Query ) of
{ value , _ } - >
2005-06-20 05:18:13 +02:00
access_parse_delete ( AccessRules , Host , Query )
2004-04-26 17:38:07 +02:00
end
end .
2007-12-07 02:40:24 +01:00
access_parse_addnew ( _ AccessRules , Host , Query ) - >
2004-04-26 17:38:07 +02:00
case lists : keysearch ( " namenew " , 1 , Query ) of
{ value , { _ , String } } when String / = " " - >
Name = list_to_atom ( String ) ,
2005-06-20 05:18:13 +02:00
ejabberd_config : add_global_option ( { access , Name , Host } , [ ] ) ,
2004-04-26 17:38:07 +02:00
ok
end .
2005-06-20 05:18:13 +02:00
access_parse_delete ( AccessRules , Host , Query ) - >
2004-04-26 17:38:07 +02:00
lists : foreach (
fun ( { access , Name , _ Rules } = AccessRule ) - >
ID = term_to_id ( AccessRule ) ,
case lists : member ( { " selected " , ID } , Query ) of
true - >
mnesia : transaction (
fun ( ) - >
2005-06-20 05:18:13 +02:00
mnesia : delete ( { config , { access , Name , Host } } )
2004-04-26 17:38:07 +02:00
end ) ;
_ - >
ok
end
end , AccessRules ) ,
ok .
access_rule_to_xhtml ( Rules ) - >
Text = lists : flatmap (
2007-12-07 02:40:24 +01:00
fun ( { Access , ACL } = _ Rule ) - >
2007-12-26 13:21:52 +01:00
SAccess = element_to_list ( Access ) ,
2004-04-26 17:38:07 +02:00
SACL = atom_to_list ( ACL ) ,
2009-01-12 22:48:34 +01:00
SAccess ++ " \s \t " ++ SACL ++ " \n "
2004-04-26 17:38:07 +02:00
end , Rules ) ,
? XAC ( " textarea " , [ { " name " , " rules " } ,
{ " rows " , " 16 " } ,
{ " cols " , " 80 " } ] ,
Text ) .
parse_access_rule ( Text ) - >
Strings = string : tokens ( Text , " \r \n " ) ,
case catch lists : flatmap (
fun ( String ) - >
case string : tokens ( String , " \s \t " ) of
[ Access , ACL ] - >
2007-12-26 13:21:52 +01:00
[ { list_to_element ( Access ) , list_to_atom ( ACL ) } ] ;
2004-04-26 17:38:07 +02:00
[ ] - >
[ ]
end
end , Strings ) of
{ 'EXIT' , _ Reason } - >
error ;
Rs - >
{ ok , Rs }
end .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% list_vhosts
2004-04-26 17:38:07 +02:00
2009-06-23 23:00:43 +02:00
list_vhosts ( Lang , JID ) - >
2005-07-29 22:34:57 +02:00
Hosts = ? MYHOSTS ,
2009-06-23 23:00:43 +02:00
HostsAllowed = lists : filter (
fun ( Host ) - >
2010-04-27 23:16:48 +02:00
is_acl_match ( Host , [ configure , webadmin_view ] , JID )
2009-06-23 23:00:43 +02:00
end ,
Hosts
) ,
list_vhosts2 ( Lang , HostsAllowed ) .
list_vhosts2 ( Lang , Hosts ) - >
2005-07-29 22:34:57 +02:00
SHosts = lists : sort ( Hosts ) ,
[ ? XE ( " table " ,
[ ? XE ( " thead " ,
[ ? XE ( " tr " ,
[ ? XCT ( " td " , " Host " ) ,
2006-02-18 20:56:16 +01:00
? XCT ( " td " , " Registered Users " ) ,
? XCT ( " td " , " Online Users " )
2005-07-29 22:34:57 +02:00
] ) ] ) ,
? XE ( " tbody " ,
lists : map (
fun ( Host ) - >
OnlineUsers =
length ( ejabberd_sm : get_vh_session_list ( Host ) ) ,
RegisteredUsers =
2007-05-12 20:14:21 +02:00
ejabberd_auth : get_vh_registered_users_number ( Host ) ,
2005-07-29 22:34:57 +02:00
? XE ( " tr " ,
[ ? XE ( " td " , [ ? AC ( " ../server/ " ++ Host ++ " / " , Host ) ] ) ,
2009-02-13 23:13:34 +01:00
? XC ( " td " , pretty_string_int ( RegisteredUsers ) ) ,
? XC ( " td " , pretty_string_int ( OnlineUsers ) )
2005-07-29 22:34:57 +02:00
] )
end , SHosts )
) ] ) ] .
2004-04-26 17:38:07 +02:00
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% list_users
2004-04-26 17:38:07 +02:00
2005-09-29 03:04:24 +02:00
list_users ( Host , Query , Lang , URLFunc ) - >
2006-07-07 10:06:12 +02:00
Res = list_users_parse_query ( Query , Host ) ,
2005-06-20 05:18:13 +02:00
Users = ejabberd_auth : get_vh_registered_users ( Host ) ,
2005-04-17 20:08:34 +02:00
SUsers = lists : sort ( [ { S , U } | | { U , S } < - Users ] ) ,
2004-10-05 21:31:17 +02:00
FUsers =
case length ( SUsers ) of
N when N =< 100 - >
2009-12-09 18:46:51 +01:00
[ list_given_users ( Host , SUsers , " ../ " , Lang , URLFunc ) ] ;
2004-10-05 21:31:17 +02:00
N - >
NParts = trunc ( math : sqrt ( N * 0 . 618 ) ) + 1 ,
M = trunc ( N / NParts ) + 1 ,
lists : flatmap (
fun ( K ) - >
L = K + M - 1 ,
2007-12-07 02:40:24 +01:00
%%Node = integer_to_list(K) ++ "-" ++ integer_to_list(L),
2005-04-17 20:08:34 +02:00
Last = if L < N - > su_to_list ( lists : nth ( L , SUsers ) ) ;
true - > su_to_list ( lists : last ( SUsers ) )
2004-10-05 21:31:17 +02:00
end ,
Name =
2005-04-17 20:08:34 +02:00
su_to_list ( lists : nth ( K , SUsers ) ) ++
[ $\s , 226 , 128 , 148 , $\s ] ++
2004-10-05 21:31:17 +02:00
Last ,
2005-09-29 03:04:24 +02:00
[ ? AC ( URLFunc ( { user_diapason , K , L } ) , Name ) , ? BR ]
2004-10-05 21:31:17 +02:00
end , lists : seq ( 1 , N , M ) )
end ,
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-10-05 21:31:17 +02:00
nothing - > [ ]
end ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-10-05 21:31:17 +02:00
[ ? XE ( " table " ,
[ ? XE ( " tr " ,
[ ? XC ( " td " , ? T ( " User " ) ++ " : " ) ,
2006-07-07 10:06:12 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " newusername " , " " ) ] ) ,
? XE ( " td " , [ ? C ( [ " @ " , Host ] ) ] )
2004-10-05 21:31:17 +02:00
] ) ,
? XE ( " tr " ,
[ ? XC ( " td " , ? T ( " Password " ) ++ " : " ) ,
2006-07-07 10:06:12 +02:00
? XE ( " td " , [ ? INPUT ( " password " , " newuserpassword " , " " ) ] ) ,
? X ( " td " )
2004-10-05 21:31:17 +02:00
] ) ,
? XE ( " tr " ,
[ ? X ( " td " ) ,
? XAE ( " td " , [ { " class " , " alignright " } ] ,
2006-07-07 10:06:12 +02:00
[ ? INPUTT ( " submit " , " addnewuser " , " Add User " ) ] ) ,
? X ( " td " )
2004-10-05 21:31:17 +02:00
] ) ] ) ,
? P ] ++
FUsers ) ] .
2006-07-07 10:06:12 +02:00
%% Parse user creation query and try register:
list_users_parse_query ( Query , Host ) - >
2004-10-05 21:31:17 +02:00
case lists : keysearch ( " addnewuser " , 1 , Query ) of
{ value , _ } - >
2006-07-07 10:06:12 +02:00
{ value , { _ , Username } } =
2004-10-05 21:31:17 +02:00
lists : keysearch ( " newusername " , 1 , Query ) ,
{ value , { _ , Password } } =
lists : keysearch ( " newuserpassword " , 1 , Query ) ,
2006-07-07 10:06:12 +02:00
case jlib : string_to_jid ( Username ++ " @ " ++ Host ) of
2004-10-05 21:31:17 +02:00
error - >
error ;
2005-04-19 16:25:31 +02:00
#jid { user = User , server = Server } - >
2005-04-20 01:10:22 +02:00
case ejabberd_auth : try_register ( User , Server , Password ) of
{ error , _ Reason } - >
error ;
_ - >
ok
end
2004-10-05 21:31:17 +02:00
end ;
false - >
nothing
2004-04-26 17:38:07 +02:00
end .
2005-04-19 16:25:31 +02:00
2005-09-29 03:04:24 +02:00
list_users_in_diapason ( Host , Diap , Lang , URLFunc ) - >
2005-06-20 05:18:13 +02:00
Users = ejabberd_auth : get_vh_registered_users ( Host ) ,
2005-04-17 20:08:34 +02:00
SUsers = lists : sort ( [ { S , U } | | { U , S } < - Users ] ) ,
2004-04-26 17:38:07 +02:00
{ ok , [ S1 , S2 ] } = regexp : split ( Diap , " - " ) ,
N1 = list_to_integer ( S1 ) ,
N2 = list_to_integer ( S2 ) ,
Sub = lists : sublist ( SUsers , N1 , N2 - N1 + 1 ) ,
2009-12-09 18:46:51 +01:00
[ list_given_users ( Host , Sub , " ../../ " , Lang , URLFunc ) ] .
2004-10-05 21:31:17 +02:00
2009-12-09 18:46:51 +01:00
list_given_users ( Host , Users , Prefix , Lang , URLFunc ) - >
ModLast = get_lastactivity_module ( Host ) ,
2010-01-12 13:02:50 +01:00
ModOffline = get_offlinemsg_module ( Host ) ,
2004-10-05 21:31:17 +02:00
? XE ( " table " ,
[ ? XE ( " thead " ,
[ ? XE ( " tr " ,
[ ? XCT ( " td " , " User " ) ,
2006-02-18 20:56:16 +01:00
? XCT ( " td " , " Offline Messages " ) ,
2004-10-05 21:31:17 +02:00
? XCT ( " td " , " Last Activity " ) ] ) ] ) ,
? XE ( " tbody " ,
lists : map (
2007-12-07 02:40:24 +01:00
fun ( _ SU = { Server , User } ) - >
2005-04-17 20:08:34 +02:00
US = { User , Server } ,
2010-01-12 13:02:50 +01:00
QueueLenStr = get_offlinemsg_length ( ModOffline , User , Server ) ,
2005-09-29 03:04:24 +02:00
FQueueLen = [ ? AC ( URLFunc ( { users_queue , Prefix ,
User , Server } ) ,
2010-01-12 13:02:50 +01:00
QueueLenStr ) ] ,
2004-10-05 21:31:17 +02:00
FLast =
2005-04-17 20:08:34 +02:00
case ejabberd_sm : get_user_resources ( User , Server ) of
2004-10-05 21:31:17 +02:00
[ ] - >
2009-12-09 18:46:51 +01:00
case ModLast : get_last_info ( User , Server ) of
not_found - >
2004-10-05 21:31:17 +02:00
? T ( " Never " ) ;
2009-12-09 18:46:51 +01:00
{ ok , Shift , _ Status } - >
2004-10-05 21:31:17 +02:00
TimeStamp = { Shift div 1000000 ,
Shift rem 1000000 ,
0 } ,
{ { Year , Month , Day } , { Hour , Minute , Second } } =
calendar : now_to_local_time ( TimeStamp ) ,
lists : flatten (
io_lib : format (
" ~w - ~.2.0w - ~.2.0w ~.2.0w : ~.2.0w : ~.2.0w " ,
[ Year , Month , Day , Hour , Minute , Second ] ) )
end ;
_ - >
? T ( " Online " )
end ,
? XE ( " tr " ,
2005-11-22 19:25:02 +01:00
[ ? XE ( " td " ,
[ ? AC ( URLFunc ( { user , Prefix ,
ejabberd_http : url_encode ( User ) ,
Server } ) ,
us_to_list ( US ) ) ] ) ,
2004-10-05 21:31:17 +02:00
? XE ( " td " , FQueueLen ) ,
? XC ( " td " , FLast ) ] )
end , Users )
) ] ) .
2004-04-26 17:38:07 +02:00
2010-01-12 13:02:50 +01:00
get_offlinemsg_length ( ModOffline , User , Server ) - >
case ModOffline of
none - > " disabled " ;
_ - > pretty_string_int ( ModOffline : get_queue_length ( User , Server ) )
end .
get_offlinemsg_module ( Server ) - >
case [ mod_offline , mod_offline_odbc ] -- gen_mod : loaded_modules ( Server ) of
[ mod_offline , mod_offline_odbc ] - > none ;
[ mod_offline_odbc ] - > mod_offline ;
[ mod_offline ] - > mod_offline_odbc
end .
2009-12-09 18:46:51 +01:00
get_lastactivity_module ( Server ) - >
case lists : member ( mod_last , gen_mod : loaded_modules ( Server ) ) of
true - > mod_last ;
_ - > mod_last_odbc
end .
2009-12-09 18:47:02 +01:00
get_lastactivity_menuitem_list ( Server ) - >
case get_lastactivity_module ( Server ) of
mod_last - > [ { " last-activity " , " Last Activity " } ] ;
mod_last_odbc - > [ ]
end .
2009-12-09 18:46:51 +01:00
2005-04-17 20:08:34 +02:00
us_to_list ( { User , Server } ) - >
jlib : jid_to_string ( { User , Server , " " } ) .
su_to_list ( { Server , User } ) - >
jlib : jid_to_string ( { User , Server , " " } ) .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% get_stats
2004-04-26 17:38:07 +02:00
2005-06-20 05:18:13 +02:00
get_stats ( global , Lang ) - >
2007-06-28 10:31:46 +02:00
OnlineUsers = mnesia : table_info ( session , size ) ,
2004-04-26 17:38:07 +02:00
RegisteredUsers = mnesia : table_info ( passwd , size ) ,
S2SConns = ejabberd_s2s : dirty_get_connections ( ) ,
S2SConnections = length ( S2SConns ) ,
S2SServers = length ( lists : usort ( [ element ( 2 , C ) | | C < - S2SConns ] ) ) ,
[ ? XAE ( " table " , [ ] ,
[ ? XE ( " tbody " ,
2006-02-18 20:56:16 +01:00
[ ? XE ( " tr " , [ ? XCT ( " td " , " Registered Users: " ) ,
2009-02-13 23:13:34 +01:00
? XC ( " td " , pretty_string_int ( RegisteredUsers ) ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Online Users: " ) ,
2009-02-13 23:13:34 +01:00
? XC ( " td " , pretty_string_int ( OnlineUsers ) ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Outgoing s2s Connections: " ) ,
2009-02-13 23:13:34 +01:00
? XC ( " td " , pretty_string_int ( S2SConnections ) ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Outgoing s2s Servers: " ) ,
2009-02-13 23:13:34 +01:00
? XC ( " td " , pretty_string_int ( S2SServers ) ) ] )
2004-04-26 17:38:07 +02:00
] )
2005-06-20 05:18:13 +02:00
] ) ] ;
get_stats ( Host , Lang ) - >
OnlineUsers = length ( ejabberd_sm : get_vh_session_list ( Host ) ) ,
2007-05-12 20:14:21 +02:00
RegisteredUsers = ejabberd_auth : get_vh_registered_users_number ( Host ) ,
2005-06-20 05:18:13 +02:00
[ ? XAE ( " table " , [ ] ,
[ ? XE ( " tbody " ,
2006-02-18 20:56:16 +01:00
[ ? XE ( " tr " , [ ? XCT ( " td " , " Registered Users: " ) ,
2009-02-13 23:13:34 +01:00
? XC ( " td " , pretty_string_int ( RegisteredUsers ) ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Online Users: " ) ,
2009-02-13 23:13:34 +01:00
? XC ( " td " , pretty_string_int ( OnlineUsers ) ) ] )
2005-06-20 05:18:13 +02:00
] )
2004-04-26 17:38:07 +02:00
] ) ] .
2004-05-04 21:47:24 +02:00
2005-06-20 05:18:13 +02:00
list_online_users ( Host , _ Lang ) - >
2007-12-07 02:40:24 +01:00
Users = [ { S , U } | | { U , S , _ R } < - ejabberd_sm : get_vh_session_list ( Host ) ] ,
2004-10-05 21:31:17 +02:00
SUsers = lists : usort ( Users ) ,
lists : flatmap (
2007-12-07 02:40:24 +01:00
fun ( { _ S , U } = SU ) - >
2005-11-22 19:25:02 +01:00
[ ? AC ( " ../user/ " ++ ejabberd_http : url_encode ( U ) ++ " / " ,
su_to_list ( SU ) ) ,
? BR ]
2004-10-05 21:31:17 +02:00
end , SUsers ) .
2005-06-20 05:18:13 +02:00
user_info ( User , Server , Query , Lang ) - >
2007-08-23 02:51:54 +02:00
LServer = jlib : nameprep ( Server ) ,
US = { jlib : nodeprep ( User ) , LServer } ,
2005-04-17 20:08:34 +02:00
Res = user_parse_query ( User , Server , Query ) ,
Resources = ejabberd_sm : get_user_resources ( User , Server ) ,
2004-05-04 21:47:24 +02:00
FResources =
case Resources of
[ ] - >
[ ? CT ( " None " ) ] ;
_ - >
[ ? XE ( " ul " ,
lists : map ( fun ( R ) - >
2008-12-26 13:44:54 +01:00
FIP = case ejabberd_sm : get_user_info (
2007-06-10 20:13:37 +02:00
User , Server , R ) of
2008-12-26 13:44:54 +01:00
offline - >
2007-06-10 20:13:37 +02:00
" " ;
2010-01-04 19:59:01 +01:00
Info when is_list ( Info ) - >
Node = proplists : get_value ( node , Info ) ,
Conn = proplists : get_value ( conn , Info ) ,
{ IP , Port } = proplists : get_value ( ip , Info ) ,
2008-12-26 13:44:54 +01:00
ConnS = case Conn of
c2s - > " plain " ;
c2s_tls - > " tls " ;
c2s_compressed - > " zlib " ;
2009-08-31 18:29:25 +02:00
c2s_compressed_tls - > " tls+zlib " ;
2008-12-26 13:44:54 +01:00
http_bind - > " http-bind " ;
http_poll - > " http-poll "
end ,
2007-06-10 20:13:37 +02:00
" ( " ++
2008-12-26 13:44:54 +01:00
ConnS ++ " :// " ++
2007-06-10 20:13:37 +02:00
inet_parse : ntoa ( IP ) ++
" : " ++
integer_to_list ( Port )
2008-12-26 13:44:54 +01:00
++ " # " ++ atom_to_list ( Node )
2007-06-10 20:13:37 +02:00
++ " ) "
end ,
? LI ( [ ? C ( R ++ FIP ) ] )
2004-05-04 21:47:24 +02:00
end , lists : sort ( Resources ) ) ) ]
end ,
2005-04-17 20:08:34 +02:00
Password = ejabberd_auth : get_password_s ( User , Server ) ,
2004-12-05 21:54:55 +01:00
FPassword = [ ? INPUT ( " password " , " password " , Password ) , ? C ( " " ) ,
2004-05-04 21:47:24 +02:00
? INPUTT ( " submit " , " chpassword " , " Change Password " ) ] ,
2007-08-23 02:51:54 +02:00
UserItems = ejabberd_hooks : run_fold ( webadmin_user , LServer , [ ] ,
[ User , Server , Lang ] ) ,
2010-01-03 01:40:37 +01:00
%% Code copied from list_given_users/5:
ModLast = get_lastactivity_module ( Server ) ,
LastActivity = case ejabberd_sm : get_user_resources ( User , Server ) of
[ ] - >
case ModLast : get_last_info ( User , Server ) of
not_found - >
? T ( " Never " ) ;
{ ok , Shift , _ Status } - >
TimeStamp = { Shift div 1000000 ,
Shift rem 1000000 ,
0 } ,
{ { Year , Month , Day } , { Hour , Minute , Second } } =
calendar : now_to_local_time ( TimeStamp ) ,
lists : flatten (
io_lib : format (
" ~w - ~.2.0w - ~.2.0w ~.2.0w : ~.2.0w : ~.2.0w " ,
[ Year , Month , Day , Hour , Minute , Second ] ) )
end ;
_ - >
? T ( " Online " )
end ,
2005-04-17 20:08:34 +02:00
[ ? XC ( " h1 " , ? T ( " User " ) ++ us_to_list ( US ) ) ] ++
2004-05-04 21:47:24 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-05-04 21:47:24 +02:00
nothing - > [ ]
end ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-05-04 21:47:24 +02:00
[ ? XCT ( " h3 " , " Connected Resources: " ) ] ++ FResources ++
2004-10-05 21:31:17 +02:00
[ ? XCT ( " h3 " , " Password: " ) ] ++ FPassword ++
2010-01-03 01:40:37 +01:00
[ ? XCT ( " h3 " , " Last Activity " ) ] ++ [ ? C ( LastActivity ) ] ++
2007-08-23 02:51:54 +02:00
UserItems ++
[ ? P , ? INPUTT ( " submit " , " removeuser " , " Remove User " ) ] ) ] .
2004-05-04 21:47:24 +02:00
2005-04-17 20:08:34 +02:00
user_parse_query ( User , Server , Query ) - >
2008-10-12 16:16:05 +02:00
lists : foldl ( fun ( { Action , _ Value } , Acc ) when Acc == nothing - >
user_parse_query1 ( Action , User , Server , Query ) ;
( { _ Action , _ Value } , Acc ) - >
Acc
end , nothing , Query ) .
user_parse_query1 ( " password " , _ User , _ Server , _ Query ) - >
nothing ;
user_parse_query1 ( " chpassword " , User , Server , Query ) - >
case lists : keysearch ( " password " , 1 , Query ) of
{ value , { _ , undefined } } - >
error ;
{ value , { _ , Password } } - >
ejabberd_auth : set_password ( User , Server , Password ) ,
ok ;
_ - >
error
end ;
user_parse_query1 ( " removeuser " , User , Server , _ Query ) - >
ejabberd_auth : remove_user ( User , Server ) ,
ok ;
user_parse_query1 ( Action , User , Server , Query ) - >
case ejabberd_hooks : run_fold ( webadmin_user_parse_query , Server , [ ] , [ Action , User , Server , Query ] ) of
[ ] - > nothing ;
Res - > Res
2004-10-05 21:31:17 +02:00
end .
2005-06-20 05:18:13 +02:00
list_last_activity ( Host , Lang , Integral , Period ) - >
2005-05-09 01:39:46 +02:00
{ MegaSecs , Secs , _ MicroSecs } = now ( ) ,
TimeStamp = MegaSecs * 1000000 + Secs ,
case Period of
" all " - >
TS = 0 ,
Days = infinity ;
" year " - >
TS = TimeStamp - 366 * 86400 ,
Days = 366 ;
_ - >
TS = TimeStamp - 31 * 86400 ,
Days = 31
end ,
case catch mnesia : dirty_select (
2005-06-20 05:18:13 +02:00
last_activity , [ { { last_activity , { '_' , Host } , '$1' , '_' } ,
2005-05-09 01:39:46 +02:00
[ { '>' , '$1' , TS } ] ,
[ { 'trunc' , { '/' ,
{ '-' , TimeStamp , '$1' } ,
86400 } } ] } ] ) of
{ 'EXIT' , _ Reason } - >
[ ] ;
Vals - >
Hist = histogram ( Vals , Integral ) ,
2005-05-28 00:52:50 +02:00
if
Hist == [ ] - >
2006-02-18 20:56:16 +01:00
[ ? CT ( " No Data " ) ] ;
2005-05-28 00:52:50 +02:00
true - >
Left = if
Days == infinity - >
0 ;
true - >
Days - length ( Hist )
end ,
Tail = if
Integral - >
lists : duplicate ( Left , lists : last ( Hist ) ) ;
true - >
lists : duplicate ( Left , 0 )
end ,
Max = lists : max ( Hist ) ,
[ ? XAE ( " ol " ,
[ { " id " , " lastactivity " } , { " start " , " 0 " } ] ,
[ ? XAE ( " li " ,
[ { " style " ,
" width: " ++ integer_to_list (
trunc ( 90 * V / Max ) ) ++ " %; " } ] ,
2009-02-13 23:13:34 +01:00
[ { xmlcdata , pretty_string_int ( V ) } ] )
2005-05-28 00:52:50 +02:00
| | V < - Hist ++ Tail ] ) ]
end
2005-05-09 01:39:46 +02:00
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 .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% get_nodes
2004-08-03 00:17:05 +02:00
2004-05-09 20:38:49 +02:00
get_nodes ( Lang ) - >
RunningNodes = mnesia : system_info ( running_db_nodes ) ,
StoppedNodes = lists : usort ( mnesia : system_info ( db_nodes ) ++
mnesia : system_info ( extra_db_nodes ) ) --
RunningNodes ,
2004-05-14 16:46:53 +02:00
FRN = if
RunningNodes == [ ] - >
? CT ( " None " ) ;
true - >
? XE ( " ul " ,
lists : map (
fun ( N ) - >
S = atom_to_list ( N ) ,
? LI ( [ ? AC ( " ../node/ " ++ S ++ " / " , S ) ] )
end , lists : sort ( RunningNodes ) ) )
end ,
FSN = if
StoppedNodes == [ ] - >
? CT ( " None " ) ;
true - >
? XE ( " ul " ,
lists : map (
fun ( N ) - >
S = atom_to_list ( N ) ,
? LI ( [ ? C ( S ) ] )
end , lists : sort ( StoppedNodes ) ) )
end ,
2004-07-13 13:28:28 +02:00
[ ? XCT ( " h1 " , " Nodes " ) ,
? XCT ( " h3 " , " Running Nodes " ) ,
2004-05-14 16:46:53 +02:00
FRN ,
2004-07-13 13:28:28 +02:00
? XCT ( " h3 " , " Stopped Nodes " ) ,
2004-05-14 16:46:53 +02:00
FSN ] .
search_running_node ( SNode ) - >
search_running_node ( SNode , mnesia : system_info ( running_db_nodes ) ) .
2004-05-09 20:38:49 +02:00
2004-05-14 16:46:53 +02:00
search_running_node ( _ , [ ] ) - >
false ;
search_running_node ( SNode , [ Node | Nodes ] ) - >
case atom_to_list ( Node ) of
SNode - >
Node ;
_ - >
search_running_node ( SNode , Nodes )
end .
2004-05-09 20:38:49 +02:00
2005-06-20 05:18:13 +02:00
get_node ( global , Node , [ ] , Query , Lang ) - >
2004-05-22 21:48:35 +02:00
Res = node_parse_query ( Node , Query ) ,
2008-10-12 15:58:05 +02:00
Base = get_base_path ( global , Node ) ,
MenuItems2 = make_menu_items ( global , Node , Base , Lang ) ,
2004-07-13 13:28:28 +02:00
[ ? XC ( " h1 " , ? T ( " Node " ) ++ atom_to_list ( Node ) ) ] ++
2004-05-22 21:48:35 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-05-22 21:48:35 +02:00
nothing - > [ ]
end ++
[ ? XE ( " ul " ,
2008-10-12 15:58:05 +02:00
[ ? LI ( [ ? ACT ( Base ++ " db/ " , " Database " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " backup/ " , " Backup " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " ports/ " , " Listened Ports " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " stats/ " , " Statistics " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " update/ " , " Update " ) ] )
2007-08-23 02:51:54 +02:00
] ++ MenuItems2 ) ,
2005-11-26 19:56:39 +01:00
? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-05-22 21:48:35 +02:00
[ ? INPUTT ( " submit " , " restart " , " Restart " ) ,
? C ( " " ) ,
? INPUTT ( " submit " , " stop " , " Stop " ) ] )
] ;
2004-05-14 16:46:53 +02:00
2007-12-07 02:40:24 +01:00
get_node ( Host , Node , [ ] , _ Query , Lang ) - >
2008-10-12 15:58:05 +02:00
Base = get_base_path ( Host , Node ) ,
2009-02-02 11:12:44 +01:00
MenuItems2 = make_menu_items ( Host , Node , Base , Lang ) ,
2005-06-20 05:18:13 +02:00
[ ? XC ( " h1 " , ? T ( " Node " ) ++ atom_to_list ( Node ) ) ,
? XE ( " ul " ,
2008-10-12 15:58:05 +02:00
[ ? LI ( [ ? ACT ( Base ++ " modules/ " , " Modules " ) ] ) ] ++ MenuItems2 )
2005-06-20 05:18:13 +02:00
] ;
get_node ( global , Node , [ " db " ] , Query , Lang ) - >
2004-05-14 16:46:53 +02:00
case rpc : call ( Node , mnesia , system_info , [ tables ] ) of
{ badrpc , _ Reason } - >
2006-02-18 20:56:16 +01:00
[ ? XCT ( " h1 " , " RPC Call Error " ) ] ;
2004-05-14 16:46:53 +02:00
Tables - >
2009-01-12 22:48:34 +01:00
ResS = case node_db_parse_query ( Node , Tables , Query ) of
nothing - > [ ] ;
ok - > [ ? XREST ( " Submitted " ) ]
end ,
2004-05-14 16:46:53 +02:00
STables = lists : sort ( Tables ) ,
Rows = lists : map (
fun ( Table ) - >
STable = atom_to_list ( Table ) ,
2004-05-16 22:13:38 +02:00
TInfo =
case rpc : call ( Node ,
mnesia ,
table_info ,
[ Table , all ] ) of
{ badrpc , _ } - >
[ ] ;
I - >
I
end ,
{ Type , Size , Memory } =
case { lists : keysearch ( storage_type , 1 , TInfo ) ,
lists : keysearch ( size , 1 , TInfo ) ,
lists : keysearch ( memory , 1 , TInfo ) } of
{ { value , { storage_type , T } } ,
{ value , { size , S } } ,
{ value , { memory , M } } } - >
{ T , S , M } ;
_ - >
{ unknown , 0 , 0 }
end ,
2004-05-14 16:46:53 +02:00
? XE ( " tr " ,
[ ? XC ( " td " , STable ) ,
? XE ( " td " , [ db_storage_select (
2004-05-16 22:13:38 +02:00
STable , Type , Lang ) ] ) ,
? XAC ( " td " , [ { " class " , " alignright " } ] ,
2009-02-13 23:13:34 +01:00
pretty_string_int ( Size ) ) ,
2004-05-16 22:13:38 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
2009-02-13 23:13:34 +01:00
pretty_string_int ( Memory ) )
2004-05-14 16:46:53 +02:00
] )
end , STables ) ,
2006-02-18 20:56:16 +01:00
[ ? XC ( " h1 " , ? T ( " Database Tables at " ) ++ atom_to_list ( Node ) ) ] ++
2009-01-12 22:48:34 +01:00
ResS ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-05-16 22:13:38 +02:00
[ ? XAE ( " table " , [ ] ,
[ ? XE ( " thead " ,
[ ? XE ( " tr " ,
[ ? XCT ( " td " , " Name " ) ,
? XCT ( " td " , " Storage Type " ) ,
2009-02-13 23:13:34 +01:00
? XCT ( " td " , " Elements " ) , %% Elements/items/records inserted in the table
? XCT ( " td " , " Memory " ) %% Words or Bytes allocated to the table on this node
2004-05-16 22:13:38 +02:00
] ) ] ) ,
? XE ( " tbody " ,
Rows ++
[ ? XE ( " tr " ,
[ ? XAE ( " td " , [ { " colspan " , " 4 " } ,
{ " class " , " alignright " } ] ,
[ ? INPUTT ( " submit " , " submit " ,
" Submit " ) ] )
] ) ]
) ] ) ] ) ]
2004-05-14 16:46:53 +02:00
end ;
2005-06-20 05:18:13 +02:00
get_node ( global , Node , [ " backup " ] , Query , Lang ) - >
2009-12-03 16:59:01 +01:00
HomeDirRaw = case { os : getenv ( " HOME " ) , os : type ( ) } of
{ EnvHome , _ } when is_list ( EnvHome ) - > EnvHome ;
{ false , win32 } - > " C:/ " ;
{ false , { win32 , _ Osname } } - > " C:/ " ;
{ false , _ } - > " /tmp/ "
end ,
HomeDir = filename : nativename ( HomeDirRaw ) ,
2009-01-12 22:48:34 +01:00
ResS = case node_backup_parse_query ( Node , Query ) of
nothing - > [ ] ;
ok - > [ ? XREST ( " Submitted " ) ] ;
{ error , Error } - > [ ? XRES ( ? T ( " Error " ) ++ " : " ++ io_lib : format ( " ~p " , [ Error ] ) ) ]
end ,
[ ? XC ( " h1 " , ? T ( " Backup of " ) ++ atom_to_list ( Node ) ) ] ++
ResS ++
2009-04-08 21:04:13 +02:00
[ ? XCT ( " p " , " Please note that these options will only backup the builtin Mnesia database. If you are using the ODBC module, you also need to backup your SQL database separately. " ) ,
2005-11-26 19:56:39 +01:00
? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-05-16 22:13:38 +02:00
[ ? XAE ( " table " , [ ] ,
[ ? XE ( " tbody " ,
[ ? XE ( " tr " ,
2006-02-18 20:56:16 +01:00
[ ? XCT ( " td " , " Store binary backup: " ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " storepath " ,
2009-08-07 11:52:45 +02:00
filename : join ( HomeDir , " ejabberd.backup " ) ) ] ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUTT ( " submit " , " store " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
2006-02-18 20:56:16 +01:00
[ ? XCT ( " td " , " Restore binary backup immediately: " ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " restorepath " ,
2009-08-07 11:52:45 +02:00
filename : join ( HomeDir , " ejabberd.backup " ) ) ] ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUTT ( " submit " , " restore " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
[ ? XCT ( " td " ,
2006-02-18 20:56:16 +01:00
" Restore binary backup after next ejabberd restart (requires less memory): " ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " fallbackpath " ,
2009-08-07 11:52:45 +02:00
filename : join ( HomeDir , " ejabberd.backup " ) ) ] ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUTT ( " submit " , " fallback " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
2006-02-18 20:56:16 +01:00
[ ? XCT ( " td " , " Store plain text backup: " ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " dumppath " ,
2009-08-07 11:52:45 +02:00
filename : join ( HomeDir , " ejabberd.dump " ) ) ] ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUTT ( " submit " , " dump " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
2006-02-18 20:56:16 +01:00
[ ? XCT ( " td " , " Restore plain text backup immediately: " ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " loadpath " ,
2009-08-07 11:52:45 +02:00
filename : join ( HomeDir , " ejabberd.dump " ) ) ] ) ,
2004-05-16 22:13:38 +02:00
? XE ( " td " , [ ? INPUTT ( " submit " , " load " ,
" OK " ) ] )
2009-08-07 11:52:45 +02:00
] ) ,
? XE ( " tr " ,
2009-09-23 19:25:04 +02:00
[ ? XCT ( " td " , " Import users data from a PIEFXIS file (XEP-0227): " ) ,
2009-08-07 11:52:45 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " import_piefxis_filepath " ,
filename : join ( HomeDir , " users.xml " ) ) ] ) ,
? XE ( " td " , [ ? INPUTT ( " submit " , " import_piefxis_file " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
2009-09-23 19:25:04 +02:00
[ ? XCT ( " td " , " Export data of all users in the server to PIEFXIS files (XEP-0227): " ) ,
2009-08-07 11:52:45 +02:00
? XE ( " td " , [ ? INPUT ( " text " , " export_piefxis_dirpath " ,
HomeDir ) ] ) ,
? XE ( " td " , [ ? INPUTT ( " submit " , " export_piefxis_dir " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
2009-09-23 19:25:04 +02:00
[ ? XE ( " td " , [ ? CT ( " Export data of users in a host to PIEFXIS files (XEP-0227): " ) ,
2009-08-12 12:42:08 +02:00
? C ( " " ) ,
2009-08-07 11:52:45 +02:00
? INPUT ( " text " , " export_piefxis_host_dirhost " , ? MYNAME ) ] ) ,
? XE ( " td " , [ ? INPUT ( " text " , " export_piefxis_host_dirpath " , HomeDir ) ] ) ,
? XE ( " td " , [ ? INPUTT ( " submit " , " export_piefxis_host_dir " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
[ ? XCT ( " td " , " Import user data from jabberd14 spool file: " ) ,
? XE ( " td " , [ ? INPUT ( " text " , " import_filepath " ,
filename : join ( HomeDir , " user1.xml " ) ) ] ) ,
? XE ( " td " , [ ? INPUTT ( " submit " , " import_file " ,
" OK " ) ] )
] ) ,
? XE ( " tr " ,
[ ? XCT ( " td " , " Import users data from jabberd14 spool directory: " ) ,
? XE ( " td " , [ ? INPUT ( " text " , " import_dirpath " ,
" /var/spool/jabber/ " ) ] ) ,
? XE ( " td " , [ ? INPUTT ( " submit " , " import_dir " ,
" OK " ) ] )
2004-05-16 22:13:38 +02:00
] )
] )
] ) ] ) ] ;
2005-06-20 05:18:13 +02:00
get_node ( global , Node , [ " ports " ] , Query , Lang ) - >
2004-06-17 23:29:24 +02:00
Ports = rpc : call ( Node , ejabberd_config , get_local_option , [ listen ] ) ,
Res = case catch node_ports_parse_query ( Node , Ports , Query ) of
submitted - >
ok ;
{ 'EXIT' , _ Reason } - >
error ;
2009-01-12 21:03:02 +01:00
{ is_added , ok } - >
ok ;
{ is_added , { error , Reason } } - >
{ error , io_lib : format ( " ~p " , [ Reason ] ) } ;
2004-06-17 23:29:24 +02:00
_ - >
nothing
end ,
2009-01-12 21:03:02 +01:00
%% TODO: This sorting does not work when [{{Port, IP}, Module, Opts}]
2004-06-17 23:29:24 +02:00
NewPorts = lists : sort (
rpc : call ( Node , ejabberd_config , get_local_option , [ listen ] ) ) ,
2009-01-07 01:55:02 +01:00
H1String = ? T ( " Listened Ports at " ) ++ atom_to_list ( Node ) ,
? H1GL ( H1String , " listened " , " Listening Ports " ) ++
2004-06-17 23:29:24 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
{ error , ReasonT } - > [ ? XRES ( ? T ( " Error " ) ++ " : " ++ ReasonT ) ] ;
2004-06-17 23:29:24 +02:00
nothing - > [ ]
end ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2004-06-17 23:29:24 +02:00
[ node_ports_to_xhtml ( NewPorts , Lang ) ] )
] ;
2005-06-20 05:18:13 +02:00
get_node ( Host , Node , [ " modules " ] , Query , Lang ) when is_list ( Host ) - >
2005-08-07 00:23:53 +02:00
Modules = rpc : call ( Node , gen_mod , loaded_modules_with_opts , [ Host ] ) ,
2005-06-20 05:18:13 +02:00
Res = case catch node_modules_parse_query ( Host , Node , Modules , Query ) of
2005-05-23 02:30:29 +02:00
submitted - >
ok ;
{ 'EXIT' , Reason } - >
? INFO_MSG ( " ~p ~n " , [ Reason ] ) ,
error ;
_ - >
nothing
end ,
2005-06-20 05:18:13 +02:00
NewModules = lists : sort (
rpc : call ( Node , gen_mod , loaded_modules_with_opts , [ Host ] ) ) ,
2009-01-07 01:55:02 +01:00
H1String = ? T ( " Modules at " ) ++ atom_to_list ( Node ) ,
? H1GL ( H1String , " modoverview " , " Modules Overview " ) ++
2005-05-23 02:30:29 +02:00
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2005-05-23 02:30:29 +02:00
nothing - > [ ]
end ++
2005-11-26 19:56:39 +01:00
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2005-05-23 02:30:29 +02:00
[ node_modules_to_xhtml ( NewModules , Lang ) ] )
] ;
2007-12-07 02:40:24 +01:00
get_node ( global , Node , [ " stats " ] , _ Query , Lang ) - >
2004-05-22 21:48:35 +02:00
UpTime = rpc : call ( Node , erlang , statistics , [ wall_clock ] ) ,
UpTimeS = io_lib : format ( " ~.3f " , [ element ( 1 , UpTime ) / 1000 ] ) ,
CPUTime = rpc : call ( Node , erlang , statistics , [ runtime ] ) ,
CPUTimeS = io_lib : format ( " ~.3f " , [ element ( 1 , CPUTime ) / 1000 ] ) ,
2007-06-28 10:31:46 +02:00
OnlineUsers = mnesia : table_info ( session , size ) ,
2009-01-12 19:41:46 +01:00
TransactionsCommitted =
2004-05-22 21:48:35 +02:00
rpc : call ( Node , mnesia , system_info , [ transaction_commits ] ) ,
TransactionsAborted =
rpc : call ( Node , mnesia , system_info , [ transaction_failures ] ) ,
TransactionsRestarted =
rpc : call ( Node , mnesia , system_info , [ transaction_restarts ] ) ,
TransactionsLogged =
rpc : call ( Node , mnesia , system_info , [ transaction_log_writes ] ) ,
2006-02-18 20:56:16 +01:00
[ ? XC ( " h1 " , io_lib : format ( ? T ( " Statistics of ~p " ) , [ Node ] ) ) ,
2004-05-22 21:48:35 +02:00
? XAE ( " table " , [ ] ,
[ ? XE ( " tbody " ,
2006-02-18 20:56:16 +01:00
[ ? XE ( " tr " , [ ? XCT ( " td " , " Uptime: " ) ,
2004-05-22 21:48:35 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
UpTimeS ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " CPU Time: " ) ,
2004-05-22 21:48:35 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
CPUTimeS ) ] ) ,
2007-06-28 10:31:46 +02:00
? XE ( " tr " , [ ? XCT ( " td " , " Online Users: " ) ,
2004-05-22 21:48:35 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
2009-02-13 23:13:34 +01:00
pretty_string_int ( OnlineUsers ) ) ] ) ,
2009-01-12 19:41:46 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Transactions Committed: " ) ,
2004-05-22 21:48:35 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
2009-02-13 23:13:34 +01:00
pretty_string_int ( TransactionsCommitted ) ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Transactions Aborted: " ) ,
2004-05-22 21:48:35 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
2009-02-13 23:13:34 +01:00
pretty_string_int ( TransactionsAborted ) ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Transactions Restarted: " ) ,
2004-05-22 21:48:35 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
2009-02-13 23:13:34 +01:00
pretty_string_int ( TransactionsRestarted ) ) ] ) ,
2006-02-18 20:56:16 +01:00
? XE ( " tr " , [ ? XCT ( " td " , " Transactions Logged: " ) ,
2004-05-22 21:48:35 +02:00
? XAC ( " td " , [ { " class " , " alignright " } ] ,
2009-02-13 23:13:34 +01:00
pretty_string_int ( TransactionsLogged ) ) ] )
2004-05-22 21:48:35 +02:00
] )
] ) ] ;
2006-02-27 05:43:16 +01:00
get_node ( global , Node , [ " update " ] , Query , Lang ) - >
rpc : call ( Node , code , purge , [ ejabberd_update ] ) ,
Res = node_update_parse_query ( Node , Query ) ,
rpc : call ( Node , code , load_file , [ ejabberd_update ] ) ,
2007-12-07 02:40:24 +01:00
{ ok , _ Dir , UpdatedBeams , Script , LowLevelScript , Check } =
2006-02-27 05:43:16 +01:00
rpc : call ( Node , ejabberd_update , update_info , [ ] ) ,
Mods =
case UpdatedBeams of
[ ] - >
? CT ( " None " ) ;
_ - >
2009-05-27 19:28:55 +02:00
BeamsLis =
lists : map (
fun ( Beam ) - >
BeamString = atom_to_list ( Beam ) ,
? LI ( [
? INPUT ( " checkbox " , " selected " , BeamString ) ,
%%?XA("input", [{"checked", ""}, %% Selected by default
%% {"type", "checkbox"},
%% {"name", "selected"},
%% {"value", BeamString}]),
? C ( BeamString ) ] )
end ,
UpdatedBeams ) ,
SelectButtons =
[ ? BR ,
? INPUTATTRS ( " button " , " selectall " , " Select All " ,
[ { " onClick " , " selectAll() " } ] ) ,
? C ( " " ) ,
? INPUTATTRS ( " button " , " unselectall " , " Unselect All " ,
[ { " onClick " , " unSelectAll() " } ] ) ] ,
%%?XE("ul", BeamsLis)
? XAE ( " ul " , [ { " class " , " nolistyle " } ] , BeamsLis ++ SelectButtons )
2006-02-27 05:43:16 +01:00
end ,
FmtScript = ? XC ( " pre " , io_lib : format ( " ~p " , [ Script ] ) ) ,
FmtLowLevelScript = ? XC ( " pre " , io_lib : format ( " ~p " , [ LowLevelScript ] ) ) ,
[ ? XC ( " h1 " , ? T ( " Update " ) ++ atom_to_list ( Node ) ) ] ++
case Res of
2009-01-12 22:48:34 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
2010-10-15 13:11:14 +02:00
{ error , ErrorText } - > [ ? XREST ( " Error: " ++ ErrorText ) ] ;
2006-02-27 05:43:16 +01:00
nothing - > [ ]
end ++
[ ? XAE ( " form " , [ { " action " , " " } , { " method " , " post " } ] ,
2009-01-12 22:48:34 +01:00
[
2006-02-27 05:43:16 +01:00
? XCT ( " h2 " , " Update plan " ) ,
2009-01-12 22:48:34 +01:00
? XCT ( " h3 " , " Modified modules " ) , Mods ,
2006-02-27 05:43:16 +01:00
? XCT ( " h3 " , " Update script " ) , FmtScript ,
? XCT ( " h3 " , " Low level update script " ) , FmtLowLevelScript ,
2009-01-12 22:48:34 +01:00
? XCT ( " h3 " , " Script check " ) , ? XC ( " pre " , atom_to_list ( Check ) ) ,
2009-05-27 19:28:55 +02:00
? BR ,
2009-01-12 22:48:34 +01:00
? INPUTT ( " submit " , " update " , " Update " )
] )
2006-02-27 05:43:16 +01:00
] ;
2005-06-20 05:18:13 +02:00
get_node ( Host , Node , NPath , Query , Lang ) - >
2007-08-23 02:51:54 +02:00
{ Hook , Opts } = case Host of
2007-08-31 18:13:35 +02:00
global - > { webadmin_page_node , [ Node , NPath , Query , Lang ] } ;
Host - > { webadmin_page_hostnode , [ Host , Node , NPath , Query , Lang ] }
2007-08-23 02:51:54 +02:00
end ,
case ejabberd_hooks : run_fold ( Hook , Host , [ ] , Opts ) of
[ ] - > [ ? XC ( " h1 " , " Not Found " ) ] ;
Res - > Res
end .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% node parse
2004-05-14 16:46:53 +02:00
2004-05-22 21:48:35 +02:00
node_parse_query ( Node , Query ) - >
case lists : keysearch ( " restart " , 1 , Query ) of
{ value , _ } - >
case rpc : call ( Node , init , restart , [ ] ) of
{ badrpc , _ Reason } - >
error ;
_ - >
ok
end ;
_ - >
2004-06-17 23:29:24 +02:00
case lists : keysearch ( " stop " , 1 , Query ) of
2004-05-22 21:48:35 +02:00
{ value , _ } - >
2004-06-17 23:29:24 +02:00
case rpc : call ( Node , init , stop , [ ] ) of
2004-05-22 21:48:35 +02:00
{ badrpc , _ Reason } - >
error ;
_ - >
ok
end ;
_ - >
nothing
end
end .
2004-05-14 16:46:53 +02:00
db_storage_select ( ID , Opt , Lang ) - >
? XAE ( " select " , [ { " name " , " table " ++ ID } ] ,
lists : map (
fun ( { O , Desc } ) - >
Sel = if
O == Opt - > [ { " selected " , " selected " } ] ;
true - > [ ]
end ,
? XACT ( " option " ,
Sel ++ [ { " value " , atom_to_list ( O ) } ] ,
Desc )
end , [ { ram_copies , " RAM copy " } ,
{ disc_copies , " RAM and disc copy " } ,
{ disc_only_copies , " Disc only copy " } ,
2009-07-23 17:23:02 +02:00
{ unknown , " Remote copy " } ,
{ delete_content , " Delete content " } ,
{ delete_table , " Delete table " } ] ) ) .
2004-05-09 20:38:49 +02:00
2009-01-12 22:48:34 +01:00
node_db_parse_query ( _ Node , _ Tables , [ { nokey , [ ] } ] ) - >
nothing ;
2004-05-16 22:13:38 +02:00
node_db_parse_query ( Node , Tables , Query ) - >
lists : foreach (
fun ( Table ) - >
STable = atom_to_list ( Table ) ,
case lists : keysearch ( " table " ++ STable , 1 , Query ) of
{ value , { _ , SType } } - >
Type = case SType of
" unknown " - > unknown ;
" ram_copies " - > ram_copies ;
" disc_copies " - > disc_copies ;
" disc_only_copies " - > disc_only_copies ;
2009-07-23 17:23:02 +02:00
" delete_content " - > delete_content ;
" delete_table " - > delete_table ;
2004-05-16 22:13:38 +02:00
_ - > false
end ,
if
Type == false - >
ok ;
2009-07-23 17:23:02 +02:00
Type == delete_content - >
mnesia : clear_table ( Table ) ;
Type == delete_table - >
mnesia : delete_table ( Table ) ;
2004-05-16 22:13:38 +02:00
Type == unknown - >
mnesia : del_table_copy ( Table , Node ) ;
true - >
case mnesia : add_table_copy ( Table , Node , Type ) of
{ aborted , _ } - >
mnesia : change_table_copy_type (
Table , Node , Type ) ;
_ - >
ok
end
end ;
_ - >
ok
end
end , Tables ) ,
ok .
2009-01-12 22:48:34 +01:00
node_backup_parse_query ( _ Node , [ { nokey , [ ] } ] ) - >
nothing ;
2004-05-22 21:48:35 +02:00
node_backup_parse_query ( Node , Query ) - >
lists : foldl (
fun ( Action , nothing ) - >
case lists : keysearch ( Action , 1 , Query ) of
{ value , _ } - >
case lists : keysearch ( Action ++ " path " , 1 , Query ) of
{ value , { _ , Path } } - >
Res =
case Action of
" store " - >
rpc : call ( Node , mnesia ,
backup , [ Path ] ) ;
" restore " - >
2006-05-07 18:52:21 +02:00
rpc : call ( Node , ejabberd_admin ,
restore , [ Path ] ) ;
2004-05-22 21:48:35 +02:00
" fallback " - >
rpc : call ( Node , mnesia ,
install_fallback , [ Path ] ) ;
" dump " - >
2008-10-12 14:05:31 +02:00
rpc : call ( Node , ejabberd_admin ,
2004-05-22 21:48:35 +02:00
dump_to_textfile , [ Path ] ) ;
" load " - >
rpc : call ( Node , mnesia ,
2009-08-07 11:52:45 +02:00
load_textfile , [ Path ] ) ;
" import_piefxis_file " - >
rpc : call ( Node , ejabberd_piefxis ,
import_file , [ Path ] ) ;
" export_piefxis_dir " - >
rpc : call ( Node , ejabberd_piefxis ,
export_server , [ Path ] ) ;
" export_piefxis_host_dir " - >
{ value , { _ , Host } } = lists : keysearch ( Action ++ " host " , 1 , Query ) ,
rpc : call ( Node , ejabberd_piefxis ,
export_host , [ Path , Host ] ) ;
" import_file " - >
rpc : call ( Node , ejabberd_admin ,
import_file , [ Path ] ) ;
" import_dir " - >
rpc : call ( Node , ejabberd_admin ,
import_dir , [ Path ] )
2004-05-22 21:48:35 +02:00
end ,
case Res of
2009-01-12 22:48:34 +01:00
{ error , Reason } - >
{ error , Reason } ;
{ badrpc , Reason } - >
{ badrpc , Reason } ;
2004-05-22 21:48:35 +02:00
_ - >
ok
end ;
2009-01-12 22:48:34 +01:00
OtherError - >
{ error , OtherError }
2004-05-22 21:48:35 +02:00
end ;
_ - >
nothing
end ;
( _ Action , Res ) - >
Res
2009-08-07 11:52:45 +02:00
end , nothing , [ " store " , " restore " , " fallback " , " dump " , " load " , " import_file " , " import_dir " ,
" import_piefxis_file " , " export_piefxis_dir " , " export_piefxis_host_dir " ] ) .
2004-05-22 21:48:35 +02:00
2004-06-17 23:29:24 +02:00
node_ports_to_xhtml ( Ports , Lang ) - >
2009-01-12 22:48:34 +01:00
? XAE ( " table " , [ { " class " , " withtextareas " } ] ,
2004-06-17 23:29:24 +02:00
[ ? XE ( " thead " ,
[ ? XE ( " tr " ,
[ ? XCT ( " td " , " Port " ) ,
2009-01-12 21:03:02 +01:00
? XCT ( " td " , " IP " ) ,
2009-08-12 12:42:08 +02:00
? XCT ( " td " , " Protocol " ) ,
2004-06-17 23:29:24 +02:00
? XCT ( " td " , " Module " ) ,
? XCT ( " td " , " Options " )
] ) ] ) ,
? XE ( " tbody " ,
lists : map (
2009-01-12 21:03:02 +01:00
fun ( { PortIP , Module , Opts } = _ E ) - >
2009-08-11 20:22:58 +02:00
{ _ Port , SPort , _ TIP , SIP , SSPort , NetProt , OptsClean } =
2009-01-12 21:03:02 +01:00
get_port_data ( PortIP , Opts ) ,
2004-06-17 23:29:24 +02:00
SModule = atom_to_list ( Module ) ,
2009-01-12 22:48:34 +01:00
{ NumLines , SOptsClean } = term_to_paragraph ( OptsClean , 40 ) ,
2007-12-07 02:40:24 +01:00
%%ID = term_to_id(E),
2004-06-17 23:29:24 +02:00
? XE ( " tr " ,
2009-01-12 21:03:02 +01:00
[ ? XAE ( " td " , [ { " size " , " 6 " } ] , [ ? C ( SPort ) ] ) ,
? XAE ( " td " , [ { " size " , " 15 " } ] , [ ? C ( SIP ) ] ) ,
2009-08-11 20:22:58 +02:00
? XAE ( " td " , [ { " size " , " 4 " } ] , [ ? C ( atom_to_list ( NetProt ) ) ] ) ,
2009-01-12 21:03:02 +01:00
? XE ( " td " , [ ? INPUTS ( " text " , " module " ++ SSPort ,
SModule , " 15 " ) ] ) ,
2009-01-12 22:48:34 +01:00
? XE ( " td " , [ ? TEXTAREA ( " opts " ++ SSPort , integer_to_list ( NumLines ) , " 35 " , SOptsClean ) ] ) ,
2009-01-12 21:03:02 +01:00
? XE ( " td " , [ ? INPUTT ( " submit " , " add " ++ SSPort ,
2004-06-17 23:29:24 +02:00
" Update " ) ] ) ,
2009-01-12 21:03:02 +01:00
? XE ( " td " , [ ? INPUTT ( " submit " , " delete " ++ SSPort ,
2004-06-17 23:29:24 +02:00
" Delete " ) ] )
]
)
end , Ports ) ++
[ ? XE ( " tr " ,
[ ? XE ( " td " , [ ? INPUTS ( " text " , " portnew " , " " , " 6 " ) ] ) ,
2009-01-12 21:03:02 +01:00
? XE ( " td " , [ ? INPUTS ( " text " , " ipnew " , " 0.0.0.0 " , " 15 " ) ] ) ,
2009-08-11 20:22:58 +02:00
? XE ( " td " , [ make_netprot_html ( " tcp " ) ] ) ,
2009-01-12 22:48:34 +01:00
? XE ( " td " , [ ? INPUTS ( " text " , " modulenew " , " " , " 15 " ) ] ) ,
? XE ( " td " , [ ? TEXTAREA ( " optsnew " , " 2 " , " 35 " , " [] " ) ] ) ,
2004-06-17 23:29:24 +02:00
? XAE ( " td " , [ { " colspan " , " 2 " } ] ,
[ ? INPUTT ( " submit " , " addnew " , " Add New " ) ] )
]
) ]
) ] ) .
2009-08-11 20:22:58 +02:00
make_netprot_html ( NetProt ) - >
? XAE ( " select " , [ { " name " , " netprotnew " } ] ,
lists : map (
fun ( O ) - >
Sel = if
O == NetProt - > [ { " selected " , " selected " } ] ;
true - > [ ]
end ,
? XAC ( " option " ,
Sel ++ [ { " value " , O } ] ,
O )
end , [ " tcp " , " udp " ] ) ) .
2009-01-12 21:03:02 +01:00
get_port_data ( PortIP , Opts ) - >
2009-08-11 20:22:58 +02:00
{ Port , IPT , IPS , _ IPV , NetProt , OptsClean } = ejabberd_listener : parse_listener_portip ( PortIP , Opts ) ,
2009-01-12 21:03:02 +01:00
SPort = io_lib : format ( " ~p " , [ Port ] ) ,
SSPort = lists : flatten (
lists : map (
fun ( N ) - > io_lib : format ( " ~.16b " , [ N ] ) end ,
2009-08-11 20:22:58 +02:00
binary_to_list ( crypto : md5 ( SPort ++ IPS ++ atom_to_list ( NetProt ) ) ) ) ) ,
{ Port , SPort , IPT , IPS , SSPort , NetProt , OptsClean } .
2009-01-12 21:03:02 +01:00
2004-06-17 23:29:24 +02:00
node_ports_parse_query ( Node , Ports , Query ) - >
lists : foreach (
2009-08-11 20:22:58 +02:00
fun ( { PortIpNetp , Module1 , Opts1 } ) - >
{ Port , _ SPort , TIP , _ SIP , SSPort , NetProt , _ OptsClean } =
get_port_data ( PortIpNetp , Opts1 ) ,
2009-01-12 21:03:02 +01:00
case lists : keysearch ( " add " ++ SSPort , 1 , Query ) of
2004-06-17 23:29:24 +02:00
{ value , _ } - >
2009-08-11 20:22:58 +02:00
PortIpNetp2 = { Port , TIP , NetProt } ,
2004-06-17 23:29:24 +02:00
{ { value , { _ , SModule } } , { value , { _ , SOpts } } } =
2009-01-12 21:03:02 +01:00
{ lists : keysearch ( " module " ++ SSPort , 1 , Query ) ,
lists : keysearch ( " opts " ++ SSPort , 1 , Query ) } ,
2004-06-17 23:29:24 +02:00
Module = list_to_atom ( SModule ) ,
{ ok , Tokens , _ } = erl_scan : string ( SOpts ++ " . " ) ,
{ ok , Opts } = erl_parse : parse_term ( Tokens ) ,
2009-01-12 21:03:02 +01:00
rpc : call ( Node , ejabberd_listener , delete_listener ,
2009-08-11 20:22:58 +02:00
[ PortIpNetp2 , Module1 ] ) ,
2009-01-12 21:03:02 +01:00
R = rpc : call ( Node , ejabberd_listener , add_listener ,
2009-08-11 20:22:58 +02:00
[ PortIpNetp2 , Module , Opts ] ) ,
2009-01-12 21:03:02 +01:00
throw ( { is_added , R } ) ;
2004-06-17 23:29:24 +02:00
_ - >
2009-01-12 21:03:02 +01:00
case lists : keysearch ( " delete " ++ SSPort , 1 , Query ) of
2004-06-17 23:29:24 +02:00
{ value , _ } - >
2009-01-12 21:03:02 +01:00
rpc : call ( Node , ejabberd_listener , delete_listener ,
2009-08-11 20:22:58 +02:00
[ PortIpNetp , Module1 ] ) ,
2004-06-17 23:29:24 +02:00
throw ( submitted ) ;
_ - >
ok
end
end
end , Ports ) ,
case lists : keysearch ( " addnew " , 1 , Query ) of
{ value , _ } - >
{ { value , { _ , SPort } } ,
2009-01-12 21:03:02 +01:00
{ value , { _ , STIP } } , %% It is a string that may represent a tuple
2009-08-11 20:22:58 +02:00
{ value , { _ , SNetProt } } ,
2004-06-17 23:29:24 +02:00
{ value , { _ , SModule } } ,
{ value , { _ , SOpts } } } =
{ lists : keysearch ( " portnew " , 1 , Query ) ,
2009-01-12 21:03:02 +01:00
lists : keysearch ( " ipnew " , 1 , Query ) ,
2009-08-11 20:22:58 +02:00
lists : keysearch ( " netprotnew " , 1 , Query ) ,
2004-06-17 23:29:24 +02:00
lists : keysearch ( " modulenew " , 1 , Query ) ,
lists : keysearch ( " optsnew " , 1 , Query ) } ,
2009-01-12 21:03:02 +01:00
{ ok , Toks , _ } = erl_scan : string ( SPort ++ " . " ) ,
{ ok , Port2 } = erl_parse : parse_term ( Toks ) ,
{ ok , ToksIP , _ } = erl_scan : string ( STIP ++ " . " ) ,
STIP2 = case erl_parse : parse_term ( ToksIP ) of
{ ok , IPTParsed } - > IPTParsed ;
{ error , _ } - > STIP
end ,
2004-06-17 23:29:24 +02:00
Module = list_to_atom ( SModule ) ,
2009-08-11 20:22:58 +02:00
NetProt2 = list_to_atom ( SNetProt ) ,
2004-06-17 23:29:24 +02:00
{ ok , Tokens , _ } = erl_scan : string ( SOpts ++ " . " ) ,
{ ok , Opts } = erl_parse : parse_term ( Tokens ) ,
2009-08-11 20:22:58 +02:00
{ Port2 , _ SPort , IP2 , _ SIP , _ SSPort , NetProt2 , OptsClean } =
get_port_data ( { Port2 , STIP2 , NetProt2 } , Opts ) ,
2009-01-12 21:03:02 +01:00
R = rpc : call ( Node , ejabberd_listener , add_listener ,
2009-08-11 20:22:58 +02:00
[ { Port2 , IP2 , NetProt2 } , Module , OptsClean ] ) ,
2009-01-12 21:03:02 +01:00
throw ( { is_added , R } ) ;
2004-06-17 23:29:24 +02:00
_ - >
ok
end .
2005-05-23 02:30:29 +02:00
node_modules_to_xhtml ( Modules , Lang ) - >
2009-01-12 22:48:34 +01:00
? XAE ( " table " , [ { " class " , " withtextareas " } ] ,
2005-05-23 02:30:29 +02:00
[ ? XE ( " thead " ,
[ ? XE ( " tr " ,
[ ? XCT ( " td " , " Module " ) ,
? XCT ( " td " , " Options " )
] ) ] ) ,
? XE ( " tbody " ,
lists : map (
2007-12-07 02:40:24 +01:00
fun ( { Module , Opts } = _ E ) - >
2005-05-23 02:30:29 +02:00
SModule = atom_to_list ( Module ) ,
2009-01-12 22:48:34 +01:00
{ NumLines , SOpts } = term_to_paragraph ( Opts , 40 ) ,
2007-12-07 02:40:24 +01:00
%%ID = term_to_id(E),
2005-05-23 02:30:29 +02:00
? XE ( " tr " ,
[ ? XC ( " td " , SModule ) ,
2009-01-12 22:48:34 +01:00
? XE ( " td " , [ ? TEXTAREA ( " opts " ++ SModule , integer_to_list ( NumLines ) , " 40 " , SOpts ) ] ) ,
2005-05-23 02:30:29 +02:00
? XE ( " td " , [ ? INPUTT ( " submit " , " restart " ++ SModule ,
" Restart " ) ] ) ,
? XE ( " td " , [ ? INPUTT ( " submit " , " stop " ++ SModule ,
" Stop " ) ] )
]
)
end , Modules ) ++
[ ? XE ( " tr " ,
[ ? XE ( " td " , [ ? INPUT ( " text " , " modulenew " , " " ) ] ) ,
2009-01-12 22:48:34 +01:00
? XE ( " td " , [ ? TEXTAREA ( " optsnew " , " 2 " , " 40 " , " [] " ) ] ) ,
2005-05-23 02:30:29 +02:00
? XAE ( " td " , [ { " colspan " , " 2 " } ] ,
[ ? INPUTT ( " submit " , " start " , " Start " ) ] )
]
) ]
) ] ) .
2005-06-20 05:18:13 +02:00
node_modules_parse_query ( Host , Node , Modules , Query ) - >
2005-05-23 02:30:29 +02:00
lists : foreach (
fun ( { Module , _ Opts1 } ) - >
SModule = atom_to_list ( Module ) ,
case lists : keysearch ( " restart " ++ SModule , 1 , Query ) of
{ value , _ } - >
{ value , { _ , SOpts } } =
lists : keysearch ( " opts " ++ SModule , 1 , Query ) ,
{ ok , Tokens , _ } = erl_scan : string ( SOpts ++ " . " ) ,
{ ok , Opts } = erl_parse : parse_term ( Tokens ) ,
2005-06-20 05:18:13 +02:00
rpc : call ( Node , gen_mod , stop_module , [ Host , Module ] ) ,
rpc : call ( Node , gen_mod , start_module , [ Host , Module , Opts ] ) ,
2005-05-23 02:30:29 +02:00
throw ( submitted ) ;
_ - >
case lists : keysearch ( " stop " ++ SModule , 1 , Query ) of
{ value , _ } - >
2005-06-20 05:18:13 +02:00
rpc : call ( Node , gen_mod , stop_module , [ Host , Module ] ) ,
2005-05-23 02:30:29 +02:00
throw ( submitted ) ;
_ - >
ok
end
end
end , Modules ) ,
case lists : keysearch ( " start " , 1 , Query ) of
{ value , _ } - >
{ { value , { _ , SModule } } ,
{ value , { _ , SOpts } } } =
{ lists : keysearch ( " modulenew " , 1 , Query ) ,
lists : keysearch ( " optsnew " , 1 , Query ) } ,
Module = list_to_atom ( SModule ) ,
{ ok , Tokens , _ } = erl_scan : string ( SOpts ++ " . " ) ,
{ ok , Opts } = erl_parse : parse_term ( Tokens ) ,
2005-06-20 05:18:13 +02:00
rpc : call ( Node , gen_mod , start_module , [ Host , Module , Opts ] ) ,
2005-05-23 02:30:29 +02:00
throw ( submitted ) ;
_ - >
ok
end .
2004-06-17 23:29:24 +02:00
2006-02-27 05:43:16 +01:00
node_update_parse_query ( Node , Query ) - >
case lists : keysearch ( " update " , 1 , Query ) of
{ value , _ } - >
2009-05-27 19:28:55 +02:00
ModulesToUpdateStrings = proplists : get_all_values ( " selected " , Query ) ,
ModulesToUpdate = [ list_to_atom ( M ) | | M < - ModulesToUpdateStrings ] ,
case rpc : call ( Node , ejabberd_update , update , [ ModulesToUpdate ] ) of
2006-02-27 05:43:16 +01:00
{ ok , _ } - >
ok ;
{ error , Error } - >
2010-10-15 13:11:14 +02:00
? ERROR_MSG ( " ~p ~n " , [ Error ] ) ,
{ error , io_lib : format ( " ~p " , [ Error ] ) } ;
2006-02-27 05:43:16 +01:00
{ badrpc , Error } - >
2010-10-15 13:11:14 +02:00
? ERROR_MSG ( " Bad RPC: ~p ~n " , [ Error ] ) ,
{ error , " Bad RPC: " ++ io_lib : format ( " ~p " , [ Error ] ) }
2006-02-27 05:43:16 +01:00
end ;
_ - >
nothing
end .
2007-08-23 02:51:54 +02:00
pretty_print_xml ( El ) - >
lists : flatten ( pretty_print_xml ( El , " " ) ) .
2004-10-05 21:31:17 +02:00
2007-08-23 02:51:54 +02:00
pretty_print_xml ( { xmlcdata , CData } , Prefix ) - >
2004-10-05 21:31:17 +02:00
[ Prefix , CData , $\n ] ;
2007-08-23 02:51:54 +02:00
pretty_print_xml ( { xmlelement , Name , Attrs , Els } , Prefix ) - >
2004-10-05 21:31:17 +02:00
[ Prefix , $< , Name ,
case Attrs of
[ ] - >
[ ] ;
[ { Attr , Val } | RestAttrs ] - >
AttrPrefix = [ Prefix ,
string : copies ( " " , length ( Name ) + 2 ) ] ,
[ $\s , Attr , $= , $' , xml : crypt ( Val ) , $' |
lists : map ( fun ( { Attr1 , Val1 } ) - >
[ $\n , AttrPrefix ,
Attr1 , $= , $' , xml : crypt ( Val1 ) , $' ]
end , RestAttrs ) ]
end ,
if
Els == [ ] - >
" /> \n " ;
true - >
OnlyCData = lists : all ( fun ( { xmlcdata , _ } ) - > true ;
( { xmlelement , _ , _ , _ } ) - > false
end , Els ) ,
if
OnlyCData - >
[ $> ,
xml : get_cdata ( Els ) ,
$< , $/ , Name , $> , $\n
] ;
true - >
[ $> , $\n ,
lists : map ( fun ( E ) - >
2007-08-23 02:51:54 +02:00
pretty_print_xml ( E , [ Prefix , " " ] )
2004-10-05 21:31:17 +02:00
end , Els ) ,
Prefix , $< , $/ , Name , $> , $\n
]
end
end ] .
2007-12-26 13:21:52 +01:00
element_to_list ( X ) when is_atom ( X ) - > atom_to_list ( X ) ;
element_to_list ( X ) when is_integer ( X ) - > integer_to_list ( X ) .
list_to_element ( List ) - >
{ ok , Tokens , _ } = erl_scan : string ( List ) ,
[ { _ , _ , Element } ] = Tokens ,
Element .
2005-04-17 20:08:34 +02:00
2005-09-29 03:04:24 +02:00
url_func ( { user_diapason , From , To } ) - >
integer_to_list ( From ) ++ " - " ++ integer_to_list ( To ) ++ " / " ;
2007-12-07 02:40:24 +01:00
url_func ( { users_queue , Prefix , User , _ Server } ) - >
2005-09-29 03:04:24 +02:00
Prefix ++ " user/ " ++ User ++ " /queue/ " ;
2007-12-07 02:40:24 +01:00
url_func ( { user , Prefix , User , _ Server } ) - >
2005-09-29 03:04:24 +02:00
Prefix ++ " user/ " ++ User ++ " / " .
2008-04-12 10:09:05 +02:00
last_modified ( ) - >
{ " Last-Modified " , " Mon, 25 Feb 2008 13:23:30 GMT " } .
cache_control_public ( ) - >
{ " Cache-Control " , " public " } .
2008-10-12 15:58:05 +02:00
2009-02-13 23:13:34 +01:00
%% Transform 1234567890 into "1,234,567,890"
pretty_string_int ( Integer ) when is_integer ( Integer ) - >
pretty_string_int ( integer_to_list ( Integer ) ) ;
pretty_string_int ( String ) when is_list ( String ) - >
{ _ , Result } = lists : foldl (
fun ( NewNumber , { 3 , Result } ) - >
{ 1 , [ NewNumber , $, | Result ] } ;
( NewNumber , { CountAcc , Result } ) - >
{ CountAcc + 1 , [ NewNumber | Result ] }
end ,
{ 0 , " " } ,
lists : reverse ( String ) ) ,
Result .
2009-06-23 22:45:39 +02:00
%%%==================================
%%%% navigation menu
2008-10-12 15:58:05 +02:00
2009-06-23 23:00:43 +02:00
%% @spec (Host, Node, Lang, JID::jid()) -> [LI]
make_navigation ( Host , Node , Lang , JID ) - >
Menu = make_navigation_menu ( Host , Node , Lang , JID ) ,
2008-10-12 15:58:05 +02:00
make_menu_items ( Lang , Menu ) .
2009-06-23 23:00:43 +02:00
%% @spec (Host, Node, Lang, JID::jid()) -> Menu
%% where Host = global | string()
%% Node = cluster | string()
%% Lang = string()
%% Menu = {URL, Title} | {URL, Title, [Menu]}
%% URL = string()
%% Title = string()
make_navigation_menu ( Host , Node , Lang , JID ) - >
HostNodeMenu = make_host_node_menu ( Host , Node , Lang , JID ) ,
HostMenu = make_host_menu ( Host , HostNodeMenu , Lang , JID ) ,
NodeMenu = make_node_menu ( Host , Node , Lang ) ,
make_server_menu ( HostMenu , NodeMenu , Lang , JID ) .
2008-10-12 15:58:05 +02:00
%% @spec (Host, Node, Base, Lang) -> [LI]
make_menu_items ( global , cluster , Base , Lang ) - >
HookItems = get_menu_items_hook ( server , Lang ) ,
make_menu_items ( Lang , { Base , " " , HookItems } ) ;
2009-02-02 11:12:44 +01:00
make_menu_items ( global , Node , Base , Lang ) - >
HookItems = get_menu_items_hook ( { node , Node } , Lang ) ,
2008-10-12 15:58:05 +02:00
make_menu_items ( Lang , { Base , " " , HookItems } ) ;
make_menu_items ( Host , cluster , Base , Lang ) - >
HookItems = get_menu_items_hook ( { host , Host } , Lang ) ,
make_menu_items ( Lang , { Base , " " , HookItems } ) ;
2009-02-02 11:12:44 +01:00
make_menu_items ( Host , Node , Base , Lang ) - >
HookItems = get_menu_items_hook ( { hostnode , Host , Node } , Lang ) ,
2008-10-12 15:58:05 +02:00
make_menu_items ( Lang , { Base , " " , HookItems } ) .
2009-06-23 23:00:43 +02:00
make_host_node_menu ( global , _ , _ Lang , _ JID ) - >
2008-10-12 15:58:05 +02:00
{ " " , " " , [ ] } ;
2009-06-23 23:00:43 +02:00
make_host_node_menu ( _ , cluster , _ Lang , _ JID ) - >
2008-10-12 15:58:05 +02:00
{ " " , " " , [ ] } ;
2009-06-23 23:00:43 +02:00
make_host_node_menu ( Host , Node , Lang , JID ) - >
2008-10-12 15:58:05 +02:00
HostNodeBase = get_base_path ( Host , Node ) ,
2009-06-23 23:00:43 +02:00
HostNodeFixed = [ { " modules/ " , " Modules " } ]
++ get_menu_items_hook ( { hostnode , Host , Node } , Lang ) ,
HostNodeBasePath = url_to_path ( HostNodeBase ) ,
HostNodeFixed2 = [ Tuple | | Tuple < - HostNodeFixed , is_allowed_path ( HostNodeBasePath , Tuple , JID ) ] ,
{ HostNodeBase , atom_to_list ( Node ) , HostNodeFixed2 } .
2008-10-12 15:58:05 +02:00
2009-06-23 23:00:43 +02:00
make_host_menu ( global , _ HostNodeMenu , _ Lang , _ JID ) - >
2008-10-12 15:58:05 +02:00
{ " " , " " , [ ] } ;
2009-06-23 23:00:43 +02:00
make_host_menu ( Host , HostNodeMenu , Lang , JID ) - >
2008-10-12 15:58:05 +02:00
HostBase = get_base_path ( Host , cluster ) ,
HostFixed = [ { " acls " , " Access Control Lists " } ,
{ " access " , " Access Rules " } ,
{ " users " , " Users " } ,
2009-12-09 18:47:02 +01:00
{ " online-users " , " Online Users " } ]
++ get_lastactivity_menuitem_list ( Host ) ++
[ { " nodes " , " Nodes " , HostNodeMenu } ,
2009-06-23 23:00:43 +02:00
{ " stats " , " Statistics " } ]
++ get_menu_items_hook ( { host , Host } , Lang ) ,
HostBasePath = url_to_path ( HostBase ) ,
HostFixed2 = [ Tuple | | Tuple < - HostFixed , is_allowed_path ( HostBasePath , Tuple , JID ) ] ,
{ HostBase , Host , HostFixed2 } .
2008-10-12 15:58:05 +02:00
make_node_menu ( _ Host , cluster , _ Lang ) - >
{ " " , " " , [ ] } ;
make_node_menu ( global , Node , Lang ) - >
NodeBase = get_base_path ( global , Node ) ,
NodeFixed = [ { " db/ " , " Database " } ,
{ " backup/ " , " Backup " } ,
{ " ports/ " , " Listened Ports " } ,
{ " stats/ " , " Statistics " } ,
2009-06-23 23:00:43 +02:00
{ " update/ " , " Update " } ]
++ get_menu_items_hook ( { node , Node } , Lang ) ,
{ NodeBase , atom_to_list ( Node ) , NodeFixed } ;
2008-10-12 15:58:05 +02:00
make_node_menu ( _ Host , _ Node , _ Lang ) - >
{ " " , " " , [ ] } .
2009-06-23 23:00:43 +02:00
make_server_menu ( HostMenu , NodeMenu , Lang , JID ) - >
2008-10-12 15:58:05 +02:00
Base = get_base_path ( global , cluster ) ,
Fixed = [ { " acls " , " Access Control Lists " } ,
{ " access " , " Access Rules " } ,
{ " vhosts " , " Virtual Hosts " , HostMenu } ,
{ " nodes " , " Nodes " , NodeMenu } ,
2009-06-23 23:00:43 +02:00
{ " stats " , " Statistics " } ]
++ get_menu_items_hook ( server , Lang ) ,
BasePath = url_to_path ( Base ) ,
Fixed2 = [ Tuple | | Tuple < - Fixed , is_allowed_path ( BasePath , Tuple , JID ) ] ,
{ Base , " ejabberd " , Fixed2 } .
2008-10-12 15:58:05 +02:00
2009-02-02 11:12:44 +01:00
get_menu_items_hook ( { hostnode , Host , Node } , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_hostnode , Host , [ ] , [ Host , Node , Lang ] ) ;
2008-10-12 15:58:05 +02:00
get_menu_items_hook ( { host , Host } , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_host , Host , [ ] , [ Host , Lang ] ) ;
2009-02-02 11:12:44 +01:00
get_menu_items_hook ( { node , Node } , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_node , [ ] , [ Node , Lang ] ) ;
2008-10-12 15:58:05 +02:00
get_menu_items_hook ( server , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_main , [ ] , [ Lang ] ) .
%% @spec (Lang::string(), Menu) -> [LI]
%% where Menu = {MURI::string(), MName::string(), Items::[Item]}
%% Item = {IURI::string(), IName::string()} | {IURI::string(), IName::string(), Menu}
make_menu_items ( Lang , Menu ) - >
lists : reverse ( make_menu_items2 ( Lang , 1 , Menu ) ) .
make_menu_items2 ( Lang , Deep , { MURI , MName , _ } = Menu ) - >
Res = case MName of
" " - > [ ] ;
_ - > [ make_menu_item ( header , Deep , MURI , MName , Lang ) ]
end ,
make_menu_items2 ( Lang , Deep , Menu , Res ) .
make_menu_items2 ( _ , _ Deep , { _ , _ , [ ] } , Res ) - >
Res ;
make_menu_items2 ( Lang , Deep , { MURI , MName , [ Item | Items ] } , Res ) - >
Res2 = case Item of
{ IURI , IName } - >
[ make_menu_item ( item , Deep , MURI ++ IURI ++ " / " , IName , Lang ) | Res ] ;
{ IURI , IName , SubMenu } - >
%%ResTemp = [?LI([?ACT(MURI ++ IURI ++ "/", IName)]) | Res],
ResTemp = [ make_menu_item ( item , Deep , MURI ++ IURI ++ " / " , IName , Lang ) | Res ] ,
ResSubMenu = make_menu_items2 ( Lang , Deep + 1 , SubMenu ) ,
ResSubMenu ++ ResTemp
end ,
make_menu_items2 ( Lang , Deep , { MURI , MName , Items } , Res2 ) .
make_menu_item ( header , 1 , URI , Name , _ Lang ) - >
2009-01-12 22:48:34 +01:00
? LI ( [ ? XAE ( " div " , [ { " id " , " navhead " } ] , [ ? AC ( URI , Name ) ] ) ] ) ;
2008-10-12 15:58:05 +02:00
make_menu_item ( header , 2 , URI , Name , _ Lang ) - >
2009-01-12 22:48:34 +01:00
? LI ( [ ? XAE ( " div " , [ { " id " , " navheadsub " } ] , [ ? AC ( URI , Name ) ] ) ] ) ;
2008-10-12 15:58:05 +02:00
make_menu_item ( header , 3 , URI , Name , _ Lang ) - >
2009-01-12 22:48:34 +01:00
? LI ( [ ? XAE ( " div " , [ { " id " , " navheadsubsub " } ] , [ ? AC ( URI , Name ) ] ) ] ) ;
2008-10-12 15:58:05 +02:00
make_menu_item ( item , 1 , URI , Name , Lang ) - >
? LI ( [ ? XAE ( " div " , [ { " id " , " navitem " } ] , [ ? ACT ( URI , Name ) ] ) ] ) ;
make_menu_item ( item , 2 , URI , Name , Lang ) - >
? LI ( [ ? XAE ( " div " , [ { " id " , " navitemsub " } ] , [ ? ACT ( URI , Name ) ] ) ] ) ;
make_menu_item ( item , 3 , URI , Name , Lang ) - >
? LI ( [ ? XAE ( " div " , [ { " id " , " navitemsubsub " } ] , [ ? ACT ( URI , Name ) ] ) ] ) .
2009-06-23 22:45:39 +02:00
%%%==================================
%%% vim: set foldmethod=marker foldmarker=%%%%,%%%=: