## @file
# Session explorer
## @class
# Session explorer.
# Synopsis:
# * build a new Lemonldap::NG::Manager::Sessions object
# * insert tree() result in HTML
#
# tree() loads on of the tree methods.
# new() manage ajax requests (inserted in HTML tree)
package Lemonldap::NG::Manager::Sessions;
use strict;
use Lemonldap::NG::Handler::CGI qw(:globalStorage :locationRules);
use Lemonldap::NG::Common::Apache::Session; #inherits
use Lemonldap::NG::Common::Conf; #link protected conf Configuration
use Lemonldap::NG::Common::Conf::Constants; #inherits
require Lemonldap::NG::Manager::_i18n; #inherits
#inherits Apache::Session
our $whatToTrace;
*whatToTrace = \$Lemonldap::NG::Handler::_CGI::whatToTrace;
our $VERSION = '0.11';
our @ISA = qw(
Lemonldap::NG::Handler::CGI
Lemonldap::NG::Manager::_i18n
);
## @cmethod Lemonldap::NG::Manager::Sessions new(hashRef args)
# Constructor.
# @param $args Arguments for Lemonldap::NG::Handler::CGI::new()
# @return New Lemonldap::NG::Manager::Sessions object
sub new {
my ( $class, $args ) = @_;
my $self = $class->SUPER::new($args)
or $class->abort( 'Unable to start ' . __PACKAGE__,
'See Apache logs for more' );
# Try to get configuration values from global configuration
my $config = Lemonldap::NG::Common::Conf->new( $self->{configStorage} );
unless ($config) {
$self->abort( "Unable to start",
"Configuration not loaded\n" . $Lemonldap::NG::Common::Conf::msg );
}
# Load parameters from lemonldap-ng.ini.
my $localconf = $config->getLocalConf(MANAGERSECTION);
# Local args prepends global args
if ($localconf) {
$self->{$_} = $args->{$_} || $localconf->{$_}
foreach ( keys %$localconf );
}
# Load default skin if no other specified
$self->{managerSkin} ||= 'default';
# Now try to load Apache::Session module
eval "use $globalStorage";
$class->abort( "Unable to load $globalStorage", $@ ) if ($@);
# Check if we use X-FORWARDED-FOR header for IP
$self->{ipField} =
$self->{useXForwardedForIP} ? "xForwardedForAddr" : "ipAddr";
# Now we're ready to display sessions. Choose display type
foreach my $k ( $self->param() ) {
# Case ajax request : execute corresponding sub and quit
if ( grep { $_ eq $k } qw(delete session id uidByIp uid letter p) ) {
print $self->header( -type => 'text/html;charset=utf-8' );
print $self->$k( $self->param($k) );
$self->quit();
}
# Case else : store tree type choosen to use it later in tree()
elsif ( grep { $_ eq $k } qw(doubleIp fullip fulluid ipclasses) ) {
$self->{_tree} = $k;
last;
}
}
# default display : list by uid
$self->{_tree} ||= 'list';
return $self;
}
## @method string tree()
# Launch required tree builder. It can be one of :
# * doubleIp()
# * fullip()
# * fulluid()
# * ipclasses()
# * list() (default)
# @return string XML tree
sub tree {
my $self = shift;
my $sub = $self->{_tree};
$self->lmLog( "Building chosen tree : $sub", 'debug' );
my ( $r, $legend ) = $self->$sub( $self->param($sub) );
return
qq{
$legend
$r
};
}
################
# TREE METHODS #
################
## @method protected string list()
# Build default tree (by letter)
# @return string XML tree
sub list {
my $self = shift;
my ( $byUid, $count, $res );
$count = 0;
# Parse all sessions to store first letter
$globalStorage->get_key_from_all_sessions(
$globalStorageOptions,
sub {
my $entry = shift;
next if ( $entry->{_httpSessionType} );
$entry->{$whatToTrace} =~ /^(\w)/ or return undef;
$byUid->{$1}++;
$count++;
undef;
}
);
# Build tree sorted by first letter
foreach my $letter ( sort keys %$byUid ) {
$res .= $self->ajaxNode(
# ID
"li_$letter",
# Legend
"$letter ($byUid->{$letter} "
. (
$byUid->{$letter} == 1
? $self->translate('session')
: $self->translate('sessions')
)
. ")",
# Next request
"letter=$letter"
);
}
return (
$res,
"$count "
. (
$count == 1
? $self->translate('session')
: $self->translate('sessions')
)
);
}
## @method protected string doubleIp()
# Build tree with users connected from more than 1 IP
# @return string XML tree
sub doubleIp {
my $self = shift;
my ( $byUid, $byIp, $res, $count );
# Parse all sessions
$globalStorage->get_key_from_all_sessions(
$globalStorageOptions,
sub {
my $entry = shift;
my $id = shift;
next if ( $entry->{_httpSessionType} );
push @{ $byUid->{ $entry->{$whatToTrace} }
->{ $entry->{ $self->{ipField} } } },
{ id => $id, _utime => $entry->{_utime} };
undef;
}
);
# Build tree sorted by uid (or other field chosen in whatToTrace parameter)
foreach my $uid (
sort { ( keys %{ $byUid->{$b} } ) <=> ( keys %{ $byUid->{$a} } ) }
keys %$byUid
)
{
# Parse only uid that are connected from more than 1 IP
last if ( ( keys %{ $byUid->{$uid} } ) == 1 );
$count++;
# Build UID node with IP as sub node
$res .= "
";
# For each IP node, store sessions sorted by start time
foreach my $session ( sort { $a->{_utime} <=> $b->{_utime} }
@{ $byUid->{$uid}->{$ip} } )
{
$res .=
"
";
}
return (
$res,
"$count "
. (
$count == 1
? $self->translate('user')
: $self->translate('users')
)
);
}
## @method protected string fullip(string req)
# Build single IP tree
# @param $req Optional IP request (127* for example)
# @return string XML tree
sub fullip {
my ( $self, $req ) = splice @_;
my ( $byUid, $res );
# Build regexp based on IP request
my $reip = quotemeta($req);
$reip =~ s/\\\*/\.\*/g;
# Parse all sessions and store only if IP match regexp
$globalStorage->get_key_from_all_sessions(
$globalStorageOptions,
sub {
my $entry = shift;
my $id = shift;
next if ( $entry->{_httpSessionType} );
if ( $entry->{ $self->{ipField} } eq $reip ) {
push @{ $byUid->{ $entry->{ $self->{ipField} } }
->{ $entry->{$whatToTrace} } },
{ id => $id, _utime => $entry->{_utime} };
}
undef;
}
);
# Build tree sorted by IP
foreach my $ip ( sort keys %$byUid ) {
$res .= "
";
}
return $res;
}
# Ajax request to list users starting by a letter
## @method protected string letter()
# Build letter XML part
# @return string XML tree
sub letter {
my $self = shift;
my $letter = $self->param('letter');
my ( $byUid, $res );
$globalStorage->get_key_from_all_sessions(
$globalStorageOptions,
sub {
my $entry = shift;
next if ( $entry->{_httpSessionType} );
$entry->{$whatToTrace} =~ /^$letter/ or return undef;
$byUid->{ $entry->{$whatToTrace} }++;
},
);
foreach my $uid ( sort keys %$byUid ) {
$res .= $self->ajaxNode(
$uid,
$uid
. (
$byUid->{$uid} > 1
? " ($byUid->{$uid} "
. (
$byUid->{$uid} == 1
? $self->translate('session')
: $self->translate('sessions')
)
. ")"
: ''
),
"uid=$uid"
);
}
return $res;
}
## @method protected string p()
# Build IP classes sub tree (call _ipclasses())
# @return string XML tree
sub p {
my $self = shift;
my @t = $self->_ipclasses(@_);
return $t[0];
}
## @method private string _ipclasses()
# Build IP classes (sub) tree
# @return string XML tree
sub _ipclasses {
my ( $self, $p ) = splice @_;
my $partial = $p ? "$p." : '';
my $repartial = quotemeta($partial);
my ( $byIp, $count, $res );
$globalStorage->get_key_from_all_sessions(
$globalStorageOptions,
sub {
my $entry = shift;
next if ( $entry->{_httpSessionType} );
$entry->{ $self->{ipField} } =~ /^$repartial(\d+)/ or return undef;
$byIp->{$1}++;
$count++;
undef;
}
);
foreach my $ip ( sort { $a <=> $b } keys %$byIp ) {
$res .= $self->ajaxNode(
"$partial$ip",
"$partial$ip ($byIp->{$ip} "
. (
$byIp->{$ip} == 1 ? $self->translate('session')
: $self->translate('sessions')
)
. ")",
(
$partial !~ /^\d+\.\d+\.\d+/ ? "ipclasses=1&p=$partial$ip"
: "uidByIp=$partial$ip"
)
);
}
return (
$res,
"$count "
. (
$count == 1
? $self->translate('session')
: $self->translate('sessions')
)
);
#return $res;
}
## @fn protected string htmlquote(string s)
# Change <, > and & to HTML encoded values in the string
# @param $s HTML string
# @return HTML string
sub htmlquote {
my $s = shift;
$s =~ s/&/&/g;
$s =~ s/</g;
$s =~ s/>/>/g;
return $s;
}
## @method private void ajaxnode(string id, string text, string param)
# Display tree node with Ajax functions inside for opening the node.
# @param $id HTML id of the element.
# @param $text text to display
# @param $param Parameters for the Ajax query
sub ajaxNode {
my ( $self, $id, $text, $param ) = @_;
return
"
$text\n
{url:$ENV{SCRIPT_NAME}?$param}
\n";
}
1;
__END__
=head1 NAME
Lemonldap::NG::Manager::Sessions - Perl extension to manage Lemonldap::NG
sessions
=head1 SYNOPSIS
#!/usr/bin/perl
use strict;
use Lemonldap::NG::Manager::Sessions;
our $cgi ||= Lemonldap::NG::Manager::Sessions->new({
localStorage => "Cache::FileCache",
localStorageOptions => {
'namespace' => 'MyNamespace',
'default_expires_in' => 600,
'directory_umask' => '007',
'cache_root' => '/tmp',
'cache_depth' => 5,
},
configStorage => $Lemonldap::NG::Conf::configStorage,
configStorage=>{
type=>'File',
dirName=>"/tmp/",
},
https => 1,
jqueryUri => '/js/jquery/jquery.js',
imagePath => '/js/jquery.simple.tree/',
# Force the use of X-FORWARDED-FOR for IP
useXForwardedForIP => 1,
# Optionnal
protection => 'rule: $uid eq "admin"',
# Or to use rules from manager
protection => 'manager',
# Or just to authenticate without managing authorization
protection => 'authenticate',
});
$cgi->process();
=head1 DESCRIPTION
Lemonldap::NG::Manager::Sessions provides a web interface to manage
Lemonldap::NG sessions.
It inherits from L, so see this manpage to
understand how arguments passed to the constructor.
=head1 SEE ALSO
L, L
=head1 AUTHOR
Xavier Guimard, Ex.guimard@free.frE
=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.
C embedded javascript library is licensed under BSD
L and copyrighted (c) 2008 by Peter
Panov Epanov@elcat.kgE, IKEEN Group L
=cut