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
%%%
%%%
2009-01-19 15:47:33 +01:00
%%% ejabberd, Copyright (C) 2002-2009 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-19 15:47:33 +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
- 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
term_to_id / 1 ] ) .
2004-04-26 17:38:07 +02:00
2008-10-13 17:36:43 +02:00
- include_lib ( " exmpp/include/exmpp.hrl " ) .
2004-04-26 17:38:07 +02:00
- include ( " ejabberd.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:29:43 +02:00
- define ( INPUTATTRS ( Type , Name , Value , Attrs ) ,
? XA ( " input " , Attrs ++
[ ? XMLATTR ( 'type' , Type ) ,
? XMLATTR ( 'name' , Name ) ,
? XMLATTR ( 'value' , Value ) ] ) ) .
2009-01-19 12:59:40 +01:00
process ( [ " doc " , LocalFile ] , _ Request ) - >
Merge from trunk: 1835, 1836, 1842, 1843, 1854, 1858, 1860, 1861, and 1862.
* doc/Makefile: In Clean do not remove html. In new Distclean,
remove also html.
* doc/Makefile: When cleaning, remove contributed_modules.tex
* src/Makefile.in: Fix arguments to Install program
* doc/guide.tex: Provide only an example of language option
* doc/guide.html: Likewise
* doc/guide.tex: mod_muc can run in several nodes of cluster
* doc/guide.html: Likewise
* doc/api/process-one.css: Add some style to HTML elements
* src/ejabberd_listener.erl: Fix EDoc errors
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberd_hooks.erl: Explanation in EDoc of some functions
* doc/guide.tex: Explain that account creation is only supported
by internal and odbc authentication methods
* doc/guide.html: Likewise
* src/Makefile.in: The path to the installed copy of ejabberd
Guide is set in the environment variable
EJABBERD_DOC_PATH (EJAB-837).
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberdctl.template: Likewise
* doc/guide.tex: Likewise
* doc/guide.html: Likewise
SVN Revision: 1937
2009-03-03 19:11:23 +01:00
DocPath = case os : getenv ( " EJABBERD_DOC_PATH " ) of
2009-01-19 12:59:40 +01:00
P when is_list ( P ) - > P ;
Merge from trunk: 1835, 1836, 1842, 1843, 1854, 1858, 1860, 1861, and 1862.
* doc/Makefile: In Clean do not remove html. In new Distclean,
remove also html.
* doc/Makefile: When cleaning, remove contributed_modules.tex
* src/Makefile.in: Fix arguments to Install program
* doc/guide.tex: Provide only an example of language option
* doc/guide.html: Likewise
* doc/guide.tex: mod_muc can run in several nodes of cluster
* doc/guide.html: Likewise
* doc/api/process-one.css: Add some style to HTML elements
* src/ejabberd_listener.erl: Fix EDoc errors
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberd_hooks.erl: Explanation in EDoc of some functions
* doc/guide.tex: Explain that account creation is only supported
by internal and odbc authentication methods
* doc/guide.html: Likewise
* src/Makefile.in: The path to the installed copy of ejabberd
Guide is set in the environment variable
EJABBERD_DOC_PATH (EJAB-837).
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberdctl.template: Likewise
* doc/guide.tex: Likewise
* doc/guide.html: Likewise
SVN Revision: 1937
2009-03-03 19:11:23 +01:00
false - > " /share/doc/ejabberd/ "
2009-01-19 12:59:40 +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 ] ) ,
Merge from trunk: 1835, 1836, 1842, 1843, 1854, 1858, 1860, 1861, and 1862.
* doc/Makefile: In Clean do not remove html. In new Distclean,
remove also html.
* doc/Makefile: When cleaning, remove contributed_modules.tex
* src/Makefile.in: Fix arguments to Install program
* doc/guide.tex: Provide only an example of language option
* doc/guide.html: Likewise
* doc/guide.tex: mod_muc can run in several nodes of cluster
* doc/guide.html: Likewise
* doc/api/process-one.css: Add some style to HTML elements
* src/ejabberd_listener.erl: Fix EDoc errors
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberd_hooks.erl: Explanation in EDoc of some functions
* doc/guide.tex: Explain that account creation is only supported
by internal and odbc authentication methods
* doc/guide.html: Likewise
* src/Makefile.in: The path to the installed copy of ejabberd
Guide is set in the environment variable
EJABBERD_DOC_PATH (EJAB-837).
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberdctl.template: Likewise
* doc/guide.tex: Likewise
* doc/guide.html: Likewise
SVN Revision: 1937
2009-03-03 19:11:23 +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-19 12:59:40 +01:00
case Error of
eacces - > { 403 , [ ] , " Forbidden " ++ Help } ;
enoent - > { 404 , [ ] , " Not found " ++ Help } ;
_ Else - > { 404 , [ ] , atom_to_list ( Error ) ++ Help }
end
end ;
2009-06-23 01:14:18 +02:00
process ( [ " server " , SHost | RPath ] , #request { auth = Auth , lang = Lang , host = HostHTTP } = Request ) - >
2008-10-13 17:36:43 +02:00
Host = exmpp_stringprep : nameprep ( SHost ) ,
2007-01-25 06:53:58 +01:00
case lists : member ( Host , ? MYHOSTS ) of
true - >
2009-06-23 01:14:18 +02:00
case get_auth_admin ( Auth , Host , HostHTTP ) of
{ ok , { User , Server } } - >
process_admin ( Host , Request #request { path = RPath ,
us = { User , Server } } ) ;
{ unauthorized , " no-auth-provided " } - >
2007-01-25 06:53:58 +01:00
{ 401 ,
[ { " WWW-Authenticate " , " basic realm= \" ejabberd \" " } ] ,
2009-06-23 01:14:18 +02:00
ejabberd_web : make_xhtml ( [ ? XCT ( 'h1' , " Unauthorized " ) ] ) } ;
{ unauthorized , Error } - >
? WARNING_MSG ( " Access ~p failed with error: ~p ~n ~p " ,
[ Auth , Error , Request ] ) ,
{ 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 - >
2008-10-13 17:36:43 +02:00
ejabberd_web : error ( not_found )
2007-01-25 06:53:58 +01:00
end ;
2009-06-23 01:14:18 +02:00
process ( RPath , #request { auth = Auth , lang = Lang , host = HostHTTP } = Request ) - >
case get_auth_admin ( Auth , global , HostHTTP ) of
{ ok , { User , Server } } - >
process_admin ( global , Request #request { path = RPath ,
us = { User , Server } } ) ;
{ unauthorized , " no-auth-provided " } - >
{ 401 ,
2007-01-25 06:53:58 +01:00
[ { " WWW-Authenticate " , " basic realm= \" ejabberd \" " } ] ,
2009-06-23 01:14:18 +02:00
ejabberd_web : make_xhtml ( [ ? XCT ( 'h1' , " Unauthorized " ) ] ) } ;
{ unauthorized , Error } - >
? WARNING_MSG ( " Access ~p failed with error: ~p ~n ~p " ,
[ Auth , Error , Request ] ) ,
{ 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 .
2009-06-23 01:14:18 +02:00
get_auth_admin ( Auth , Host , HostHTTP ) - >
2007-01-25 06:53:58 +01:00
case Auth of
2009-06-23 01:14:18 +02:00
{ SJID , Pass } - >
2008-10-13 17:36:43 +02:00
try
2009-06-01 18:35:55 +02:00
JID = exmpp_jid : parse ( SJID ) ,
2009-06-23 01:14:18 +02:00
User = exmpp_jid : node_as_list ( JID ) ,
Server = exmpp_jid : domain_as_list ( JID ) ,
case User == undefined of
2008-10-13 17:36:43 +02:00
true - >
2009-06-23 01:14:18 +02:00
%% If only specified username, not username@server
get_auth_account ( Host , Server , HostHTTP , Pass ) ;
2008-10-13 17:36:43 +02:00
false - >
2009-06-23 01:14:18 +02:00
get_auth_account ( Host , User , Server , Pass )
2008-10-13 17:36:43 +02:00
end
catch
_ - >
2009-06-23 01:14:18 +02:00
{ unauthorized , " badformed-jid " }
2008-10-13 17:36:43 +02:00
end ;
_ - >
2009-06-23 01:14:18 +02:00
{ unauthorized , " no-auth-provided " }
end .
get_auth_account ( Host , User , Server , Pass ) - >
case ejabberd_auth : check_password ( User , Server , Pass ) of
true - >
case acl : match_rule ( Host , configure ,
exmpp_jid : make ( User , Server ) ) of
deny - >
{ unauthorized , " unprivileged-account " } ;
allow - >
{ 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 .
2005-06-20 05:18:13 +02:00
make_xhtml ( Els , Host , Lang ) - >
2008-10-13 12:11:19 +02:00
make_xhtml ( Els , Host , cluster , Lang ) .
2009-01-19 12:59:40 +01:00
%% @spec (Els, Host, Node, Lang) -> {200, [html], xmlelement()}
2008-10-13 12:11:19 +02:00
%% where Host = global | string()
%% Node = cluster | atom()
make_xhtml ( Els , Host , Node , Lang ) - >
Base = get_base_path ( Host , cluster ) , %% Enforcing 'cluster' on purpose here
MenuItems = make_navigation ( Host , Node , Lang ) ,
2005-06-20 05:18:13 +02:00
{ 200 , [ html ] ,
2008-10-13 17:36:43 +02:00
#xmlel { ns = ? NS_XHTML , name = 'html' , attrs = [
2009-01-21 14:34:26 +01:00
exmpp_xml : attribute ( ? NS_XML , 'lang' , Lang ) ,
? XMLATTR ( 'lang' , Lang ) ] , children =
2008-10-13 17:36:43 +02:00
[ #xmlel { ns = ? NS_XHTML , name = 'head' , children =
[ ? XCT ( 'title' , " ejabberd Web Admin " ) ,
#xmlel { ns = ? NS_XHTML , name = 'meta' , attrs = [
2009-01-21 14:34:26 +01:00
? XMLATTR ( 'http-equiv' , < < " Content-Type " > > ) ,
? XMLATTR ( 'content' , < < " text/html; charset=utf-8 " > > ) ] } ,
2009-05-27 19:29:43 +02:00
#xmlel { ns = ? NS_XHTML , name = 'script' ,
%% This children is to ensure exmpp puts: <script ...></script>
children = [ ? C ( " . " ) ] ,
attrs = [
? XMLATTR ( 'src' , Base ++ " additions.js " ) ,
? XMLATTR ( 'type' , < < " text/javascript " > > ) ] } ,
2008-10-13 17:36:43 +02:00
#xmlel { ns = ? NS_XHTML , name = 'link' , attrs = [
2009-01-21 14:34:26 +01:00
? XMLATTR ( 'href' , Base ++ " favicon.ico " ) ,
? XMLATTR ( 'type' , < < " image/x-icon " > > ) ,
? XMLATTR ( 'rel' , < < " shortcut icon " > > ) ] } ,
2008-10-13 17:36:43 +02:00
#xmlel { ns = ? NS_XHTML , name = 'link' , attrs = [
2009-01-21 14:34:26 +01:00
? XMLATTR ( 'href' , Base ++ " style.css " ) ,
? XMLATTR ( 'type' , < < " text/css " > > ) ,
? XMLATTR ( 'rel' , < < " stylesheet " > > ) ] } ] } ,
2008-10-13 17:36:43 +02:00
? XE ( 'body' ,
[ ? XAE ( 'div' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " container " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'div' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " header " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XE ( 'h1' ,
2009-01-19 16:27:07 +01:00
[ ? ACT ( " /admin/ " , " ejabberd Web Admin " ) ]
2005-06-20 05:18:13 +02:00
) ] ) ,
2008-10-13 17:36:43 +02:00
? XAE ( 'div' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " navigation " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XE ( 'ul' ,
2008-10-13 12:11:19 +02:00
MenuItems
2005-05-09 01:39:46 +02:00
) ] ) ,
2008-10-13 17:36:43 +02:00
? XAE ( 'div' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " content " > > ) ] ,
2005-05-09 01:39:46 +02:00
Els ) ,
2008-10-13 17:36:43 +02:00
? XAE ( 'div' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " clearcopyright " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ #xmlcdata { cdata = < < > > } ] ) ] ) ,
? XAE ( 'div' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " copyrightouter " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'div' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " copyright " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'p' ,
2009-01-19 15:47:33 +01:00
" ejabberd (c) 2002-2009 ProcessOne " )
2005-05-09 01:39:46 +02:00
] ) ] ) ] )
2004-04-26 17:38:07 +02:00
] } } .
2008-10-13 12:11:19 +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-05-27 19:29:43 +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-13 12:11:19 +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-13 12:11:19 +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:50 +02:00
border - top : 1 px solid #d47911 ;
2008-10-13 12:11:19 +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:50 +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-13 12:11:19 +02:00
ul li #navhead a , ul li #navheadsub a , ul li #navheadsubsub a {
text - align : center ;
2009-05-27 19:29:50 +02:00
border - top : 1 px solid #d47911 ;
border - bottom : 2 px solid #d47911 ;
2009-01-19 16:27:07 +01:00
background : # FED6A6 ;
2008-10-13 12:11:19 +02:00
}
#navheadsub , #navitemsub {
border - left : 7 px solid white ;
2009-05-27 19:29:50 +02:00
margin - left : 2 px ;
2008-10-13 12:11:19 +02:00
}
#navheadsubsub , #navitemsubsub {
border - left : 14 px solid white ;
2009-05-27 19:29:50 +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:29:43 +02:00
#content ul . noliststyle > 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-13 12:11:19 +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-19 12:59:40 +01:00
div . guidelink {
2004-05-16 22:13:38 +02:00
text - align : right ;
2009-01-19 12:59:40 +01:00
padding - right : 1 em ;
}
2009-01-19 16:27:07 +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-19 12:59:40 +01:00
* . alignright {
font - size : 10 pt ;
2009-03-03 19:24:42 +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-19 16:27:07 +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-19 16:27:07 +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
2008-10-13 12:11:19 +02:00
2005-06-20 05:18:13 +02:00
process_admin ( global ,
2007-12-07 02:40:24 +01:00
#request { path = [ ] ,
lang = Lang } ) - >
2008-10-13 12:11:19 +02:00
Base = get_base_path ( global , cluster ) ,
MenuItems2 = make_menu_items ( global , cluster , Base , Lang ) ,
2009-01-19 12:59:40 +01:00
make_xhtml ( ? H1GL ( ? T ( " Administration " ) , " toc " , " Contents " ) ++
[ ? XE ( 'ul' ,
2005-05-09 01:39:46 +02:00
[ ? LI ( [ ? ACT ( " /admin/acls/ " , " Access Control Lists " ) , ? C ( " " ) ,
2006-02-18 20:56:16 +01:00
? ACT ( " /admin/acls-raw/ " , " (Raw) " ) ] ) ,
2005-05-09 01:39:46 +02:00
? LI ( [ ? ACT ( " /admin/access/ " , " Access Rules " ) , ? C ( " " ) ,
2006-02-18 20:56:16 +01:00
? ACT ( " /admin/access-raw/ " , " (Raw) " ) ] ) ,
2005-07-29 22:34:57 +02:00
? LI ( [ ? ACT ( " /admin/vhosts/ " , " Virtual Hosts " ) ] ) ,
2005-05-09 01:39:46 +02:00
? LI ( [ ? ACT ( " /admin/nodes/ " , " Nodes " ) ] ) ,
? LI ( [ ? ACT ( " /admin/stats/ " , " Statistics " ) ] )
2007-08-23 02:51:54 +02:00
] ++ MenuItems2
2005-06-20 05:18:13 +02:00
)
] , global , Lang ) ;
process_admin ( Host ,
2007-12-07 02:40:24 +01:00
#request { path = [ ] ,
lang = Lang } ) - >
2008-10-13 12:11:19 +02:00
Base = get_base_path ( Host , cluster ) ,
MenuItems2 = make_menu_items ( Host , cluster , Base , Lang ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Administration " ) ,
? XE ( 'ul' ,
2005-06-20 05:18:13 +02:00
[ ? LI ( [ ? ACT ( Base ++ " acls/ " , " Access Control Lists " ) , ? C ( " " ) ,
2006-02-18 20:56:16 +01:00
? ACT ( Base ++ " acls-raw/ " , " (Raw) " ) ] ) ,
2005-06-20 05:18:13 +02:00
? LI ( [ ? ACT ( Base ++ " access/ " , " Access Rules " ) , ? C ( " " ) ,
2006-02-18 20:56:16 +01:00
? ACT ( Base ++ " access-raw/ " , " (Raw) " ) ] ) ,
2005-06-20 05:18:13 +02:00
? LI ( [ ? ACT ( Base ++ " users/ " , " Users " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " online-users/ " , " Online Users " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " last-activity/ " , " Last Activity " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " nodes/ " , " Nodes " ) ] ) ,
? LI ( [ ? ACT ( Base ++ " stats/ " , " Statistics " ) ] )
2007-08-23 02:51:54 +02:00
] ++ MenuItems2
2005-04-18 22:03:07 +02:00
)
2005-06-20 05:18:13 +02:00
] , Host , Lang ) ;
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:29:43 +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 ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2009-01-19 16:27:07 +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-19 16:27:07 +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-19 12:59:40 +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-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2009-01-19 16:27:07 +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
] )
2005-06-20 05:18:13 +02:00
] , Host , Lang ) ;
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 " ] ,
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-19 12:59:40 +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-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'p' , [ ? ACT ( " ../acls-raw/ " , " Raw " ) ] ) ] ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( '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
] )
2005-06-20 05:18:13 +02:00
] , Host , Lang ) ;
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 " ] ,
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-19 16:27:07 +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-19 16:27:07 +01:00
[ { { access , '$1' , '$2' } } ] } ] ) ,
{ NumLines , AccessP } = term_to_paragraph ( Access , 80 ) ,
2009-01-19 12:59:40 +01:00
make_xhtml ( ? H1GL ( ? T ( " Access Rules " ) , " AccessRights " , " Access Rights " ) ++
2004-04-26 17:38:07 +02:00
case Res of
2009-01-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2009-01-19 16:27:07 +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
] )
2005-06-20 05:18:13 +02:00
] , Host , Lang ) ;
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 ,
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-19 12:59:40 +01:00
make_xhtml ( ? H1GL ( ? T ( " Access Rules " ) , " AccessRights " , " Access Rights " ) ++
2004-04-26 17:38:07 +02:00
case Res of
2009-01-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'p' , [ ? ACT ( " ../access-raw/ " , " Raw " ) ] ) ] ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( '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
] )
2005-06-20 05:18:13 +02:00
] , Host , Lang ) ;
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 ,
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 ,
2008-10-13 17:36:43 +02:00
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-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( '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
] )
2005-06-20 05:18:13 +02:00
] , Host , Lang ) ;
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 " ] ,
lang = Lang } ) - >
2005-07-29 22:34:57 +02:00
Res = list_vhosts ( Lang ) ,
2009-01-19 12:59:40 +01:00
make_xhtml ( ? H1GL ( ? T ( " ejabberd virtual hosts " ) , " virtualhost " , " Virtual Hosting " ) ++ Res , global , Lang ) ;
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 ,
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 ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Users " ) ] ++ Res , Host , Lang ) ;
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 ] ,
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 ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Users " ) ] ++ Res , Host , Lang ) ;
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 " ] ,
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 ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Online Users " ) ] ++ Res , Host , Lang ) ;
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 " ] ,
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 ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Users Last Activity " ) ] ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2005-05-09 01:39:46 +02:00
[ ? CT ( " Period: " ) ,
2009-01-21 14:34:26 +01:00
? XAE ( 'select' , [ ? XMLATTR ( 'name' , < < " period " > > ) ] ,
2005-05-09 01:39:46 +02:00
lists : map (
fun ( { O , V } ) - >
Sel = if
2009-01-21 14:34:26 +01:00
O == Month - > [ ? XMLATTR ( 'selected' , < < " selected " > > ) ] ;
2005-05-09 01:39:46 +02:00
true - > [ ]
end ,
2008-10-13 17:36:43 +02:00
? XAC ( 'option' ,
2009-01-21 14:34:26 +01:00
Sel ++ [ ? XMLATTR ( 'value' , O ) ] , V )
2005-05-09 01:39:46 +02:00
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 " )
] ) ] ++
2005-06-20 05:18:13 +02:00
Res , Host , Lang ) ;
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 " ] ,
lang = Lang } ) - >
2005-06-20 05:18:13 +02:00
Res = get_stats ( Host , Lang ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Statistics " ) ] ++ Res , Host , Lang ) ;
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 ] ,
2004-05-04 21:47:24 +02:00
q = Query ,
2007-12-07 02:40:24 +01:00
lang = Lang } ) - >
2008-10-13 12:11:19 +02:00
case ejabberd_auth : is_user_exists ( U , Host ) of
true - >
Res = user_info ( U , Host , Query , Lang ) ,
make_xhtml ( Res , Host , Lang ) ;
false - >
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Not Found " ) ] , Host , Lang )
2008-10-13 12:11:19 +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 " ] ,
lang = Lang } ) - >
2004-05-09 20:38:49 +02:00
Res = get_nodes ( Lang ) ,
2005-06-20 05:18:13 +02:00
make_xhtml ( Res , Host , Lang ) ;
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 ] ,
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 - >
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Node not found " ) ] , Host , Lang ) ;
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 ) ,
2008-10-13 12:11:19 +02:00
make_xhtml ( Res , Host , Node , Lang )
2004-05-14 16:46:53 +02:00
end ;
2007-08-23 02:51:54 +02:00
process_admin ( Host , #request { lang = Lang } = Request ) - >
{ Hook , Opts } = case Host of
global - > { webadmin_page_main , [ Request ] } ;
Host - > { webadmin_page_host , [ Host , Request ] }
end ,
2009-02-18 19:03:11 +01:00
case ejabberd_hooks : run_fold ( Hook , list_to_binary ( Host ) , [ ] , Opts ) of
2008-10-13 17:36:43 +02:00
[ ] - > setelement ( 1 , make_xhtml ( [ ? XC ( 'h1' , " Not Found " ) ] , Host , Lang ) , 404 ) ;
2007-08-23 02:51:54 +02:00
Res - > make_xhtml ( Res , Host , Lang )
end .
2004-04-26 17:38:07 +02:00
acls_to_xhtml ( ACLs ) - >
2008-10-13 17:36:43 +02:00
? XAE ( 'table' , [ ] ,
[ ? XE ( 'tbody' ,
2004-04-26 17:38:07 +02:00
lists : map (
fun ( { acl , Name , Spec } = ACL ) - >
SName = atom_to_list ( Name ) ,
ID = term_to_id ( ACL ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XE ( 'td' , [ ? INPUT ( " checkbox " , " selected " , ID ) ] ) ,
? XC ( 'td' , SName ) ] ++
2004-04-26 17:38:07 +02:00
acl_spec_to_xhtml ( ID , Spec )
)
end , ACLs ) ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'tr' ,
[ ? X ( 'td' ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " namenew " , " " ) ] )
2004-04-26 17:38:07 +02:00
] ++
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 ) - >
2008-10-13 17:36:43 +02:00
? XE ( 'td' ,
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'select' , [ ? XMLATTR ( 'name' , " type " ++ ID ) ] ,
2004-04-26 17:38:07 +02:00
lists : map (
fun ( O ) - >
Sel = if
2009-01-21 14:34:26 +01:00
O == Opt - > [ ? XMLATTR ( 'selected' , < < " selected " > > ) ] ;
2004-04-26 17:38:07 +02:00
true - > [ ]
end ,
2008-10-13 17:36:43 +02:00
? XAC ( 'option' ,
2009-01-21 14:34:26 +01:00
Sel ++ [ ? XMLATTR ( 'value' , O ) ] ,
2004-04-26 17:38:07 +02:00
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-19 16:27:07 +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-22 16:50:43 +01:00
%% @spec (T::any(), Cols::integer()) -> {NumLines::integer(), Paragraph::string()}
2009-01-19 16:27:07 +01:00
term_to_paragraph ( T , Cols ) - >
Merge from trunk: 1835, 1836, 1842, 1843, 1854, 1858, 1860, 1861, and 1862.
* doc/Makefile: In Clean do not remove html. In new Distclean,
remove also html.
* doc/Makefile: When cleaning, remove contributed_modules.tex
* src/Makefile.in: Fix arguments to Install program
* doc/guide.tex: Provide only an example of language option
* doc/guide.html: Likewise
* doc/guide.tex: mod_muc can run in several nodes of cluster
* doc/guide.html: Likewise
* doc/api/process-one.css: Add some style to HTML elements
* src/ejabberd_listener.erl: Fix EDoc errors
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberd_hooks.erl: Explanation in EDoc of some functions
* doc/guide.tex: Explain that account creation is only supported
by internal and odbc authentication methods
* doc/guide.html: Likewise
* src/Makefile.in: The path to the installed copy of ejabberd
Guide is set in the environment variable
EJABBERD_DOC_PATH (EJAB-837).
* src/web/ejabberd_web_admin.erl: Likewise
* src/ejabberdctl.template: Likewise
* doc/guide.tex: Likewise
* doc/guide.html: Likewise
SVN Revision: 1937
2009-03-03 19:11:23 +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-19 16:27:07 +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 ) - >
2009-06-01 18:35:55 +02:00
JID = exmpp_jid : parse ( Val ) ,
2009-06-01 18:40:51 +02:00
U = exmpp_jid : prep_node_as_list ( JID ) ,
2009-06-01 18:38:28 +02:00
S = exmpp_jid : prep_domain_as_list ( JID ) ,
2009-01-21 14:34:26 +01:00
undefined = exmpp_jid : resource ( JID ) ,
2007-12-06 19:54:18 +01:00
{ 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 ) - >
2009-06-01 18:35:55 +02:00
JID = exmpp_jid : parse ( Val ) ,
2009-06-01 18:40:51 +02:00
U = exmpp_jid : prep_node_as_list ( JID ) ,
2009-06-01 18:38:28 +02:00
S = exmpp_jid : prep_domain_as_list ( JID ) ,
2009-01-21 14:34:26 +01:00
undefined = exmpp_jid : resource ( JID ) ,
2007-12-06 19:54:18 +01:00
{ 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 ) - >
2009-06-01 18:35:55 +02:00
JID = exmpp_jid : parse ( Val ) ,
2009-06-01 18:40:51 +02:00
U = exmpp_jid : prep_node_as_list ( JID ) ,
2009-06-01 18:38:28 +02:00
S = exmpp_jid : prep_domain_as_list ( JID ) ,
2009-01-21 14:34:26 +01:00
undefined = exmpp_jid : resource ( JID ) ,
2008-02-12 02:16:11 +01:00
case U of
2009-01-21 14:34:26 +01:00
undefined - >
2008-02-12 02:16:11 +01:00
{ 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 ) - >
2008-10-13 17:36:43 +02:00
? XAE ( 'table' , [ ] ,
[ ? XE ( 'tbody' ,
2004-04-26 17:38:07 +02:00
lists : map (
fun ( { access , Name , Rules } = Access ) - >
SName = atom_to_list ( Name ) ,
ID = term_to_id ( Access ) ,
2009-05-27 19:29:58 +02:00
? XE ( 'tr' ,
2008-10-13 17:36:43 +02:00
[ ? XE ( 'td' , [ ? INPUT ( " checkbox " , " selected " , ID ) ] ) ,
? XE ( 'td' , [ ? AC ( SName ++ " / " , SName ) ] ) ,
? XC ( 'td' , term_to_string ( Rules ) )
2004-04-26 17:38:07 +02:00
]
)
2009-05-27 19:29:58 +02:00
end , lists : sort ( AccessRules ) ) ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'tr' ,
[ ? X ( 'td' ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " namenew " , " " ) ] ) ,
? 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-19 16:27:07 +01:00
SAccess ++ " \s \t " ++ SACL ++ " \n "
2004-04-26 17:38:07 +02:00
end , Rules ) ,
2009-05-27 19:29:58 +02:00
? XAC ( 'textarea' , [ ? XMLATTR ( 'name' , < < " rules " > > ) ,
? XMLATTR ( 'rows' , < < " 16 " > > ) ,
? XMLATTR ( 'cols' , < < " 80 " > > ) ] ,
2004-04-26 17:38:07 +02:00
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 .
2005-07-29 22:34:57 +02:00
list_vhosts ( Lang ) - >
Hosts = ? MYHOSTS ,
SHosts = lists : sort ( Hosts ) ,
2008-10-13 17:36:43 +02:00
[ ? XE ( 'table' ,
[ ? XE ( 'thead' ,
[ ? XE ( 'tr' ,
[ ? XCT ( 'td' , " Host " ) ,
? XCT ( 'td' , " Registered Users " ) ,
? XCT ( 'td' , " Online Users " )
2005-07-29 22:34:57 +02:00
] ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tbody' ,
2005-07-29 22:34:57 +02:00
lists : map (
fun ( Host ) - >
OnlineUsers =
2009-02-18 19:03:11 +01:00
length ( ejabberd_sm : get_vh_session_list ( list_to_binary ( Host ) ) ) ,
2005-07-29 22:34:57 +02:00
RegisteredUsers =
2007-05-12 20:14:21 +02:00
ejabberd_auth : get_vh_registered_users_number ( Host ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XE ( 'td' , [ ? AC ( " ../server/ " ++ Host ++ " / " , Host ) ] ) ,
2009-03-03 19:29:53 +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
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 - >
2005-09-29 03:04:24 +02:00
[ list_given_users ( 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-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-10-05 21:31:17 +02:00
nothing - > [ ]
end ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XE ( 'table' ,
[ ? XE ( 'tr' ,
[ ? XC ( 'td' , ? T ( " User " ) ++ " : " ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " newusername " , " " ) ] ) ,
? XE ( 'td' , [ ? C ( [ " @ " , Host ] ) ] )
2004-10-05 21:31:17 +02:00
] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XC ( 'td' , ? T ( " Password " ) ++ " : " ) ,
? XE ( 'td' , [ ? INPUT ( " password " , " newuserpassword " , " " ) ] ) ,
? X ( 'td' )
2004-10-05 21:31:17 +02:00
] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? X ( 'td' ) ,
2009-01-21 14:34:26 +01:00
? XAE ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2006-07-07 10:06:12 +02:00
[ ? INPUTT ( " submit " , " addnewuser " , " Add User " ) ] ) ,
2008-10-13 17:36:43 +02:00
? 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 ) ,
2008-10-13 17:36:43 +02:00
try
2009-06-01 18:35:55 +02:00
JID = exmpp_jid : parse ( Username ++ " @ " ++ Host ) ,
2009-02-20 16:30:16 +01:00
User = exmpp_jid : node_as_list ( JID ) ,
Server = exmpp_jid : domain_as_list ( JID ) ,
2008-10-13 17:36:43 +02:00
case ejabberd_auth : try_register ( User , Server , Password ) of
{ error , _ Reason } - >
error ;
_ - >
ok
end
catch
_ - >
error
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 ) ,
2005-09-29 03:04:24 +02:00
[ list_given_users ( Sub , " ../../ " , Lang , URLFunc ) ] .
2004-10-05 21:31:17 +02:00
2005-09-29 03:04:24 +02:00
list_given_users ( Users , Prefix , Lang , URLFunc ) - >
2008-10-13 17:36:43 +02:00
? XE ( 'table' ,
[ ? XE ( 'thead' ,
[ ? XE ( 'tr' ,
[ ? XCT ( 'td' , " User " ) ,
? XCT ( 'td' , " Offline Messages " ) ,
? XCT ( 'td' , " Last Activity " ) ] ) ] ) ,
? XE ( 'tbody' ,
2004-10-05 21:31:17 +02:00
lists : map (
2007-12-07 02:40:24 +01:00
fun ( _ SU = { Server , User } ) - >
2009-02-18 19:03:11 +01:00
ServerB = list_to_binary ( Server ) ,
UserB = list_to_binary ( User ) ,
US = { UserB , ServerB } ,
FQueueLen = try
QueueLen = length ( mnesia : dirty_read ( { offline_msg , US } ) ) ,
[ ? AC ( URLFunc ( { users_queue , Prefix ,
User , Server } ) ,
2009-03-03 19:29:53 +01:00
pretty_string_int ( QueueLen ) ) ]
2009-02-18 19:03:11 +01:00
catch
_ : _ - > [ #xmlcdata { cdata = < < " Can't access the offline messages storage. " > > } ]
end ,
2004-10-05 21:31:17 +02:00
FLast =
2009-02-18 19:03:11 +01:00
case ejabberd_sm : get_user_resources ( UserB , ServerB ) of
2004-10-05 21:31:17 +02:00
[ ] - >
2005-04-17 20:08:34 +02:00
case mnesia : dirty_read ( { last_activity , US } ) of
2004-10-05 21:31:17 +02:00
[ ] - >
? T ( " Never " ) ;
[ E ] - >
Shift = element ( 3 , E ) ,
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 ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XE ( 'td' ,
2005-11-22 19:25:02 +01:00
[ ? AC ( URLFunc ( { user , Prefix ,
ejabberd_http : url_encode ( User ) ,
Server } ) ,
us_to_list ( US ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , FQueueLen ) ,
? XC ( 'td' , FLast ) ] )
2004-10-05 21:31:17 +02:00
end , Users )
) ] ) .
2004-04-26 17:38:07 +02:00
2005-04-17 20:08:34 +02:00
us_to_list ( { User , Server } ) - >
2009-06-01 18:52:14 +02:00
exmpp_jid : to_list ( User , Server , undefined ) .
2005-04-17 20:08:34 +02:00
su_to_list ( { Server , User } ) - >
2009-06-01 18:52:14 +02:00
exmpp_jid : to_list ( User , Server , undefined ) .
2005-04-17 20:08:34 +02:00
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 ] ) ) ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'table' , [ ] ,
[ ? XE ( 'tbody' ,
[ ? XE ( 'tr' , [ ? XCT ( 'td' , " Registered Users: " ) ,
2009-03-03 19:29:53 +01:00
? XC ( 'td' , pretty_string_int ( RegisteredUsers ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Online Users: " ) ,
2009-03-03 19:29:53 +01:00
? XC ( 'td' , pretty_string_int ( OnlineUsers ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Outgoing s2s Connections: " ) ,
2009-03-03 19:29:53 +01:00
? XC ( 'td' , pretty_string_int ( S2SConnections ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Outgoing s2s Servers: " ) ,
2009-03-03 19:29:53 +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 ) - >
2009-02-18 19:03:11 +01:00
OnlineUsers = length ( ejabberd_sm : get_vh_session_list ( list_to_binary ( Host ) ) ) ,
2007-05-12 20:14:21 +02:00
RegisteredUsers = ejabberd_auth : get_vh_registered_users_number ( Host ) ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'table' , [ ] ,
[ ? XE ( 'tbody' ,
[ ? XE ( 'tr' , [ ? XCT ( 'td' , " Registered Users: " ) ,
2009-03-03 19:29:53 +01:00
? XC ( 'td' , pretty_string_int ( RegisteredUsers ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Online Users: " ) ,
2009-03-03 19:29:53 +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 ) - >
2009-02-18 19:03:11 +01:00
Users = [ { S , U } | | { U , S , _ R } < - ejabberd_sm : get_vh_session_list ( list_to_binary ( 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 ) - >
2009-02-18 19:03:11 +01:00
[ ? AC ( " ../user/ " ++ ejabberd_http : url_encode ( binary_to_list ( U ) ) ++ " / " ,
2005-11-22 19:25:02 +01:00
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 ) - >
2009-02-18 19:03:11 +01:00
UserB = list_to_binary ( User ) ,
ServerB = list_to_binary ( Server ) ,
2008-10-13 17:36:43 +02:00
LServer = exmpp_stringprep : nameprep ( Server ) ,
US = { exmpp_stringprep : nodeprep ( User ) , LServer } ,
2005-04-17 20:08:34 +02:00
Res = user_parse_query ( User , Server , Query ) ,
2009-02-18 19:03:11 +01:00
Resources = ejabberd_sm : get_user_resources ( UserB , ServerB ) ,
2004-05-04 21:47:24 +02:00
FResources =
case Resources of
[ ] - >
[ ? CT ( " None " ) ] ;
_ - >
2008-10-13 17:36:43 +02:00
[ ? XE ( 'ul' ,
2004-05-04 21:47:24 +02:00
lists : map ( fun ( R ) - >
2009-01-19 12:16:44 +01:00
FIP = case ejabberd_sm : get_user_info (
2009-02-18 19:03:11 +01:00
UserB , ServerB , R ) of
2009-01-19 12:16:44 +01:00
offline - >
2007-06-10 20:13:37 +02:00
" " ;
2009-01-19 12:16:44 +01:00
[ { node , Node } , { conn , Conn } , { ip , { IP , Port } } ] - >
ConnS = case Conn of
c2s - > " plain " ;
c2s_tls - > " tls " ;
c2s_compressed - > " zlib " ;
http_bind - > " http-bind " ;
http_poll - > " http-poll "
end ,
2007-06-10 20:13:37 +02:00
" ( " ++
2009-01-19 12:16:44 +01:00
ConnS ++ " :// " ++
2007-06-10 20:13:37 +02:00
inet_parse : ntoa ( IP ) ++
" : " ++
integer_to_list ( Port )
2009-01-19 12:16:44 +01:00
++ " # " ++ atom_to_list ( Node )
2007-06-10 20:13:37 +02:00
++ " ) "
end ,
2009-02-18 19:03:11 +01:00
? LI ( [ ? C ( binary_to_list ( 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 " ) ] ,
2009-02-18 19:03:11 +01:00
UserItems = ejabberd_hooks : run_fold ( webadmin_user , list_to_binary ( LServer ) , [ ] ,
2007-08-23 02:51:54 +02:00
[ User , Server , Lang ] ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , ? T ( " User " ) ++ us_to_list ( US ) ) ] ++
2004-05-04 21:47:24 +02:00
case Res of
2009-01-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-05-04 21:47:24 +02:00
nothing - > [ ]
end ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XCT ( 'h3' , " Connected Resources: " ) ] ++ FResources ++
[ ? XCT ( 'h3' , " Password: " ) ] ++ FPassword ++
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-13 12:11:19 +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 ) - >
2009-02-18 19:03:11 +01:00
case ejabberd_hooks : run_fold ( webadmin_user_parse_query , list_to_binary ( Server ) , [ ] , [ Action , User , Server , Query ] ) of
2008-10-13 12:11:19 +02:00
[ ] - > 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 ) ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'ol' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'id' , < < " lastactivity " > > ) , ? XMLATTR ( 'start' , < < " 0 " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'li' ,
2009-01-21 14:34:26 +01:00
[ ? XMLATTR ( 'style' ,
2005-05-28 00:52:50 +02:00
" width: " ++ integer_to_list (
2009-01-21 14:34:26 +01:00
trunc ( 90 * V / Max ) ) ++ " %; " ) ] ,
2009-03-03 19:29:53 +01:00
[ #xmlcdata { cdata = list_to_binary ( 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 .
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 - >
2008-10-13 17:36:43 +02:00
? XE ( 'ul' ,
2004-05-14 16:46:53 +02:00
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 - >
2008-10-13 17:36:43 +02:00
? XE ( 'ul' ,
2004-05-14 16:46:53 +02:00
lists : map (
fun ( N ) - >
S = atom_to_list ( N ) ,
? LI ( [ ? C ( S ) ] )
end , lists : sort ( StoppedNodes ) ) )
end ,
2008-10-13 17:36:43 +02:00
[ ? XCT ( 'h1' , " Nodes " ) ,
? XCT ( 'h3' , " Running Nodes " ) ,
2004-05-14 16:46:53 +02:00
FRN ,
2008-10-13 17:36:43 +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-13 12:11:19 +02:00
Base = get_base_path ( global , Node ) ,
MenuItems2 = make_menu_items ( global , Node , Base , Lang ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , ? T ( " Node " ) ++ atom_to_list ( Node ) ) ] ++
2004-05-22 21:48:35 +02:00
case Res of
2009-01-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2004-05-22 21:48:35 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'ul' ,
2008-10-13 12:11:19 +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 ) ,
2009-01-21 14:34:26 +01:00
? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? INPUTT ( 'submit' , " restart " , " Restart " ) ,
2004-05-22 21:48:35 +02:00
? C ( " " ) ,
2008-10-13 17:36:43 +02:00
? INPUTT ( 'submit' , " stop " , " Stop " ) ] )
2004-05-22 21:48:35 +02:00
] ;
2004-05-14 16:46:53 +02:00
2007-12-07 02:40:24 +01:00
get_node ( Host , Node , [ ] , _ Query , Lang ) - >
2008-10-13 12:11:19 +02:00
Base = get_base_path ( Host , Node ) ,
2009-03-03 19:24:42 +01:00
MenuItems2 = make_menu_items ( Host , Node , Base , Lang ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , ? T ( " Node " ) ++ atom_to_list ( Node ) ) ,
? XE ( 'ul' ,
2008-10-13 12:11:19 +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 } - >
2008-10-13 17:36:43 +02:00
[ ? XCT ( 'h1' , " RPC Call Error " ) ] ;
2004-05-14 16:46:53 +02:00
Tables - >
2009-01-19 16:27:07 +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 ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XC ( 'td' , STable ) ,
? XE ( 'td' , [ db_storage_select (
2004-05-16 22:13:38 +02:00
STable , Type , Lang ) ] ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2009-03-03 19:29:53 +01:00
pretty_string_int ( Size ) ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2009-03-03 19:29:53 +01:00
pretty_string_int ( Memory ) )
2004-05-14 16:46:53 +02:00
] )
end , STables ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , ? T ( " Database Tables at " ) ++ atom_to_list ( Node ) ) ] ++
2009-01-19 16:27:07 +01:00
ResS ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'table' , [ ] ,
[ ? XE ( 'thead' ,
[ ? XE ( 'tr' ,
[ ? XCT ( 'td' , " Name " ) ,
? XCT ( 'td' , " Storage Type " ) ,
? XCT ( 'td' , " Size " ) ,
? XCT ( 'td' , " Memory " )
2004-05-16 22:13:38 +02:00
] ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tbody' ,
2004-05-16 22:13:38 +02:00
Rows ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'tr' ,
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'td' , [ ? XMLATTR ( 'colspan' , < < " 4 " > > ) ,
? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2004-05-16 22:13:38 +02:00
[ ? 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-01-19 16:27:07 +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. " ) ,
2009-01-21 14:34:26 +01:00
? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'table' , [ ] ,
[ ? XE ( 'tbody' ,
[ ? XE ( 'tr' ,
[ ? XCT ( 'td' , " Store binary backup: " ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " storepath " ,
2004-05-16 22:13:38 +02:00
" ejabberd.backup " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " store " ,
2004-05-16 22:13:38 +02:00
" OK " ) ] )
] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XCT ( 'td' , " Restore binary backup immediately: " ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " restorepath " ,
2004-05-16 22:13:38 +02:00
" ejabberd.backup " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " restore " ,
2004-05-16 22:13:38 +02:00
" OK " ) ] )
] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XCT ( 'td' ,
2006-02-18 20:56:16 +01:00
" Restore binary backup after next ejabberd restart (requires less memory): " ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUT ( " text " , " fallbackpath " ,
2004-05-16 22:13:38 +02:00
" ejabberd.backup " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " fallback " ,
2004-05-16 22:13:38 +02:00
" OK " ) ] )
] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XCT ( 'td' , " Store plain text backup: " ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " dumppath " ,
2004-05-16 22:13:38 +02:00
" ejabberd.dump " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " dump " ,
2004-05-16 22:13:38 +02:00
" OK " ) ] )
] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XCT ( 'td' , " Restore plain text backup immediately: " ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " loadpath " ,
2004-05-16 22:13:38 +02:00
" ejabberd.dump " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " load " ,
2004-05-16 22:13:38 +02:00
" OK " ) ] )
] )
] )
] ) ] ) ] ;
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-19 16:27:07 +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-19 16:27:07 +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-19 12:59:40 +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-19 16:27:07 +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 ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( '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-19 12:59:40 +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-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2005-05-23 02:30:29 +02:00
nothing - > [ ]
end ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( '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-19 16:27:07 +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 ] ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , io_lib : format ( ? T ( " Statistics of ~p " ) , [ Node ] ) ) ,
? XAE ( 'table' , [ ] ,
[ ? XE ( 'tbody' ,
[ ? XE ( 'tr' , [ ? XCT ( 'td' , " Uptime: " ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2004-05-22 21:48:35 +02:00
UpTimeS ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " CPU Time: " ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2004-05-22 21:48:35 +02:00
CPUTimeS ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Online Users: " ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2009-03-03 19:29:53 +01:00
pretty_string_int ( OnlineUsers ) ) ] ) ,
2009-01-19 16:27:07 +01:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Committed: " ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2009-03-03 19:29:53 +01:00
pretty_string_int ( TransactionsCommitted ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Aborted: " ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2009-03-03 19:29:53 +01:00
pretty_string_int ( TransactionsAborted ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Restarted: " ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2009-03-03 19:29:53 +01:00
pretty_string_int ( TransactionsRestarted ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Logged: " ) ,
2009-01-21 14:34:26 +01:00
? XAC ( 'td' , [ ? XMLATTR ( 'class' , < < " alignright " > > ) ] ,
2009-03-03 19:29:53 +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:29:43 +02:00
BeamsLis =
lists : map (
fun ( Beam ) - >
BeamString = atom_to_list ( Beam ) ,
? LI ( [
? INPUT ( " checkbox " , " selected " , BeamString ) ,
%% If we want checkboxes selected by default:
%%?XA("input", [{"checked", ""},
%% {"type", "checkbox"},
%% {"name", "selected"},
%% {"value", BeamString}]),
? C ( BeamString ) ] )
end ,
UpdatedBeams ) ,
SelectButtons =
[ ? BR ,
? INPUTATTRS ( < < " button " > > , < < " selectall " > > ,
< < " Select All " > > ,
[ ? XMLATTR ( 'onClick' , < < " selectAll() " > > ) ] ) ,
? C ( " " ) ,
? INPUTATTRS ( < < " button " > > , < < " unselectall " > > ,
< < " Unselect All " > > ,
[ ? XMLATTR ( 'onClick' , < < " unSelectAll() " > > ) ] ) ] ,
%%?XE("ul", BeamsLis)
? XAE ( 'ul' , [ ? XMLATTR ( 'class' , < < " noliststyle " > > ) ] ,
BeamsLis ++ SelectButtons )
2006-02-27 05:43:16 +01:00
end ,
2008-10-13 17:36:43 +02:00
FmtScript = ? XC ( 'pre' , io_lib : format ( " ~p " , [ Script ] ) ) ,
FmtLowLevelScript = ? XC ( 'pre' , io_lib : format ( " ~p " , [ LowLevelScript ] ) ) ,
[ ? XC ( 'h1' , ? T ( " Update " ) ++ atom_to_list ( Node ) ) ] ++
2006-02-27 05:43:16 +01:00
case Res of
2009-01-19 16:27:07 +01:00
ok - > [ ? XREST ( " Submitted " ) ] ;
error - > [ ? XREST ( " Bad format " ) ] ;
2006-02-27 05:43:16 +01:00
nothing - > [ ]
end ++
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'form' , [ ? XMLATTR ( 'action' , < < > > ) , ? XMLATTR ( 'method' , < < " post " > > ) ] ,
2009-01-19 16:27:07 +01:00
[
2008-10-13 17:36:43 +02:00
? XCT ( 'h2' , " Update plan " ) ,
2009-01-19 16:27:07 +01:00
? XCT ( 'h3' , " Modified modules " ) , Mods ,
2008-10-13 17:36:43 +02:00
? XCT ( 'h3' , " Update script " ) , FmtScript ,
? XCT ( 'h3' , " Low level update script " ) , FmtLowLevelScript ,
2009-01-19 16:27:07 +01:00
? XCT ( 'h3' , " Script check " ) , ? XC ( " pre " , atom_to_list ( Check ) ) ,
2009-05-27 19:29:43 +02:00
? BR ,
2009-01-19 16:27:07 +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 ,
2009-02-18 19:03:11 +01:00
case ejabberd_hooks : run_fold ( Hook , list_to_binary ( Host ) , [ ] , Opts ) of
2008-10-13 17:36:43 +02:00
[ ] - > [ ? XC ( 'h1' , " Not Found " ) ] ;
2007-08-23 02:51:54 +02:00
Res - > Res
end .
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 ) - >
2009-01-21 14:34:26 +01:00
? XAE ( 'select' , [ ? XMLATTR ( 'name' , " table " ++ ID ) ] ,
2004-05-14 16:46:53 +02:00
lists : map (
fun ( { O , Desc } ) - >
Sel = if
2009-01-21 14:34:26 +01:00
O == Opt - > [ ? XMLATTR ( 'selected' , < < " selected " > > ) ] ;
2004-05-14 16:46:53 +02:00
true - > [ ]
end ,
2008-10-13 17:36:43 +02:00
? XACT ( 'option' ,
2009-01-21 14:34:26 +01:00
Sel ++ [ ? XMLATTR ( 'value' , O ) ] ,
2004-05-14 16:46:53 +02:00
Desc )
end , [ { ram_copies , " RAM copy " } ,
{ disc_copies , " RAM and disc copy " } ,
{ disc_only_copies , " Disc only copy " } ,
{ unknown , " Remote copy " } ] ) ) .
2004-05-09 20:38:49 +02:00
2009-01-19 16:27:07 +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 ;
_ - > false
end ,
if
Type == false - >
ok ;
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-19 16:27:07 +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-13 12:11:19 +02:00
rpc : call ( Node , ejabberd_admin ,
2004-05-22 21:48:35 +02:00
dump_to_textfile , [ Path ] ) ;
" load " - >
rpc : call ( Node , mnesia ,
load_textfile , [ Path ] )
end ,
case Res of
2009-01-19 16:27:07 +01:00
{ error , Reason } - >
{ error , Reason } ;
{ badrpc , Reason } - >
{ badrpc , Reason } ;
2004-05-22 21:48:35 +02:00
_ - >
ok
end ;
2009-01-19 16:27:07 +01:00
OtherError - >
{ error , OtherError }
2004-05-22 21:48:35 +02:00
end ;
_ - >
nothing
end ;
( _ Action , Res ) - >
Res
end , nothing , [ " store " , " restore " , " fallback " , " dump " , " load " ] ) .
2004-06-17 23:29:24 +02:00
node_ports_to_xhtml ( Ports , Lang ) - >
2009-01-21 14:34:26 +01:00
? XAE ( 'table' , [ ? XMLATTR ( 'class' , < < " withtextareas " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XE ( 'thead' ,
[ ? XE ( 'tr' ,
[ ? XCT ( 'td' , " Port " ) ,
2009-01-19 16:27:07 +01:00
? XCT ( 'td' , " IP " ) ,
2008-10-13 17:36:43 +02:00
? XCT ( 'td' , " Module " ) ,
? XCT ( 'td' , " Options " )
2004-06-17 23:29:24 +02:00
] ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tbody' ,
2004-06-17 23:29:24 +02:00
lists : map (
2009-01-19 16:27:07 +01:00
fun ( { PortIP , Module , Opts } = _ E ) - >
{ _ Port , SPort , _ TIP , SIP , SSPort , OptsClean } =
get_port_data ( PortIP , Opts ) ,
2004-06-17 23:29:24 +02:00
SModule = atom_to_list ( Module ) ,
2009-01-19 16:27:07 +01:00
{ NumLines , SOptsClean } = term_to_paragraph ( OptsClean , 40 ) ,
2007-12-07 02:40:24 +01:00
%%ID = term_to_id(E),
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
2009-01-21 14:34:26 +01:00
[ ? XAE ( 'td' , [ ? XMLATTR ( 'size' , < < " 6 " > > ) ] , [ ? C ( SPort ) ] ) ,
? XAE ( 'td' , [ ? XMLATTR ( 'size' , < < " 15 " > > ) ] , [ ? C ( SIP ) ] ) ,
2009-01-19 16:27:07 +01:00
? XE ( 'td' , [ ? INPUTS ( " text " , " module " ++ SSPort ,
SModule , " 15 " ) ] ) ,
? XE ( 'td' , [ ? TEXTAREA ( " opts " ++ SSPort , integer_to_list ( NumLines ) , " 35 " , SOptsClean ) ] ) ,
? XE ( 'td' , [ ? INPUTT ( " submit " , " add " ++ SSPort ,
2004-06-17 23:29:24 +02:00
" Update " ) ] ) ,
2009-01-19 16:27:07 +01:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " delete " ++ SSPort ,
2004-06-17 23:29:24 +02:00
" Delete " ) ] )
]
)
end , Ports ) ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'tr' ,
[ ? XE ( 'td' , [ ? INPUTS ( " text " , " portnew " , " " , " 6 " ) ] ) ,
2009-01-19 16:27:07 +01:00
? XE ( 'td' , [ ? INPUTS ( " text " , " ipnew " , " 0.0.0.0 " , " 15 " ) ] ) ,
? XE ( 'td' , [ ? INPUTS ( " text " , " modulenew " , " " , " 15 " ) ] ) ,
? XE ( 'td' , [ ? TEXTAREA ( " optsnew " , " 2 " , " 35 " , " [] " ) ] ) ,
2009-02-18 19:03:11 +01:00
? XAE ( 'td' , [ ? XMLATTR ( " colspan " , " 2 " ) ] ,
2004-06-17 23:29:24 +02:00
[ ? INPUTT ( " submit " , " addnew " , " Add New " ) ] )
]
) ]
) ] ) .
2009-01-19 16:27:07 +01:00
get_port_data ( PortIP , Opts ) - >
{ Port , IPT , IPS , _ IPV , OptsClean } = ejabberd_listener : parse_listener_portip ( PortIP , Opts ) ,
SPort = io_lib : format ( " ~p " , [ Port ] ) ,
SSPort = lists : flatten (
lists : map (
fun ( N ) - > io_lib : format ( " ~.16b " , [ N ] ) end ,
binary_to_list ( crypto : md5 ( SPort ++ IPS ) ) ) ) ,
{ Port , SPort , IPT , IPS , SSPort , OptsClean } .
2004-06-17 23:29:24 +02:00
node_ports_parse_query ( Node , Ports , Query ) - >
lists : foreach (
2009-01-19 16:27:07 +01:00
fun ( { PortIP , Module1 , Opts1 } ) - >
{ Port , _ SPort , TIP , _ SIP , SSPort , _ OptsClean } =
get_port_data ( PortIP , Opts1 ) ,
case lists : keysearch ( " add " ++ SSPort , 1 , Query ) of
2004-06-17 23:29:24 +02:00
{ value , _ } - >
2009-01-19 16:27:07 +01:00
PortIP2 = { Port , TIP } ,
2004-06-17 23:29:24 +02:00
{ { value , { _ , SModule } } , { value , { _ , SOpts } } } =
2009-01-19 16:27:07 +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-19 16:27:07 +01:00
rpc : call ( Node , ejabberd_listener , delete_listener ,
[ PortIP2 , Module1 ] ) ,
R = rpc : call ( Node , ejabberd_listener , add_listener ,
[ PortIP2 , Module , Opts ] ) ,
throw ( { is_added , R } ) ;
2004-06-17 23:29:24 +02:00
_ - >
2009-01-19 16:27:07 +01:00
case lists : keysearch ( " delete " ++ SSPort , 1 , Query ) of
2004-06-17 23:29:24 +02:00
{ value , _ } - >
2009-01-19 16:27:07 +01:00
rpc : call ( Node , ejabberd_listener , delete_listener ,
[ PortIP , 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-19 16:27:07 +01:00
{ value , { _ , STIP } } , %% It is a string that may represent a tuple
2004-06-17 23:29:24 +02:00
{ value , { _ , SModule } } ,
{ value , { _ , SOpts } } } =
{ lists : keysearch ( " portnew " , 1 , Query ) ,
2009-01-19 16:27:07 +01:00
lists : keysearch ( " ipnew " , 1 , Query ) ,
2004-06-17 23:29:24 +02:00
lists : keysearch ( " modulenew " , 1 , Query ) ,
lists : keysearch ( " optsnew " , 1 , Query ) } ,
2009-01-19 16:27:07 +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 ) ,
{ ok , Tokens , _ } = erl_scan : string ( SOpts ++ " . " ) ,
{ ok , Opts } = erl_parse : parse_term ( Tokens ) ,
2009-01-19 16:27:07 +01:00
{ Port2 , _ SPort , IP2 , _ SIP , _ SSPort , OptsClean } =
get_port_data ( { Port2 , STIP2 } , Opts ) ,
R = rpc : call ( Node , ejabberd_listener , add_listener ,
[ { Port2 , IP2 } , Module , OptsClean ] ) ,
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-21 14:34:26 +01:00
? XAE ( 'table' , [ ? XMLATTR ( 'class' , < < " withtextareas " > > ) ] ,
2008-10-13 17:36:43 +02:00
[ ? XE ( 'thead' ,
[ ? XE ( 'tr' ,
[ ? XCT ( 'td' , " Module " ) ,
? XCT ( 'td' , " Options " )
2005-05-23 02:30:29 +02:00
] ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tbody' ,
2005-05-23 02:30:29 +02:00
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-19 16:27:07 +01:00
{ NumLines , SOpts } = term_to_paragraph ( Opts , 40 ) ,
2007-12-07 02:40:24 +01:00
%%ID = term_to_id(E),
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XC ( 'td' , SModule ) ,
2009-01-19 16:27:07 +01:00
? XE ( 'td' , [ ? TEXTAREA ( " opts " ++ SModule , integer_to_list ( NumLines ) , " 40 " , SOpts ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " restart " ++ SModule ,
2005-05-23 02:30:29 +02:00
" Restart " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " stop " ++ SModule ,
2005-05-23 02:30:29 +02:00
" Stop " ) ] )
]
)
end , Modules ) ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'tr' ,
[ ? XE ( 'td' , [ ? INPUT ( " text " , " modulenew " , " " ) ] ) ,
2009-01-19 16:27:07 +01:00
? XE ( 'td' , [ ? TEXTAREA ( " optsnew " , " 2 " , " 40 " , " [] " ) ] ) ,
2009-02-18 19:03:11 +01:00
? XAE ( 'td' , [ ? XMLATTR ( " colspan " , " 2 " ) ] ,
2005-05-23 02:30:29 +02:00
[ ? 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:29:43 +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 } - >
? ERROR_MSG ( " ~p ~n " , [ Error ] ) ;
{ badrpc , Error } - >
? ERROR_MSG ( " ~p ~n " , [ Error ] )
end ;
_ - >
nothing
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-13 12:11:19 +02:00
2009-03-03 19:29:53 +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 .
2008-10-13 12:11:19 +02:00
%%%
%%% Navigation Menu
%%%
%% @spec (Host, Node, Lang) -> [LI]
make_navigation ( Host , Node , Lang ) - >
HostNodeMenu = make_host_node_menu ( Host , Node , Lang ) ,
HostMenu = make_host_menu ( Host , HostNodeMenu , Lang ) ,
NodeMenu = make_node_menu ( Host , Node , Lang ) ,
Menu = make_server_menu ( HostMenu , NodeMenu , Lang ) ,
make_menu_items ( Lang , Menu ) .
%% @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-03-03 19:24:42 +01:00
make_menu_items ( global , Node , Base , Lang ) - >
HookItems = get_menu_items_hook ( { node , Node } , Lang ) ,
2008-10-13 12:11:19 +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-03-03 19:24:42 +01:00
make_menu_items ( Host , Node , Base , Lang ) - >
HookItems = get_menu_items_hook ( { hostnode , Host , Node } , Lang ) ,
2008-10-13 12:11:19 +02:00
make_menu_items ( Lang , { Base , " " , HookItems } ) .
make_host_node_menu ( global , _ , _ Lang ) - >
{ " " , " " , [ ] } ;
make_host_node_menu ( _ , cluster , _ Lang ) - >
{ " " , " " , [ ] } ;
make_host_node_menu ( Host , Node , Lang ) - >
HostNodeBase = get_base_path ( Host , Node ) ,
HostNodeFixed = [ { " modules/ " , " Modules " } ] ,
2009-03-03 19:24:42 +01:00
HostNodeHook = get_menu_items_hook ( { hostnode , Host , Node } , Lang ) ,
2008-10-13 12:11:19 +02:00
{ HostNodeBase , atom_to_list ( Node ) , HostNodeFixed ++ HostNodeHook } .
make_host_menu ( global , _ HostNodeMenu , _ Lang ) - >
{ " " , " " , [ ] } ;
make_host_menu ( Host , HostNodeMenu , Lang ) - >
HostBase = get_base_path ( Host , cluster ) ,
HostFixed = [ { " acls " , " Access Control Lists " } ,
{ " access " , " Access Rules " } ,
{ " users " , " Users " } ,
{ " online-users " , " Online Users " } ,
{ " last-activity " , " Last Activity " } ,
{ " nodes " , " Nodes " , HostNodeMenu } ,
{ " stats " , " Statistics " } ] ,
HostHook = get_menu_items_hook ( { host , Host } , Lang ) ,
{ HostBase , Host , HostFixed ++ HostHook } .
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 " } ,
{ " update/ " , " Update " } ] ,
2009-03-03 19:24:42 +01:00
NodeHook = get_menu_items_hook ( { node , Node } , Lang ) ,
2008-10-13 12:11:19 +02:00
{ NodeBase , atom_to_list ( Node ) , NodeFixed ++ NodeHook } ;
make_node_menu ( _ Host , _ Node , _ Lang ) - >
{ " " , " " , [ ] } .
make_server_menu ( HostMenu , NodeMenu , Lang ) - >
Base = get_base_path ( global , cluster ) ,
Fixed = [ { " acls " , " Access Control Lists " } ,
{ " access " , " Access Rules " } ,
{ " vhosts " , " Virtual Hosts " , HostMenu } ,
{ " nodes " , " Nodes " , NodeMenu } ,
{ " stats " , " Statistics " } ] ,
Hook = get_menu_items_hook ( server , Lang ) ,
{ Base , " ejabberd " , Fixed ++ Hook } .
2009-03-03 19:24:42 +01:00
get_menu_items_hook ( { hostnode , Host , Node } , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_hostnode , list_to_binary ( Host ) , [ ] , [ Host , Node , Lang ] ) ;
2008-10-13 12:11:19 +02:00
get_menu_items_hook ( { host , Host } , Lang ) - >
2009-02-18 19:03:11 +01:00
ejabberd_hooks : run_fold ( webadmin_menu_host , list_to_binary ( Host ) , [ ] , [ Host , Lang ] ) ;
2009-03-03 19:24:42 +01:00
get_menu_items_hook ( { node , Node } , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_node , [ ] , [ Node , Lang ] ) ;
2008-10-13 12:11:19 +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-21 14:34:26 +01:00
? LI ( [ ? XAE ( 'div' , [ ? XMLATTR ( 'id' , < < " navhead " > > ) ] , [ ? AC ( URI , Name ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( header , 2 , URI , Name , _ Lang ) - >
2009-01-21 14:34:26 +01:00
? LI ( [ ? XAE ( 'div' , [ ? XMLATTR ( 'id' , < < " navheadsub " > > ) ] , [ ? AC ( URI , Name ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( header , 3 , URI , Name , _ Lang ) - >
2009-01-21 14:34:26 +01:00
? LI ( [ ? XAE ( 'div' , [ ? XMLATTR ( 'id' , < < " navheadsubsub " > > ) ] , [ ? AC ( URI , Name ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( item , 1 , URI , Name , Lang ) - >
2009-01-21 14:34:26 +01:00
? LI ( [ ? XAE ( 'div' , [ ? XMLATTR ( 'id' , < < " navitem " > > ) ] , [ ? ACT ( URI , Name ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( item , 2 , URI , Name , Lang ) - >
2009-01-21 14:34:26 +01:00
? LI ( [ ? XAE ( 'div' , [ ? XMLATTR ( 'id' , < < " navitemsub " > > ) ] , [ ? ACT ( URI , Name ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( item , 3 , URI , Name , Lang ) - >
2009-01-21 14:34:26 +01:00
? LI ( [ ? XAE ( 'div' , [ ? XMLATTR ( 'id' , < < " navitemsubsub " > > ) ] , [ ? ACT ( URI , Name ) ] ) ] ) .