2008-05-09 17:51:21 +02:00
|
|
|
package Lemonldap::NG::Handler::Status;
|
|
|
|
|
|
|
|
use strict;
|
2008-05-12 06:02:55 +02:00
|
|
|
use POSIX;
|
2008-05-12 12:30:09 +02:00
|
|
|
use Data::Dumper;
|
2008-05-09 17:51:21 +02:00
|
|
|
|
2008-05-11 11:17:26 +02:00
|
|
|
our $status = {};
|
|
|
|
our $activity = [];
|
|
|
|
our $start = int( time / 60 );
|
2008-05-19 11:18:00 +02:00
|
|
|
use constant MN_COUNT => 5;
|
2008-05-09 17:51:21 +02:00
|
|
|
|
2008-05-11 21:21:39 +02:00
|
|
|
sub portalTab {
|
|
|
|
return {
|
|
|
|
-2 => 'PORTAL_REDIRECT',
|
|
|
|
-1 => 'PORTAL_ALREADY_AUTHENTICATED',
|
|
|
|
0 => 'PORTAL_OK',
|
|
|
|
1 => 'PORTAL_SESSIONEXPIRED',
|
|
|
|
2 => 'PORTAL_FORMEMPTY',
|
|
|
|
3 => 'PORTAL_WRONGMANAGERACCOUNT',
|
|
|
|
4 => 'PORTAL_USERNOTFOUND',
|
|
|
|
5 => 'PORTAL_BADCREDENTIALS',
|
|
|
|
6 => 'PORTAL_LDAPCONNECTFAILED',
|
|
|
|
7 => 'PORTAL_LDAPERROR',
|
|
|
|
8 => 'PORTAL_APACHESESSIONERROR',
|
|
|
|
9 => 'PORTAL_FIRSTACCESS',
|
|
|
|
10 => 'PORTAL_BADCERTIFICATE',
|
|
|
|
11 => 'PORTAL_LA_FAILED',
|
|
|
|
12 => 'PORTAL_LA_ARTFAILED',
|
|
|
|
13 => 'PORTAL_LA_DEFEDFAILED',
|
|
|
|
14 => 'PORTAL_LA_QUERYEMPTY',
|
|
|
|
15 => 'PORTAL_LA_SOAPFAILED',
|
|
|
|
16 => 'PORTAL_LA_SLOFAILED',
|
|
|
|
17 => 'PORTAL_LA_SSOFAILED',
|
|
|
|
18 => 'PORTAL_LA_SSOINITFAILED',
|
|
|
|
19 => 'PORTAL_LA_SESSIONERROR',
|
|
|
|
20 => 'PORTAL_LA_SEPFAILED',
|
|
|
|
21 => 'PORTAL_PP_ACCOUNT_LOCKED',
|
|
|
|
22 => 'PORTAL_PP_PASSWORD_EXPIRED',
|
|
|
|
};
|
|
|
|
}
|
|
|
|
|
2008-05-12 06:02:55 +02:00
|
|
|
eval {
|
|
|
|
POSIX::setgid( ( getgrnam( $ENV{APACHE_RUN_GROUP} ) )[2] );
|
|
|
|
POSIX::setuid( ( getpwnam( $ENV{APACHE_RUN_USER} ) )[2] );
|
|
|
|
};
|
|
|
|
|
2008-05-09 17:51:21 +02:00
|
|
|
sub run {
|
2008-05-09 22:50:27 +02:00
|
|
|
my ( $localStorage, $localStorageOptions ) = ( shift, shift );
|
2008-05-09 17:51:21 +02:00
|
|
|
my $refLocalStorage;
|
2008-05-12 12:30:09 +02:00
|
|
|
eval "use $localStorage; \$refLocalStorage = new $localStorage(\$localStorageOptions);";
|
2008-05-09 22:50:27 +02:00
|
|
|
die($@) if ($@);
|
|
|
|
$| = 1;
|
2008-05-13 18:50:33 +02:00
|
|
|
my ( $lastMn, $mn, $count );
|
2008-05-09 22:50:27 +02:00
|
|
|
while (<STDIN>) {
|
2008-05-19 11:18:00 +02:00
|
|
|
$mn = int( time / 60 ) - $start + 1;
|
2008-05-11 11:17:26 +02:00
|
|
|
|
|
|
|
# Cleaning activity array
|
|
|
|
if ( $mn > $lastMn ) {
|
|
|
|
for ( my $i = 0 ; $i < $mn - $lastMn ; $i++ ) {
|
|
|
|
unshift @$activity, {};
|
|
|
|
delete $activity->[MN_COUNT];
|
|
|
|
}
|
|
|
|
}
|
|
|
|
$lastMn = $mn;
|
|
|
|
|
|
|
|
# Activity collect
|
2008-05-11 21:21:39 +02:00
|
|
|
if (/^(\S+)\s+=>\s+(\S+)\s+(OK|REJECT|REDIRECT|LOGOUT|\-?\d+)$/) {
|
2008-05-09 22:50:27 +02:00
|
|
|
my ( $user, $uri, $code ) = ( $1, $2, $3 );
|
2008-05-11 11:17:26 +02:00
|
|
|
|
2008-05-11 21:21:39 +02:00
|
|
|
# Portal error translation
|
2008-05-19 11:18:00 +02:00
|
|
|
$code = portalTab->{$code} || $code if ( $code =~ /^\-?\d+$/ );
|
2008-05-11 21:21:39 +02:00
|
|
|
|
2008-05-11 11:17:26 +02:00
|
|
|
# Per user activity
|
2008-05-09 22:50:27 +02:00
|
|
|
$status->{user}->{$user}->{$code}++;
|
2008-05-11 11:17:26 +02:00
|
|
|
|
|
|
|
# Per uri activity
|
2008-05-09 22:50:27 +02:00
|
|
|
$uri =~ s/^(.*?)\?.*$/$1/;
|
|
|
|
$status->{uri}->{$uri}->{$code}++;
|
2008-05-13 18:50:33 +02:00
|
|
|
$count->{uri}->{$uri}++;
|
|
|
|
|
2008-05-19 11:18:00 +02:00
|
|
|
# Per vhost activity
|
2008-05-13 18:50:33 +02:00
|
|
|
my ($vhost) = ( $uri =~ /^([^\/]+)/ );
|
2008-05-19 11:18:00 +02:00
|
|
|
$status->{vhost}->{$vhost}->{$code}++;
|
|
|
|
$count->{vhost}->{$vhost}++;
|
2008-05-11 11:17:26 +02:00
|
|
|
|
|
|
|
# Last 5 minutes activity
|
|
|
|
$activity->[0]->{$code}++;
|
2008-05-09 22:50:27 +02:00
|
|
|
}
|
2008-05-11 11:17:26 +02:00
|
|
|
|
|
|
|
# Status requests
|
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# $args contains parameters passed to url status page (a=1 for example
|
2008-05-11 11:17:26 +02:00
|
|
|
# if request is http://test.example.com/status?a=1). To be used
|
|
|
|
# later...
|
|
|
|
elsif (/^STATUS(?:\s+(\S+))?$/) {
|
2008-05-13 11:07:30 +02:00
|
|
|
my $tmp = $1;
|
2008-05-12 12:30:09 +02:00
|
|
|
my $args = {};
|
2008-05-13 11:07:30 +02:00
|
|
|
%$args = split( /[=&]/, $tmp ) if ($tmp);
|
2008-05-12 12:30:09 +02:00
|
|
|
&head;
|
2008-05-13 18:50:33 +02:00
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
#print Dumper($args),&end;next;
|
|
|
|
my ( $c, $m, $u );
|
2008-05-09 22:50:27 +02:00
|
|
|
while ( my ( $user, $v ) = each( %{ $status->{user} } ) ) {
|
2008-05-11 21:21:39 +02:00
|
|
|
$u++ unless ( $user =~ /^\d+\.\d+\.\d+\.\d+$/ );
|
|
|
|
|
2008-05-11 11:17:26 +02:00
|
|
|
# Total requests
|
2008-05-09 22:50:27 +02:00
|
|
|
foreach ( keys %$v ) {
|
|
|
|
$c->{$_} += $v->{$_};
|
|
|
|
}
|
|
|
|
}
|
2008-05-11 11:17:26 +02:00
|
|
|
foreach my $mn (@$activity) {
|
2008-05-12 12:30:09 +02:00
|
|
|
$m->{$_} += $mn->{$_} foreach ( keys %$mn );
|
|
|
|
}
|
|
|
|
foreach ( keys %$m ) {
|
|
|
|
$m->{$_} = sprintf( "%.2f", $m->{$_} / MN_COUNT );
|
|
|
|
$m->{$_} = int( $m->{$_} ) if ( $m->{$_} > 99 );
|
2008-05-11 11:17:26 +02:00
|
|
|
}
|
2008-05-12 12:30:09 +02:00
|
|
|
if ( $args->{'dump'} ) {
|
|
|
|
print "<div id=\"dump\"><pre>\n";
|
2008-05-13 18:50:33 +02:00
|
|
|
print Dumper( $status, $activity, $count );
|
2008-05-12 12:30:09 +02:00
|
|
|
print "</pre></div>\n";
|
2008-05-11 11:17:26 +02:00
|
|
|
}
|
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# Total requests
|
|
|
|
print "<h2>Total</h2>\n<div id=\"total\"><pre>\n";
|
2008-05-30 17:49:33 +02:00
|
|
|
print sprintf( "%-30s : \%6d (%.02f / mn)\n",
|
2008-05-19 11:18:00 +02:00
|
|
|
$_, $c->{$_}, $c->{$_} / $mn )
|
2008-05-11 21:21:39 +02:00
|
|
|
foreach ( sort keys %$c );
|
2008-05-12 12:30:09 +02:00
|
|
|
print "\n</pre></div>\n";
|
2008-05-13 18:50:33 +02:00
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# Average
|
2008-05-19 11:18:00 +02:00
|
|
|
print "<h2>Average for last " . MN_COUNT
|
|
|
|
. " minutes</h2>\n<div id=\"average\"><pre>\n";
|
2008-05-30 17:49:33 +02:00
|
|
|
print sprintf( "%-30s : %6s / mn\n", $_, $m->{$_} )
|
2008-05-12 12:30:09 +02:00
|
|
|
foreach ( sort keys %$m );
|
|
|
|
print "\n</pre></div>\n";
|
2008-05-13 18:50:33 +02:00
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# Users connected
|
|
|
|
print "<div id=\"users\"><p>\nTotal users : $u\n</p></div>\n";
|
2008-05-13 18:50:33 +02:00
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# Local cache
|
2008-05-13 18:50:33 +02:00
|
|
|
my @t =
|
|
|
|
$refLocalStorage->get_keys( $localStorageOptions->{namespace} );
|
2008-05-12 12:30:09 +02:00
|
|
|
print "<div id=\"cache\"><p>\nLocal Cache : " . @t
|
|
|
|
. " objects\n</p></div>\n";
|
2008-05-13 18:50:33 +02:00
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# Top uri
|
|
|
|
if ( $args->{top} ) {
|
2008-05-13 18:50:33 +02:00
|
|
|
print "<hr/>\n";
|
2008-05-12 12:30:09 +02:00
|
|
|
$args->{categories} ||= 'REJECT,PORTAL_FIRSTACCESS,LOGOUT,OK';
|
2008-05-13 18:50:33 +02:00
|
|
|
|
2008-05-19 11:18:00 +02:00
|
|
|
# Vhost activity
|
|
|
|
print
|
|
|
|
"<h2>Virtual Host activity</h2>\n<div id=\"vhost\"><pre>\n";
|
|
|
|
foreach (
|
|
|
|
sort { $count->{vhost}->{$b} <=> $count->{vhost}->{$a} }
|
|
|
|
keys %{ $count->{vhost} } )
|
|
|
|
{
|
2008-05-30 17:49:33 +02:00
|
|
|
print sprintf( "%-40s : %6d\n", $_, $count->{vhost}->{$_} );
|
2008-05-19 11:18:00 +02:00
|
|
|
}
|
2008-05-13 18:50:33 +02:00
|
|
|
print "\n</pre></div>\n";
|
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# General
|
|
|
|
print "<h2>Top used URI</h2>\n<div id=\"uri\"><pre>\n";
|
2008-05-13 11:07:30 +02:00
|
|
|
my $i = 0;
|
2008-05-19 11:18:00 +02:00
|
|
|
foreach ( sort { $count->{uri}->{$b} <=> $count->{uri}->{$a} }
|
|
|
|
keys %{ $count->{uri} } )
|
2008-05-13 11:07:30 +02:00
|
|
|
{
|
|
|
|
last if ( $i == $args->{top} );
|
2008-05-13 18:50:33 +02:00
|
|
|
last unless ( $count->{uri}->{$_} );
|
2008-05-12 12:30:09 +02:00
|
|
|
$i++;
|
2008-05-30 17:49:33 +02:00
|
|
|
print sprintf( "%-80s : %6d\n", $_, $count->{uri}->{$_} );
|
2008-05-12 12:30:09 +02:00
|
|
|
}
|
|
|
|
print "\n</pre></div>\n";
|
2008-05-13 18:50:33 +02:00
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
# Top by category
|
|
|
|
print "<table border=\"1\" width=\"100%\"><tr><th>Code</th><th>Top</ht></tr>\n";
|
2008-05-13 11:07:30 +02:00
|
|
|
foreach my $cat ( split /,/, $args->{categories} ) {
|
2008-05-12 12:30:09 +02:00
|
|
|
print "<tr><td><pre>$cat</pre></td><td nowrap>\n<div id=\"$cat\">\n";
|
2008-05-13 11:07:30 +02:00
|
|
|
topByCat( $cat, $args->{top} );
|
2008-05-12 12:30:09 +02:00
|
|
|
print "</div>\n</td></tr>";
|
|
|
|
}
|
2008-05-13 11:07:30 +02:00
|
|
|
print "</table>\n";
|
2008-05-12 12:30:09 +02:00
|
|
|
}
|
2008-05-13 11:07:30 +02:00
|
|
|
print "<div id=\"up\"><p>\nServer up for : "
|
|
|
|
. &timeUp($mn)
|
|
|
|
. "\n</p></div>\n";
|
2008-05-11 14:55:20 +02:00
|
|
|
&end;
|
2008-05-09 22:50:27 +02:00
|
|
|
}
|
2008-05-09 17:51:21 +02:00
|
|
|
}
|
|
|
|
}
|
2008-05-11 14:55:20 +02:00
|
|
|
|
2008-05-13 11:07:30 +02:00
|
|
|
sub timeUp {
|
|
|
|
my $d = shift;
|
|
|
|
my $mn = $d % 60;
|
|
|
|
$d = ( $d - $mn ) / 60;
|
|
|
|
my $h = $d % 24;
|
2008-05-13 13:32:59 +02:00
|
|
|
$d = ( $d - $h ) / 24;
|
2008-05-13 11:07:30 +02:00
|
|
|
return "$d\d $h\h $mn\mn";
|
|
|
|
}
|
|
|
|
|
2008-05-12 12:30:09 +02:00
|
|
|
sub topByCat {
|
2008-05-13 11:07:30 +02:00
|
|
|
my ( $cat, $max ) = @_;
|
|
|
|
my $i = 0;
|
2008-05-12 12:30:09 +02:00
|
|
|
print "<pre>\n";
|
2008-05-13 11:07:30 +02:00
|
|
|
foreach (
|
|
|
|
sort { $status->{uri}->{$b}->{$cat} <=> $status->{uri}->{$a}->{$cat} }
|
2008-05-19 11:18:00 +02:00
|
|
|
keys %{ $status->{uri} }
|
|
|
|
)
|
2008-05-13 11:07:30 +02:00
|
|
|
{
|
|
|
|
last if ( $i == $max );
|
|
|
|
last unless ( $status->{uri}->{$_}->{$cat} );
|
2008-05-12 12:30:09 +02:00
|
|
|
$i++;
|
2008-05-30 17:49:33 +02:00
|
|
|
print sprintf( "%-80s : %6d\n", $_, $status->{uri}->{$_}->{$cat} );
|
2008-05-12 12:30:09 +02:00
|
|
|
}
|
|
|
|
print "</pre>\n";
|
|
|
|
}
|
|
|
|
|
2008-05-11 14:55:20 +02:00
|
|
|
sub head {
|
|
|
|
print <<"EOF";
|
|
|
|
<!DOCTYPE html
|
|
|
|
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
|
|
|
|
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
|
|
|
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
|
|
|
|
<head>
|
|
|
|
<title>Lemonldap::NG Status</title>
|
|
|
|
<meta http-equiv="Content-Type" content="text/html; charset=utf8" />
|
|
|
|
</head>
|
|
|
|
<body>
|
2008-05-11 21:21:39 +02:00
|
|
|
<h1>Lemonldap::NG Status</h1>
|
2008-05-11 14:55:20 +02:00
|
|
|
EOF
|
|
|
|
}
|
|
|
|
|
|
|
|
sub end {
|
|
|
|
print <<"EOF";
|
2008-05-12 12:30:09 +02:00
|
|
|
<hr/>
|
|
|
|
<script type="text/javascript" language="Javascript">
|
|
|
|
//<!--
|
|
|
|
var a = document.location.href;
|
|
|
|
a=a.replace(/\\?.*\$/,'');
|
|
|
|
document.write('<a href="'+a+'?top=10&categories=REJECT,PORTAL_FIRSTACCESS,LOGOUT,OK">Top 10</a>');
|
|
|
|
//-->
|
|
|
|
</script>
|
2008-05-11 14:55:20 +02:00
|
|
|
</body>
|
|
|
|
</html>
|
2008-05-12 12:30:09 +02:00
|
|
|
END
|
2008-05-11 14:55:20 +02:00
|
|
|
EOF
|
|
|
|
}
|
2008-05-09 17:51:21 +02:00
|
|
|
1;
|
2008-05-09 22:50:27 +02:00
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
Lemonldap::NG::Handler::Status - Perl extension to add a mod_status like system for L<Lemonldap::NG::Handler>
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
=head2 Create your Apache module
|
|
|
|
|
|
|
|
Create your own package (example using a central configuration database):
|
|
|
|
|
|
|
|
package My::Package;
|
|
|
|
use Lemonldap::NG::Handler::SharedConf;
|
|
|
|
@ISA = qw(Lemonldap::NG::Handler::SharedConf);
|
|
|
|
|
|
|
|
__PACKAGE__->init ( {
|
|
|
|
# Activate status feature
|
|
|
|
status => 1,
|
|
|
|
# Local storage used for sessions and configuration
|
|
|
|
localStorage => "Cache::DBFile",
|
|
|
|
localStorageOptions => {...},
|
|
|
|
# How to get my configuration
|
|
|
|
configStorage => {
|
|
|
|
type => "DBI",
|
|
|
|
dbiChain => "DBI:mysql:database=lemondb;host=$hostname",
|
|
|
|
dbiUser => "lemonldap",
|
|
|
|
dbiPassword => "password",
|
|
|
|
}
|
|
|
|
# ... See Lemonldap::N::Handler
|
|
|
|
} );
|
|
|
|
|
|
|
|
=head2 Configure Apache
|
|
|
|
|
|
|
|
Call your package in /apache-dir/conf/httpd.conf:
|
|
|
|
|
|
|
|
# Load your package
|
|
|
|
PerlRequire /My/File
|
|
|
|
# Normal Protection
|
|
|
|
PerlHeaderParserHandler My::Package
|
|
|
|
|
|
|
|
# Status page
|
|
|
|
<Location /status>
|
|
|
|
Order deny,allow
|
|
|
|
Allow from 10.1.1.0/24
|
|
|
|
Deny from all
|
|
|
|
PerlHeaderParserHandler My::Package->status
|
|
|
|
</Location>
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
Lemonldap::NG::Handler::Status adds a mod_status like feature to display
|
|
|
|
Lemonldap::NG::Handler activity on a protected server. It can so be used by
|
|
|
|
L<mrtg> or directly browsed by your browser.
|
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
|
|
|
L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Manager>,
|
|
|
|
L<http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation>
|
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
|
|
|
Xavier Guimard, E<lt>guimard@E<gt>
|
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
|
|
|
Copyright (C) 2008 by Xavier Guimard
|
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.8 or,
|
|
|
|
at your option, any later version of Perl 5 you may have available.
|
|
|
|
|
|
|
|
=cut
|