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
%%%
%%%
2008-09-16 16:39:57 +02:00
%%% ejabberd, Copyright (C) 2002-2008 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.
%%%
%%% 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
2007-01-25 06:53:58 +01:00
2007-12-07 02:40:24 +01:00
process ( [ " server " , SHost | RPath ] , #request { auth = Auth } = 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 - >
case get_auth ( Auth ) of
{ User , Server } - >
case acl : match_rule (
2008-10-13 17:36:43 +02:00
Host , configure , exmpp_jid : make_bare_jid ( User , Server ) ) of
2007-01-25 06:53:58 +01:00
deny - >
2008-10-13 17:36:43 +02:00
ejabberd_web : error ( not_allowed ) ;
2007-01-25 06:53:58 +01:00
allow - >
process_admin (
Host , Request #request { path = RPath ,
us = { User , Server } } )
end ;
unauthorized - >
{ 401 ,
[ { " WWW-Authenticate " , " basic realm= \" ejabberd \" " } ] ,
2008-10-13 17:36:43 +02:00
ejabberd_web : make_xhtml ( [ #xmlel { ns = ? NS_XHTML , name = 'h1' , children =
[ #xmlcdata { cdata = < < " 401 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 ;
2007-12-07 02:40:24 +01:00
process ( RPath , #request { auth = Auth } = Request ) - >
2007-01-25 06:53:58 +01:00
case get_auth ( Auth ) of
{ User , Server } - >
case acl : match_rule (
2008-10-13 17:36:43 +02:00
global , configure , exmpp_jid : make_bare_jid ( User , Server ) ) of
2007-01-25 06:53:58 +01:00
deny - >
2008-10-13 17:36:43 +02:00
ejabberd_web : error ( not_allowed ) ;
2007-01-25 06:53:58 +01:00
allow - >
process_admin (
global , Request #request { path = RPath ,
us = { User , Server } } )
end ;
unauthorized - >
2008-10-13 17:36:43 +02:00
%% XXX bard: any reason to send this data now and not
%% always in case of an 401? ought to check http specs...
2007-01-25 06:53:58 +01:00
{ 401 ,
[ { " WWW-Authenticate " , " basic realm= \" ejabberd \" " } ] ,
2008-10-13 17:36:43 +02:00
ejabberd_web : make_xhtml ( [ #xmlel { ns = ? NS_XHTML , name = 'h1' , children =
[ #xmlcdata { cdata = < < " 401 Unauthorized " > > } ] } ] ) }
2007-01-25 06:53:58 +01:00
end .
get_auth ( Auth ) - >
case Auth of
2008-10-13 17:36:43 +02:00
{ SJID , P } - >
try
#jid { node = U , domain = S } = exmpp_jid : list_to_jid ( SJID ) ,
case ejabberd_auth : check_password ( U , S , P ) of
true - >
{ U , S } ;
false - >
unauthorized
end
catch
_ - >
unauthorized
end ;
_ - >
unauthorized
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 ) .
%% @spec (Els, Host, Node, Lang)
%% 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 = [
#xmlattr { ns = ? NS_XML , name = 'lang' , value = Lang } ,
#xmlattr { name = 'lang' , value = Lang } ] , children =
[ #xmlel { ns = ? NS_XHTML , name = 'head' , children =
[ ? XCT ( 'title' , " ejabberd Web Admin " ) ,
#xmlel { ns = ? NS_XHTML , name = 'meta' , attrs = [
#xmlattr { name = 'http-equiv' , value = " Content-Type " } ,
#xmlattr { name = 'content' , value = " text/html; charset=utf-8 " } ] } ,
#xmlel { ns = ? NS_XHTML , name = 'link' , attrs = [
#xmlattr { name = 'href' , value = Base ++ " favicon.ico " } ,
#xmlattr { name = 'type' , value = " image/x-icon " } ,
#xmlattr { name = 'rel' , value = " shortcut icon " } ] } ,
#xmlel { ns = ? NS_XHTML , name = 'link' , attrs = [
#xmlattr { name = 'href' , value = Base ++ " style.css " } ,
#xmlattr { name = 'type' , value = " text/css " } ,
#xmlattr { name = 'rel' , value = " stylesheet " } ] } ] } ,
? XE ( 'body' ,
[ ? XAE ( 'div' ,
[ #xmlattr { name = 'id' , value = " container " } ] ,
[ ? XAE ( 'div' ,
[ #xmlattr { name = 'id' , value = " header " } ] ,
[ ? XE ( 'h1' ,
2007-06-22 16:04:45 +02:00
[ ? ACT ( " /admin/ " , " Administration " ) ]
2005-06-20 05:18:13 +02:00
) ] ) ,
2008-10-13 17:36:43 +02:00
? XAE ( 'div' ,
[ #xmlattr { name = 'id' , value = " navigation " } ] ,
[ ? 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' ,
[ #xmlattr { name = 'id' , value = " content " } ] ,
2005-05-09 01:39:46 +02:00
Els ) ,
2008-10-13 17:36:43 +02:00
? XAE ( 'div' ,
[ #xmlattr { name = 'id' , value = " clearcopyright " } ] ,
[ #xmlcdata { cdata = < < > > } ] ) ] ) ,
? XAE ( 'div' ,
[ #xmlattr { name = 'id' , value = " copyrightouter " } ] ,
[ ? XAE ( 'div' ,
[ #xmlattr { name = 'id' , value = " copyright " } ] ,
[ ? XC ( 'p' ,
2008-01-15 18:02:57 +01:00
" ejabberd (c) 2002-2008 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 ) ++ " / " .
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 ;
background : #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 ;
2005-05-23 02:30:29 +02:00
border - top : 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 ;
border - top : 2 px solid #d47911 ;
border - bottom : 1 px solid #d47911 ;
}
#navheadsub , #navitemsub {
border - left : 7 px solid white ;
margin - left : 2 px solid #d47911 ;
}
#navheadsubsub , #navitemsubsub {
border - left : 14 px solid white ;
margin - left : 4 px solid #d47911 ;
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 ;
vertical - align : middle ;
margin - top : 7 px ;
margin - bottom : 5 px ;
padding : 0 . 1 em ;
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 ;
}
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
2004-05-16 22:13:38 +02:00
* . alignright {
text - align : right ;
}
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 (
2005-05-09 01:39:46 +02:00
" iVBORw0KGgoAAAANSUhEUgAAAVcAAAA3CAMAAACPbPnEAAAAYFBMVEX///8C "
" AgJyMgL+vm7Wdg7+igL+/v7+slb+qkb+4sr+ojP+nir+lhr+1qb+khL+wnb+ "
" wn7+zpb+jgb+yoz+xo7+tmL+pj7+mib+jg7+5sb+rlL+rkr+mh7+tl7+2q7+ "
" umpJ0uikAAAAAXRSTlMAQObYZgAAAAFiS0dEAIgFHUgAAAAJcEhZcwAACxIA "
" AAsSAdLdfvwAAAAHdElNRQfUBAUJBhWzc9qJAAABQ0lEQVR42u2bXU/CQBBF "
" UUZFURAU5Ev4//+S3Ow+tFl3s6adtE3Oebghzc4DJ/Nw04WZgQczexJkz4lX "
" vOKVxKuXV6APTCFXAq94xSte8ermFYbrA6+ilemZRxGz+fxBxMydL0/Vz5an "
" vkUrPfb1IPCKV7ziFa9uXsG/DzyLPz7ndjS3tc3tSbcwPdl9tmYq3dHmk9x3 "
" r8mtiM11KfCKV7ziFa9uXmEc7wf+u6+5TtlXf62fKu9rl3wX9ibsLPCKV7zi "
" Fa9uXmF87wf67aBT6a+hp4bOehFxU0/CbgKveMUrXvHq5hXG+vuBcpss75zH "
" /VZ5X7vcb4W7q5A/wvbCXoTNhX0JvOIVr3jFq5tX4P8Fw2V6g7UQ9itsLeKm "
" fgi84hWveMWrm1egDwyX6Q3WTtinsI2wq7CjwCte8YpXvLp5BQ/utIiGbwh9 "
" RAEAAAAASUVORK5CYII= " ) .
2004-04-26 17:38:07 +02:00
logo_fill ( ) - >
jlib : decode_base64 (
2005-05-09 01:39:46 +02:00
" iVBORw0KGgoAAAANSUhEUgAAAAYAAAA3BAMAAADdxCZzAAAAHlBMVEXWdg7+ "
" igL+jg7+khL+nir+rkr+umr+yoz+1qb+5sbOf9L8AAAACXBIWXMAAA9hAAAP "
" YQGoP6dpAAAAQUlEQVQI12XDSxHAIBAFQT6BJEcsYAELWMACFtYCFnAL7zxd "
" 1c5dvhSU2BpKqBXl6R0ljYGS50R5zVC+tVD+vfE6YyUexE9x7g4AAAAASUVO "
" RK5CYII= " ) .
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 ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Administration " ) ,
? 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
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 } ) - >
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 ,
2005-06-20 05:18:13 +02:00
ACLs = lists : flatten (
io_lib : format (
" ~p . " , [ lists : keysort (
2 , ets : select ( acl , [ { { acl , { '$1' , Host } , '$2' } ,
[ ] , [ { { acl , '$1' , '$2' } } ] } ] ) ) ] ) ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Access Control Lists " ) ] ++
2004-04-26 17:38:07 +02:00
case Res of
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
[ ? XAC ( 'textarea' , [ #xmlattr { name = 'name' , value = " acls " } ,
#xmlattr { name = 'rows' , value = " 16 " } ,
#xmlattr { name = 'cols' , value = " 80 " } ] ,
2004-04-26 17:38:07 +02:00
ACLs ) ,
? 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' } } ] } ] ) ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Access Control Lists " ) ] ++
2004-04-26 17:38:07 +02:00
case Res of
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'p' , [ ? ACT ( " ../acls-raw/ " , " Raw " ) ] ) ] ++
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " 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 =
lists : flatten (
io_lib : format (
" ~p . " , [ 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' } } ] } ] ) ] ) ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Access Rules " ) ] ++
2004-04-26 17:38:07 +02:00
case Res of
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
[ ? XAC ( 'textarea' , [ #xmlattr { name = 'name' , value = " access " } ,
#xmlattr { name = 'rows' , value = " 16 " } ,
#xmlattr { name = 'cols' , value = " 80 " } ] ,
2004-04-26 17:38:07 +02:00
Access ) ,
? 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' } } ] } ] ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " Access Rules " ) ] ++
2004-04-26 17:38:07 +02:00
case Res of
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XE ( 'p' , [ ? ACT ( " ../access-raw/ " , " Raw " ) ] ) ] ++
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " 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
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-04-26 17:38:07 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " 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 ) ,
2008-10-13 17:36:43 +02:00
make_xhtml ( [ ? XCT ( 'h1' , " ejabberd virtual hosts " ) ] ++ 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 " ) ] ++
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
2005-05-09 01:39:46 +02:00
[ ? CT ( " Period: " ) ,
2008-10-13 17:36:43 +02:00
? XAE ( 'select' , [ #xmlattr { name = 'name' , value = " period " } ] ,
2005-05-09 01:39:46 +02:00
lists : map (
fun ( { O , V } ) - >
Sel = if
2008-10-13 17:36:43 +02:00
O == Month - > [ #xmlattr { name = 'selected' , value = " selected " } ] ;
2005-05-09 01:39:46 +02:00
true - > [ ]
end ,
2008-10-13 17:36:43 +02:00
? XAC ( 'option' ,
Sel ++ [ #xmlattr { name = 'value' , 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 ,
case ejabberd_hooks : run_fold ( Hook , 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' ,
[ ? XAE ( 'select' , [ #xmlattr { name = 'name' , value = " type " ++ ID } ] ,
2004-04-26 17:38:07 +02:00
lists : map (
fun ( O ) - >
Sel = if
2008-10-13 17:36:43 +02:00
O == Opt - > [ #xmlattr { name = 'selected' , value = " selected " } ] ;
2004-04-26 17:38:07 +02:00
true - > [ ]
end ,
2008-10-13 17:36:43 +02:00
? XAC ( 'option' ,
Sel ++ [ #xmlattr { name = 'value' , value = atom_to_list ( 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
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
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 ) - >
2008-10-13 17:36:43 +02:00
#jid { lnode = U , ldomain = S , resource = undefined } = exmpp_jid : list_to_jid ( Val ) ,
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 ) - >
2008-10-13 17:36:43 +02:00
#jid { lnode = U , ldomain = S , resource = undefined } = exmpp_jid : list_to_jid ( Val ) ,
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 ) - >
2008-10-13 17:36:43 +02:00
#jid { lnode = U , ldomain = S , resource = undefined } = exmpp_jid : list_to_jid ( Val ) ,
2008-02-12 02:16:11 +01:00
case U of
" " - >
{ ACLName , S } ;
_ - >
{ ACLName , U , S }
end .
2004-04-26 17:38:07 +02:00
acl_parse_delete ( ACLs , Query ) - >
NewACLs =
lists : filter (
2007-12-07 02:40:24 +01:00
fun ( { acl , _ Name , _ Spec } = ACL ) - >
2004-04-26 17:38:07 +02:00
ID = term_to_id ( ACL ) ,
not lists : member ( { " selected " , ID } , Query )
end , ACLs ) ,
NewACLs .
2004-05-01 22:10:25 +02:00
access_rules_to_xhtml ( AccessRules , Lang ) - >
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 ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'trr' ,
[ ? 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
]
)
end , 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 ) ,
SAccess ++ " \t " ++ SACL ++ " \n "
end , Rules ) ,
2008-10-13 17:36:43 +02:00
? XAC ( 'textarea' , [ { " name " , " rules " } ,
2004-04-26 17:38:07 +02:00
{ " rows " , " 16 " } ,
{ " cols " , " 80 " } ] ,
Text ) .
parse_access_rule ( Text ) - >
Strings = string : tokens ( Text , " \r \n " ) ,
case catch lists : flatmap (
fun ( String ) - >
case string : tokens ( String , " \s \t " ) of
[ Access , ACL ] - >
2007-12-26 13:21:52 +01:00
[ { list_to_element ( Access ) , list_to_atom ( ACL ) } ] ;
2004-04-26 17:38:07 +02:00
[ ] - >
[ ]
end
end , Strings ) of
{ 'EXIT' , _ Reason } - >
error ;
Rs - >
{ ok , Rs }
end .
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 =
length ( ejabberd_sm : get_vh_session_list ( Host ) ) ,
RegisteredUsers =
2007-05-12 20:14:21 +02:00
ejabberd_auth : get_vh_registered_users_number ( Host ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' ,
[ ? XE ( 'td' , [ ? AC ( " ../server/ " ++ Host ++ " / " , Host ) ] ) ,
? XC ( 'td' , integer_to_list ( RegisteredUsers ) ) ,
? XC ( 'td' , integer_to_list ( 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
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-10-05 21:31:17 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
[ ? 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' ) ,
? XAE ( 'td' , [ #xmlattr { name = 'class' , value = " 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
#jid { node = User , domain = Server } = exmpp_jid : list_to_jid ( Username ++ " @ " ++ Host ) ,
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 } ) - >
2005-04-17 20:08:34 +02:00
US = { User , Server } ,
QueueLen = length ( mnesia : dirty_read ( { offline_msg , US } ) ) ,
2005-09-29 03:04:24 +02:00
FQueueLen = [ ? AC ( URLFunc ( { users_queue , Prefix ,
User , Server } ) ,
2004-10-05 21:31:17 +02:00
integer_to_list ( QueueLen ) ) ] ,
FLast =
2005-04-17 20:08:34 +02:00
case ejabberd_sm : get_user_resources ( User , Server ) of
2004-10-05 21:31:17 +02:00
[ ] - >
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 } ) - >
2008-10-13 17:36:43 +02:00
exmpp_jid : jid_to_list ( User , Server , undefined ) .
2005-04-17 20:08:34 +02:00
su_to_list ( { Server , User } ) - >
2008-10-13 17:36:43 +02:00
exmpp_jid : 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: " ) ,
? XC ( 'td' , integer_to_list ( RegisteredUsers ) ) ] ) ,
? XE ( 'tr' , [ ? XCT ( 'td' , " Online Users: " ) ,
? XC ( 'td' , integer_to_list ( OnlineUsers ) ) ] ) ,
? XE ( 'tr' , [ ? XCT ( 'td' , " Outgoing s2s Connections: " ) ,
? XC ( 'td' , integer_to_list ( S2SConnections ) ) ] ) ,
? XE ( 'tr' , [ ? XCT ( 'td' , " Outgoing s2s Servers: " ) ,
? XC ( 'td' , integer_to_list ( S2SServers ) ) ] )
2004-04-26 17:38:07 +02:00
] )
2005-06-20 05:18:13 +02:00
] ) ] ;
get_stats ( Host , Lang ) - >
OnlineUsers = length ( ejabberd_sm : get_vh_session_list ( Host ) ) ,
2007-05-12 20:14:21 +02:00
RegisteredUsers = ejabberd_auth : get_vh_registered_users_number ( Host ) ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'table' , [ ] ,
[ ? XE ( 'tbody' ,
[ ? XE ( 'tr' , [ ? XCT ( 'td' , " Registered Users: " ) ,
? XC ( 'td' , integer_to_list ( RegisteredUsers ) ) ] ) ,
? XE ( 'tr' , [ ? XCT ( 'td' , " Online Users: " ) ,
? XC ( 'td' , integer_to_list ( OnlineUsers ) ) ] )
2005-06-20 05:18:13 +02:00
] )
2004-04-26 17:38:07 +02:00
] ) ] .
2004-05-04 21:47:24 +02:00
2005-06-20 05:18:13 +02:00
list_online_users ( Host , _ Lang ) - >
2007-12-07 02:40:24 +01:00
Users = [ { S , U } | | { U , S , _ R } < - ejabberd_sm : get_vh_session_list ( Host ) ] ,
2004-10-05 21:31:17 +02:00
SUsers = lists : usort ( Users ) ,
lists : flatmap (
2007-12-07 02:40:24 +01:00
fun ( { _ S , U } = SU ) - >
2005-11-22 19:25:02 +01:00
[ ? AC ( " ../user/ " ++ ejabberd_http : url_encode ( U ) ++ " / " ,
su_to_list ( SU ) ) ,
? BR ]
2004-10-05 21:31:17 +02:00
end , SUsers ) .
2005-06-20 05:18:13 +02:00
user_info ( User , Server , Query , Lang ) - >
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 ) ,
Resources = ejabberd_sm : get_user_resources ( User , Server ) ,
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 (
2007-06-10 20:13:37 +02:00
User , Server , 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 ,
? LI ( [ ? C ( R ++ FIP ) ] )
2004-05-04 21:47:24 +02:00
end , lists : sort ( Resources ) ) ) ]
end ,
2005-04-17 20:08:34 +02:00
Password = ejabberd_auth : get_password_s ( User , Server ) ,
2004-12-05 21:54:55 +01:00
FPassword = [ ? INPUT ( " password " , " password " , Password ) , ? C ( " " ) ,
2004-05-04 21:47:24 +02:00
? INPUTT ( " submit " , " chpassword " , " Change Password " ) ] ,
2007-08-23 02:51:54 +02:00
UserItems = ejabberd_hooks : run_fold ( webadmin_user , LServer , [ ] ,
[ User , Server , Lang ] ) ,
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
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-05-04 21:47:24 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
[ ? 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 ) - >
case ejabberd_hooks : run_fold ( webadmin_user_parse_query , Server , [ ] , [ Action , User , Server , Query ] ) of
[ ] - > nothing ;
Res - > Res
2004-10-05 21:31:17 +02:00
end .
2005-06-20 05:18:13 +02:00
list_last_activity ( Host , Lang , Integral , Period ) - >
2005-05-09 01:39:46 +02:00
{ MegaSecs , Secs , _ MicroSecs } = now ( ) ,
TimeStamp = MegaSecs * 1000000 + Secs ,
case Period of
" all " - >
TS = 0 ,
Days = infinity ;
" year " - >
TS = TimeStamp - 366 * 86400 ,
Days = 366 ;
_ - >
TS = TimeStamp - 31 * 86400 ,
Days = 31
end ,
case catch mnesia : dirty_select (
2005-06-20 05:18:13 +02:00
last_activity , [ { { last_activity , { '_' , Host } , '$1' , '_' } ,
2005-05-09 01:39:46 +02:00
[ { '>' , '$1' , TS } ] ,
[ { 'trunc' , { '/' ,
{ '-' , TimeStamp , '$1' } ,
86400 } } ] } ] ) of
{ 'EXIT' , _ Reason } - >
[ ] ;
Vals - >
Hist = histogram ( Vals , Integral ) ,
2005-05-28 00:52:50 +02:00
if
Hist == [ ] - >
2006-02-18 20:56:16 +01:00
[ ? CT ( " No Data " ) ] ;
2005-05-28 00:52:50 +02:00
true - >
Left = if
Days == infinity - >
0 ;
true - >
Days - length ( Hist )
end ,
Tail = if
Integral - >
lists : duplicate ( Left , lists : last ( Hist ) ) ;
true - >
lists : duplicate ( Left , 0 )
end ,
Max = lists : max ( Hist ) ,
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'ol' ,
[ #xmlattr { name = 'id' , value = " lastactivity " } , #xmlattr { name = 'start' , value = " 0 " } ] ,
[ ? XAE ( 'li' ,
[ #xmlattr { name = 'style' , value =
2005-05-28 00:52:50 +02:00
" width: " ++ integer_to_list (
trunc ( 90 * V / Max ) ) ++ " %; " } ] ,
2008-10-13 17:36:43 +02:00
[ #xmlcdata { cdata = list_to_binary ( integer_to_list ( 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
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
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 ) ,
2008-10-13 17:36:43 +02:00
? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
[ ? 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 ) ,
MenuItems2 = make_menu_items ( global , 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 - >
2007-07-26 12:22:44 +02:00
node_db_parse_query ( Node , Tables , Query ) ,
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 ) ] ) ,
2008-10-13 17:36:43 +02:00
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-16 22:13:38 +02:00
integer_to_list ( Size ) ) ,
2008-10-13 17:36:43 +02:00
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-16 22:13:38 +02:00
integer_to_list ( 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 ) ) ] ++
2007-07-26 12:22:44 +02:00
[ ? CT ( " Submitted " ) , ? P ] ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
[ ? 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' ,
[ ? XAE ( 'td' , [ #xmlattr { name = 'colspan' , value = " 4 " } ,
#xmlattr { name = 'class' , value = " 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 ) - >
2007-12-07 02:40:24 +01:00
_ Res = node_backup_parse_query ( Node , Query ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , ? T ( " Backup of " ) ++ atom_to_list ( Node ) ) ,
? XCT ( 'p' , " Remark 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. " ) ,
? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
[ ? 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 ;
_ - >
nothing
end ,
NewPorts = lists : sort (
rpc : call ( Node , ejabberd_config , get_local_option , [ listen ] ) ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , ? T ( " Listened Ports at " ) ++ atom_to_list ( Node ) ) ] ++
2004-06-17 23:29:24 +02:00
case Res of
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2004-06-17 23:29:24 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " 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 ] ) ) ,
2008-10-13 17:36:43 +02:00
[ ? XC ( 'h1' , ? T ( " Modules at " ) ++ atom_to_list ( Node ) ) ] ++
2005-05-23 02:30:29 +02:00
case Res of
2006-02-18 20:56:16 +01:00
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
2005-05-23 02:30:29 +02:00
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " 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 ) ,
2004-05-22 21:48:35 +02:00
TransactionsCommited =
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: " ) ,
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-22 21:48:35 +02:00
UpTimeS ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " CPU Time: " ) ,
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-22 21:48:35 +02:00
CPUTimeS ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Online Users: " ) ,
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2007-06-28 10:31:46 +02:00
integer_to_list ( OnlineUsers ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Commited: " ) ,
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-22 21:48:35 +02:00
integer_to_list ( TransactionsCommited ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Aborted: " ) ,
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-22 21:48:35 +02:00
integer_to_list ( TransactionsAborted ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Restarted: " ) ,
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-22 21:48:35 +02:00
integer_to_list ( TransactionsRestarted ) ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'tr' , [ ? XCT ( 'td' , " Transactions Logged: " ) ,
? XAC ( 'td' , [ #xmlattr { name = 'class' , value = " alignright " } ] ,
2004-05-22 21:48:35 +02:00
integer_to_list ( TransactionsLogged ) ) ] )
] )
] ) ] ;
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 " ) ;
_ - >
2008-10-13 17:36:43 +02:00
? XE ( 'ul' ,
2006-02-27 05:43:16 +01:00
[ ? LI ( [ ? C ( atom_to_list ( Beam ) ) ] ) | |
Beam < - UpdatedBeams ] )
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
ok - > [ ? CT ( " Submitted " ) , ? P ] ;
error - > [ ? CT ( " Bad format " ) , ? P ] ;
nothing - > [ ]
end ++
2008-10-13 17:36:43 +02:00
[ ? XAE ( 'form' , [ #xmlattr { name = 'action' , value = " " } , #xmlattr { name = 'method' , value = " post " } ] ,
2006-02-27 05:43:16 +01:00
[ ? INPUTT ( " submit " , " update " , " Update " ) ,
2008-10-13 17:36:43 +02:00
? XCT ( 'h2' , " Update plan " ) ,
? XCT ( 'h3' , " Updated modules " ) , Mods ,
? XCT ( 'h3' , " Update script " ) , FmtScript ,
? XCT ( 'h3' , " Low level update script " ) , FmtLowLevelScript ,
? XCT ( 'h3' , " Script check " ) , ? C ( atom_to_list ( Check ) ) ] )
2006-02-27 05:43:16 +01:00
] ;
2005-06-20 05:18:13 +02:00
get_node ( Host , Node , NPath , Query , Lang ) - >
2007-08-23 02:51:54 +02:00
{ Hook , Opts } = case Host of
2007-08-31 18:13:35 +02:00
global - > { webadmin_page_node , [ Node , NPath , Query , Lang ] } ;
Host - > { webadmin_page_hostnode , [ Host , Node , NPath , Query , Lang ] }
2007-08-23 02:51:54 +02:00
end ,
case ejabberd_hooks : run_fold ( Hook , Host , [ ] , Opts ) of
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 ) - >
2008-10-13 17:36:43 +02:00
? XAE ( 'select' , [ #xmlattr { name = 'name' , value = " table " ++ ID } ] ,
2004-05-14 16:46:53 +02:00
lists : map (
fun ( { O , Desc } ) - >
Sel = if
2008-10-13 17:36:43 +02:00
O == Opt - > [ #xmlattr { name = 'selected' , value = " selected " } ] ;
2004-05-14 16:46:53 +02:00
true - > [ ]
end ,
2008-10-13 17:36:43 +02:00
? XACT ( 'option' ,
Sel ++ [ #xmlattr { name = 'value' , value = atom_to_list ( 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
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 .
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
{ error , _ Reason } - >
error ;
{ badrpc , _ Reason } - >
error ;
_ - >
ok
end ;
_ - >
error
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 ) - >
2008-10-13 17:36:43 +02:00
? XAE ( 'table' , [ ] ,
[ ? XE ( 'thead' ,
[ ? XE ( 'tr' ,
[ ? XCT ( 'td' , " Port " ) ,
? 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 (
2007-12-07 02:40:24 +01:00
fun ( { Port , Module , Opts } = _ E ) - >
2004-06-17 23:29:24 +02:00
SPort = integer_to_list ( Port ) ,
SModule = atom_to_list ( Module ) ,
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' , SPort ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " module " ++ SPort ,
2004-06-17 23:29:24 +02:00
SModule ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTS ( " text " , " opts " ++ SPort ,
2004-06-17 23:29:24 +02:00
term_to_string ( Opts ) , " 40 " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " add " ++ SPort ,
2004-06-17 23:29:24 +02:00
" Update " ) ] ) ,
2008-10-13 17:36:43 +02:00
? XE ( 'td' , [ ? INPUTT ( " submit " , " delete " ++ SPort ,
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 " ) ] ) ,
? XE ( 'td' , [ ? INPUT ( " text " , " modulenew " , " " ) ] ) ,
? XE ( 'td' , [ ? INPUTS ( " text " , " optsnew " , " " , " 40 " ) ] ) ,
? XAE ( 'td' , [ #xmlattr { name = 'colspan' , value = " 2 " } ] ,
2004-06-17 23:29:24 +02:00
[ ? INPUTT ( " submit " , " addnew " , " Add New " ) ] )
]
) ]
) ] ) .
node_ports_parse_query ( Node , Ports , Query ) - >
lists : foreach (
2008-10-13 12:11:19 +02:00
fun ( { Port , Module1 , _ Opts1 } ) - >
2004-06-17 23:29:24 +02:00
SPort = integer_to_list ( Port ) ,
case lists : keysearch ( " add " ++ SPort , 1 , Query ) of
{ value , _ } - >
{ { value , { _ , SModule } } , { value , { _ , SOpts } } } =
{ lists : keysearch ( " module " ++ SPort , 1 , Query ) ,
lists : keysearch ( " opts " ++ SPort , 1 , Query ) } ,
Module = list_to_atom ( SModule ) ,
{ ok , Tokens , _ } = erl_scan : string ( SOpts ++ " . " ) ,
{ ok , Opts } = erl_parse : parse_term ( Tokens ) ,
2008-10-13 12:11:19 +02:00
rpc : call ( Node , ejabberd_listener , delete_listener , [ Port , Module ] ) ,
2005-05-23 02:30:29 +02:00
rpc : call ( Node , ejabberd_listener , add_listener , [ Port , Module , Opts ] ) ,
2004-06-17 23:29:24 +02:00
throw ( submitted ) ;
_ - >
case lists : keysearch ( " delete " ++ SPort , 1 , Query ) of
{ value , _ } - >
2008-10-13 12:11:19 +02:00
rpc : call ( Node , ejabberd_listener , delete_listener , [ Port , 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 } } ,
{ value , { _ , SModule } } ,
{ value , { _ , SOpts } } } =
{ lists : keysearch ( " portnew " , 1 , Query ) ,
lists : keysearch ( " modulenew " , 1 , Query ) ,
lists : keysearch ( " optsnew " , 1 , Query ) } ,
Port = list_to_integer ( SPort ) ,
Module = list_to_atom ( SModule ) ,
{ ok , Tokens , _ } = erl_scan : string ( SOpts ++ " . " ) ,
{ ok , Opts } = erl_parse : parse_term ( Tokens ) ,
2005-05-23 02:30:29 +02:00
rpc : call ( Node , ejabberd_listener , add_listener , [ Port , Module , Opts ] ) ,
2004-06-17 23:29:24 +02:00
throw ( submitted ) ;
_ - >
ok
end .
2005-05-23 02:30:29 +02:00
node_modules_to_xhtml ( Modules , Lang ) - >
2008-10-13 17:36:43 +02:00
? XAE ( 'table' , [ ] ,
[ ? 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 ) ,
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 ) ,
? XE ( 'td' , [ ? INPUTS ( " text " , " opts " ++ SModule ,
2005-05-23 02:30:29 +02:00
term_to_string ( Opts ) , " 40 " ) ] ) ,
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 " , " " ) ] ) ,
? XE ( 'td' , [ ? INPUTS ( " text " , " optsnew " , " " , " 40 " ) ] ) ,
? XAE ( 'td' , [ #xmlattr { name = 'colspan' , value = " 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 , _ } - >
case rpc : call ( Node , ejabberd_update , update , [ ] ) of
{ 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
%%%
%%% 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 } ) ;
make_menu_items ( global , _ Node , Base , Lang ) - >
HookItems = get_menu_items_hook ( node , Lang ) ,
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 } ) ;
make_menu_items ( Host , _ Node , Base , Lang ) - >
HookItems = get_menu_items_hook ( { hostnode , Host } , Lang ) ,
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 " } ] ,
HostNodeHook = get_menu_items_hook ( { hostnode , Host } , Lang ) ,
{ 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 " } ] ,
NodeHook = get_menu_items_hook ( node , Lang ) ,
{ 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 } .
get_menu_items_hook ( { hostnode , Host } , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_hostnode , Host , [ ] , [ Host , Lang ] ) ;
get_menu_items_hook ( { host , Host } , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_host , Host , [ ] , [ Host , Lang ] ) ;
get_menu_items_hook ( node , Lang ) - >
ejabberd_hooks : run_fold ( webadmin_menu_node , [ ] , [ Lang ] ) ;
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 ) - >
2008-10-13 17:36:43 +02:00
? LI ( [ ? XAE ( 'div' , [ #xmlattr { name = 'id' , value = " navhead " } ] , [ ? AC ( URI , " ~ " ++ Name ++ " ~ " ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( header , 2 , URI , Name , _ Lang ) - >
2008-10-13 17:36:43 +02:00
? LI ( [ ? XAE ( 'div' , [ #xmlattr { name = 'id' , value = " navheadsub " } ] , [ ? AC ( URI , " ~ " ++ Name ++ " ~ " ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( header , 3 , URI , Name , _ Lang ) - >
2008-10-13 17:36:43 +02:00
? LI ( [ ? XAE ( 'div' , [ #xmlattr { name = 'id' , value = " navheadsubsub " } ] , [ ? AC ( URI , " ~ " ++ Name ++ " ~ " ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( item , 1 , URI , Name , Lang ) - >
2008-10-13 17:36:43 +02:00
? LI ( [ ? XAE ( 'div' , [ #xmlattr { name = 'id' , value = " navitem " } ] , [ ? ACT ( URI , Name ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( item , 2 , URI , Name , Lang ) - >
2008-10-13 17:36:43 +02:00
? LI ( [ ? XAE ( 'div' , [ #xmlattr { name = 'id' , value = " navitemsub " } ] , [ ? ACT ( URI , Name ) ] ) ] ) ;
2008-10-13 12:11:19 +02:00
make_menu_item ( item , 3 , URI , Name , Lang ) - >
2008-10-13 17:36:43 +02:00
? LI ( [ ? XAE ( 'div' , [ #xmlattr { name = 'id' , value = " navitemsubsub " } ] , [ ? ACT ( URI , Name ) ] ) ] ) .