337 lines
10 KiB
Perl
337 lines
10 KiB
Perl
package Lemonldap::NG::Manager::Sessions;
|
|
|
|
use 5.10.0;
|
|
use Mouse;
|
|
|
|
use Lemonldap::NG::Common::Session;
|
|
use Lemonldap::NG::Common::Conf::Constants;
|
|
use Lemonldap::NG::Common::Session;
|
|
use Lemonldap::NG::Common::PSGI::Constants;
|
|
use Lemonldap::NG::Manager::Constants;
|
|
use Lemonldap::NG::Handler::Main qw(:tsv);
|
|
|
|
use feature 'state';
|
|
|
|
extends 'Lemonldap::NG::Manager::Lib';
|
|
|
|
our $VERSION = '2.0.0';
|
|
|
|
#############################
|
|
# I. INITIALIZATION METHODS #
|
|
#############################
|
|
|
|
use constant defaultRoute => 'sessions.html';
|
|
|
|
sub addRoutes {
|
|
my $self = shift;
|
|
|
|
# HTML template
|
|
$self->addRoute( 'sessions.html', undef, ['GET'] )
|
|
|
|
# READ
|
|
->addRoute( 'sessions', undef, ['GET'] )
|
|
|
|
# DELETE
|
|
->addRoute( sessions => { ':sessionId' => 'delSession' }, ['DELETE'] );
|
|
|
|
#TODO: transfer this in Manager.pm ?
|
|
if ( my $localConf = $self->confAcc->getLocalConf(SESSIONSEXPLORERSECTION) )
|
|
{
|
|
$self->{$_} = $localConf->{$_} foreach ( keys %$localConf );
|
|
}
|
|
|
|
$self->{ipField} ||= 'ipAddr';
|
|
$self->{multiValuesSeparator} ||= '; ';
|
|
$self->{hiddenAttributes} //= "_password";
|
|
}
|
|
|
|
#######################
|
|
# II. DISPLAY METHODS #
|
|
#######################
|
|
|
|
sub sessions {
|
|
my ( $self, $req, $session, $skey ) = splice @_;
|
|
|
|
# Case 1: only one session is required
|
|
if ($session) {
|
|
return $self->session( $req, $session, $skey );
|
|
}
|
|
|
|
# Case 2: list of sessions
|
|
my $params = $req->params();
|
|
my $res;
|
|
|
|
# 2.1 Get fields to require
|
|
my @fields = ( '_httpSessionType', $self->{ipField}, $tsv->{whatToTrace} );
|
|
if ( my $groupBy = $params->{groupBy} ) {
|
|
$groupBy = $1
|
|
if ( $groupBy =~ /^substr\((\w+)(?:,\d+(?:,\d+)?)?\)$/ );
|
|
if ( $groupBy =~ /^net4\((\w+),\d\)$/ ) {
|
|
push @fields, $1;
|
|
}
|
|
else {
|
|
push @fields, $groupBy;
|
|
}
|
|
}
|
|
elsif ( my $order = $params->{orderBy} ) {
|
|
$order =~ s/^net4\((\w+)\)$/$1/;
|
|
push @fields, split( /, /, $order );
|
|
}
|
|
else {
|
|
push @fields, '_utime';
|
|
}
|
|
|
|
# 2.2 Restrict query if possible: search for filters (any query arg that is
|
|
# not a keyword)
|
|
my $moduleOptions = $tsv->{sessionStorageOptions} || {};
|
|
$moduleOptions->{backend} = $tsv->{sessionStorageModule};
|
|
if (
|
|
my %filters = map {
|
|
/^(?:(?:group|order)By|doubleIp)$/ ? () : ( $_ => $params->{$_} );
|
|
} keys %$params
|
|
)
|
|
{
|
|
|
|
# Check if a '*' is required
|
|
my $function = 'searchOn';
|
|
$function = 'searchOnExpr' if ( grep /\*/, values %filters );
|
|
|
|
# For now, only one argument can be passed to
|
|
# Lemonldap::NG::Common::Apache::Session so just the first filter is
|
|
# used
|
|
my ($firstFilter) = keys %filters;
|
|
$res =
|
|
Lemonldap::NG::Common::Apache::Session->$function( $moduleOptions,
|
|
$firstFilter, $filters{$firstFilter}, @fields );
|
|
|
|
# TODO: change this
|
|
return $self->sendError( $req, 'No sessions', 200 )
|
|
unless ( $res and %$res );
|
|
delete $filters{$firstFilter};
|
|
foreach my $k ( keys %filters ) {
|
|
$filters{$k} =~ s/\*/\.\*/g;
|
|
foreach my $session ( keys %$res ) {
|
|
if ( $res->{$session}->{$k} ) {
|
|
delete $res->{$session}
|
|
unless ( $res->{$session}->{$k} =~ /^$filters{$k}$/ );
|
|
print STDERR "Deleted\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# 2.3 Else get all sessions
|
|
else {
|
|
$res =
|
|
Lemonldap::NG::Common::Apache::Session->get_key_from_all_sessions(
|
|
$moduleOptions, [@fields] );
|
|
}
|
|
|
|
# 2.4 Special case doubleIp (users connected from more than 1 IP)
|
|
if ( $params->{doubleIp} ) {
|
|
my %r;
|
|
|
|
# 2.4.1 Store user IP addresses in %r
|
|
while ( my ( $id, $entry ) = each %$res ) {
|
|
next if ( $entry->{_httpSessionType} );
|
|
$r{ $entry->{ $tsv->{whatToTrace} } }
|
|
->{ $entry->{ $self->{ipField} } }++;
|
|
}
|
|
|
|
# 2.4.2 Store sessions owned by users that has more than one IP address in $r
|
|
my $r;
|
|
foreach my $k ( keys %$res ) {
|
|
my @tmp = keys %{ $r{ $res->{$k}->{ $tsv->{whatToTrace} } } };
|
|
if ( @tmp > 1 ) {
|
|
$res->{$k}->{_sessionId} = $k;
|
|
push @{ $r->{ $res->{$k}->{ $tsv->{whatToTrace} } } },
|
|
$res->{$k};
|
|
}
|
|
}
|
|
|
|
# 2.4.3 Store these session in an array. Array elements are :
|
|
# {
|
|
# uid => whatToTraceFieldValue,
|
|
# sessions => [
|
|
# { session => <session-id-1>, date => <_utime> },
|
|
# { session => <session-id-2>, date => <_utime> },
|
|
# ]
|
|
# }
|
|
$res = [];
|
|
foreach my $uid ( sort keys %$r ) {
|
|
push @$res, {
|
|
value => $uid,
|
|
count => scalar( @{ $r->{$uid} } ),
|
|
sessions => [
|
|
map {
|
|
{
|
|
session => $_->{_sessionId},
|
|
date => $_->{_utime}
|
|
}
|
|
} @{ $r->{$uid} }
|
|
]
|
|
};
|
|
}
|
|
}
|
|
|
|
# 2.4 Order and group by
|
|
# $res will become an array ref here (except for doubleIp, already done bellow).
|
|
|
|
# If "groupBy" is asked, elements will be like:
|
|
# { uid => 'foo.bar', count => 3 }
|
|
elsif ( my $group = $req->params('groupBy') ) {
|
|
my $r;
|
|
|
|
# Substrings
|
|
if ( $group =~ /^substr\((\w+)(?:,(\d+)(?:,(\d+))?)?\)$/ ) {
|
|
my ( $field, $length, $start ) = ( $1, $2, $3 );
|
|
$start ||= 0;
|
|
$length = 1 if ( $length < 1 );
|
|
foreach my $k ( keys %$res ) {
|
|
$r->{ substr $res->{$k}->{$field}, $start, $length }++;
|
|
}
|
|
$group = $field;
|
|
}
|
|
|
|
# Subnets
|
|
elsif ( $group =~ /^net4\((\w+),(\d)\)$/ ) {
|
|
my $field = $1;
|
|
my $nb = $2 - 1;
|
|
foreach my $k ( keys %$res ) {
|
|
if ( $res->{$k}->{$field} =~ /^((((\d+)\.\d+)\.\d+)\.\d+)$/ ) {
|
|
my @d = ( $4, $3, $2, $1 );
|
|
$r->{ $d[$nb] }++;
|
|
}
|
|
}
|
|
$group = $field;
|
|
}
|
|
|
|
# Simple field groupBy query
|
|
elsif ( $group =~ /^\w+$/ ) {
|
|
foreach my $k ( keys %$res ) {
|
|
$r->{ $res->{$k}->{$group} }++;
|
|
}
|
|
}
|
|
else {
|
|
return $self->sendError( $req, 'Syntax error in groupBy', 400 );
|
|
}
|
|
|
|
# Build result
|
|
$res = [
|
|
sort { $a->{value} cmp $b->{value} }
|
|
map { { value => $_, count => $r->{$_} } } keys %$r
|
|
];
|
|
}
|
|
|
|
# Else if "orderBy" is asked, $res elements will be like:
|
|
# { uid => 'foo.bar', session => <sessionId> }
|
|
elsif ( my $f = $req->params('orderBy') ) {
|
|
my @fields = split /,/, $f;
|
|
my @r = map {
|
|
my $tmp = { session => $_ };
|
|
foreach my $f (@fields) {
|
|
my $s = $f;
|
|
$s =~ s/^net4\((\w+)\)$/$1/;
|
|
$tmp->{$s} = $res->{$_}->{$s};
|
|
}
|
|
$tmp
|
|
} keys %$res;
|
|
while ( my $f = pop @fields ) {
|
|
if ( $f =~ s/^net4\((\w+)\)$/$1/ ) {
|
|
@r = sort {
|
|
my @a = split /\./, $a->{$f};
|
|
my @b = split /\./, $b->{$f};
|
|
my $cmp = 0;
|
|
F: for ( my $i = 0 ; $i < 4 ; $i++ ) {
|
|
if ( $a[$i] != $b[$i] ) {
|
|
$cmp = $a[$i] <=> $b[$i];
|
|
last F;
|
|
}
|
|
}
|
|
$cmp;
|
|
} @r;
|
|
}
|
|
else {
|
|
@r = sort { $a->{$f} cmp $b->{$f} } @r;
|
|
}
|
|
}
|
|
$res = [@r];
|
|
}
|
|
|
|
# Else, $res elements will be like:
|
|
# { session => <sessionId>, date => <timestamp> }
|
|
else {
|
|
$res = [
|
|
sort { $a->{date} <=> $b->{date} }
|
|
map { { session => $_, date => $res->{$_}->{_utime} } }
|
|
keys %$res
|
|
];
|
|
}
|
|
|
|
return $self->sendJSONresponse( $req,
|
|
{ result => 1, count => scalar(@$res), values => $res } );
|
|
}
|
|
|
|
sub delSession {
|
|
my ( $self, $req ) = splice @_;
|
|
return $self->sendJSONresponse( $req, { result => 1 } )
|
|
if ( $self->{demoMode} );
|
|
my $id = $req->params('sessionId')
|
|
or return $self->sendError( $req, 'sessionId is missing', 400 );
|
|
my $session = $self->getApacheSession($id);
|
|
$session->remove;
|
|
if ( $session->error ) {
|
|
return $self->sendError( $req, $session->error, 200 );
|
|
}
|
|
return $self->sendJSONresponse( $req, { result => 1 } );
|
|
}
|
|
|
|
sub session {
|
|
my ( $self, $req, $id, $skey ) = splice @_;
|
|
my ( %h, $res );
|
|
|
|
# Try to read session
|
|
# TODO: conf in PSGI
|
|
my $apacheSession = $self->getApacheSession($id)
|
|
or return $self->sendError( $req, undef, 400 );
|
|
|
|
my %session = %{ $apacheSession->data };
|
|
|
|
foreach my $k ( keys %session ) {
|
|
$session{$k} = '**********'
|
|
if ( $self->{hiddenAttributes} =~ /\b$k\b/ );
|
|
$session{$k} = [ split /$self->{multiValuesSeparator}/o, $session{$k} ]
|
|
if ( $session{$k} =~ /$self->{multiValuesSeparator}/o );
|
|
}
|
|
|
|
if ($skey) {
|
|
return $self->sendJSONresponse( $req, $session{$skey} );
|
|
}
|
|
else {
|
|
return $self->sendJSONresponse( $req, \%session );
|
|
}
|
|
|
|
# TODO: check for utf-8 problems
|
|
}
|
|
|
|
sub getApacheSession {
|
|
my ( $self, $id ) = splice @_;
|
|
my $apacheSession = Lemonldap::NG::Common::Session->new(
|
|
{
|
|
storageModule => $tsv->{sessionStorageModule},
|
|
storageModuleOptions => $tsv->{sessionStorageOptions},
|
|
cacheModule => $tsv->{sessionCacheModule},
|
|
cacheModuleOptions => $tsv->{sessionCacheOptions},
|
|
id => $id,
|
|
kind => "SSO",
|
|
}
|
|
);
|
|
if ( $apacheSession->error ) {
|
|
$self->error( $apacheSession->error );
|
|
return undef;
|
|
}
|
|
return $apacheSession;
|
|
}
|
|
|
|
1;
|