LEMONLDAP::NG : * Security fix : redirections in portal must be in protected sites
* perltidy in Manager/Sessions.pm
* Doxygen in progress...
This commit is contained in:
Xavier Guimard
parent
1af1632c72
commit
24a14caeda
|
|
@ -10,6 +10,7 @@ distribution_type: module
|
|||
requires:
|
||||
DBI: 0
|
||||
Storable: 0
|
||||
Regexp::Assemble: 0
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.3.html
|
||||
version: 1.3
|
||||
|
|
@ -5,8 +5,9 @@ WriteMakefile(
|
|||
NAME => 'Lemonldap::NG::Common',
|
||||
VERSION_FROM => 'lib/Lemonldap/NG/Common.pm', # finds $VERSION
|
||||
PREREQ_PM => {
|
||||
'DBI' => 0,
|
||||
'Storable' => 0,
|
||||
'DBI' => 0,
|
||||
'Storable' => 0,
|
||||
'Regexp::Assemble' => 0,
|
||||
}, # e.g., Module::Name => 1.1
|
||||
EXE_FILES => [
|
||||
'scripts/lmConfig_File2MySQL',
|
||||
|
|
|
|||
|
|
@ -1,3 +1,10 @@
|
|||
## @file
|
||||
# Base package for all Lemonldap::NG CGI
|
||||
#
|
||||
# @copy 2005, 2006, 2007, 2008, Xavier Guimard <x.guimard@free.fr>
|
||||
|
||||
## @class
|
||||
# Base class for all Lemonldap::NG portal CGI
|
||||
package Lemonldap::NG::Common::CGI;
|
||||
|
||||
use strict;
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ use strict;
|
|||
no strict 'refs';
|
||||
use Data::Dumper;
|
||||
use Lemonldap::NG::Common::Conf::Constants;
|
||||
use Regexp::Assemble;
|
||||
|
||||
our $VERSION = 0.51;
|
||||
our @ISA;
|
||||
|
|
@ -156,6 +157,12 @@ sub getDBConf {
|
|||
}
|
||||
}
|
||||
$msg = "Get configuration $conf->{cfgNum}";
|
||||
my $re = Regexp::Assemble->new();
|
||||
foreach(keys %{$conf->{locationRules}}) {
|
||||
quotemeta($_);
|
||||
$re->add($_);
|
||||
}
|
||||
$conf->{reVHosts} = $re->as_string;
|
||||
$self->setLocalConf($conf) if ( $self->{refLocalStorage} );
|
||||
return $conf;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -16,9 +16,11 @@ our @ISA = qw(Lemonldap::NG::Handler::CGI);
|
|||
sub new {
|
||||
my ( $class, $args ) = @_;
|
||||
my $self = $class->SUPER::new($args)
|
||||
or $class->abort( 'Unable to start ' . __PACKAGE__, 'See Apache logs for more' );
|
||||
or $class->abort( 'Unable to start ' . __PACKAGE__,
|
||||
'See Apache logs for more' );
|
||||
foreach (qw(jqueryUri personnalCss imagePath)) {
|
||||
$self->{$_} = $args->{$_}; # or print STDERR "Warning, $_ is not set, falling to default value\n";
|
||||
$self->{$_} = $args->{ $_
|
||||
}; # or print STDERR "Warning, $_ is not set, falling to default value\n";
|
||||
}
|
||||
eval "use $globalStorage";
|
||||
$class->abort( "Unable to load $globalStorage", $@ ) if ($@);
|
||||
|
|
@ -72,7 +74,8 @@ sub process {
|
|||
foreach my $ip ( sort keys %{ $byUid->{$uid} } ) {
|
||||
print "<li class=\"open\" id=\"di$ip\"><span>$ip</span><ul>";
|
||||
foreach my $session ( @{ $byUid->{$uid}->{$ip} } ) {
|
||||
print "<li id=\"di$session->{id}\"><span onclick=\"display('$session->{id}');\">"
|
||||
print
|
||||
"<li id=\"di$session->{id}\"><span onclick=\"display('$session->{id}');\">"
|
||||
. localtime( $session->{_utime} )
|
||||
. "</span></li>";
|
||||
}
|
||||
|
|
@ -227,10 +230,11 @@ sub process {
|
|||
undef;
|
||||
}
|
||||
);
|
||||
foreach my $user (sort keys %$byUser) {
|
||||
foreach my $user ( sort keys %$byUser ) {
|
||||
print "<li id=\"ip$user\"><span>$user</span><ul>";
|
||||
foreach my $session ( @{ $byUser->{$user} } ) {
|
||||
print "<li id=\"ip$session->{id}\"><span onclick=\"display('$session->{id}');\">"
|
||||
print
|
||||
"<li id=\"ip$session->{id}\"><span onclick=\"display('$session->{id}');\">"
|
||||
. localtime( $session->{_utime} )
|
||||
. "</span></li>";
|
||||
}
|
||||
|
|
@ -257,7 +261,8 @@ sub process {
|
|||
foreach my $ip ( sort keys %$byIp ) {
|
||||
print "<li class=\"open\" id=\"uid$ip\"><span>$ip</span><ul>";
|
||||
foreach my $session ( @{ $byIp->{$ip} } ) {
|
||||
print "<li id=\"uid$session->{id}\"><span onclick=\"display('$session->{id}');\">"
|
||||
print
|
||||
"<li id=\"uid$session->{id}\"><span onclick=\"display('$session->{id}');\">"
|
||||
. localtime( $session->{_utime} )
|
||||
. "</span></li>";
|
||||
}
|
||||
|
|
@ -294,7 +299,7 @@ sub process {
|
|||
|
||||
# Display by IP classes
|
||||
elsif ( $self->param('ipclasses') ) {
|
||||
my $partial = $self->param('p') ? $self->param('p').'.' : '';
|
||||
my $partial = $self->param('p') ? $self->param('p') . '.' : '';
|
||||
my $repartial = quotemeta($partial);
|
||||
my ( $byIp, $count );
|
||||
$globalStorage->get_key_from_all_sessions(
|
||||
|
|
@ -309,19 +314,28 @@ sub process {
|
|||
);
|
||||
|
||||
# Ajax request to list ip subclasses
|
||||
if ( $partial ) {
|
||||
if ($partial) {
|
||||
print $self->header( -type => 'text/html; charset=utf8' );
|
||||
}
|
||||
|
||||
# Display by IP subclass
|
||||
else {
|
||||
$self->start("Active sessions ($count)");
|
||||
$self->window("Sessions par réseaux <i><small>($count)</small></i>");
|
||||
$self->window(
|
||||
"Sessions par réseaux <i><small>($count)</small></i>");
|
||||
}
|
||||
foreach my $ip ( sort {$a<=>$b} keys %$byIp ) {
|
||||
$self->ajaxNode( "$partial$ip", "$partial$ip <i><small>($byIp->{$ip})</small></i>", ($partial!~/^\d+\.\d+\.\d+/?"ipclasses=1&p=$partial$ip":"uidByIp=$partial$ip"));
|
||||
foreach my $ip ( sort { $a <=> $b } keys %$byIp ) {
|
||||
$self->ajaxNode(
|
||||
"$partial$ip",
|
||||
"$partial$ip <i><small>($byIp->{$ip})</small></i>",
|
||||
(
|
||||
$partial !~ /^\d+\.\d+\.\d+/
|
||||
? "ipclasses=1&p=$partial$ip"
|
||||
: "uidByIp=$partial$ip"
|
||||
)
|
||||
);
|
||||
}
|
||||
$self->end() unless($partial);
|
||||
$self->end() unless ($partial);
|
||||
}
|
||||
|
||||
# Default display
|
||||
|
|
@ -427,7 +441,8 @@ sub window {
|
|||
my $root = shift;
|
||||
print '<table border="0" width="100%"><tr style="text-align:center;">
|
||||
<td><a href="' . $ENV{SCRIPT_NAME} . '">Sessions actives</a></td>
|
||||
<td><a href="' . $ENV{SCRIPT_NAME} . '?ipclasses=1">Réseaux</a></td>
|
||||
<td><a href="'
|
||||
. $ENV{SCRIPT_NAME} . '?ipclasses=1">Réseaux</a></td>
|
||||
<td><a href="'
|
||||
. $ENV{SCRIPT_NAME} . '?doubleIp=1">Utilisateurs multi-IP</a></td>
|
||||
<td><form action="'
|
||||
|
|
@ -1103,7 +1118,7 @@ sessions
|
|||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
#!/usr/bin/perl
|
||||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Manager::Sessions;
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ our @EXPORT =
|
|||
PE_PP_MUST_SUPPLY_OLD_PASSWORD PE_PP_INSUFFICIENT_PASSWORD_QUALITY
|
||||
PE_PP_PASSWORD_TOO_SHORT PE_PP_PASSWORD_TOO_YOUNG
|
||||
PE_PP_PASSWORD_IN_HISTORY PE_PP_GRACE PE_PP_EXP_WARNING
|
||||
PE_PASSWORD_MISMATCH PE_PASSWORD_OK PE_NOTIFICATION );
|
||||
PE_PASSWORD_MISMATCH PE_PASSWORD_OK PE_NOTIFICATION PE_BADURL );
|
||||
our %EXPORT_TAGS = ( 'all' => [ @EXPORT, 'import' ], );
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
|
@ -186,6 +186,7 @@ sub error_type {
|
|||
32, #PE_PP_GRACE
|
||||
33, #PE_PP_EXP_WARNING
|
||||
36, #PE_NOTIFICATION
|
||||
37, #PE_BADURL
|
||||
)
|
||||
)
|
||||
);
|
||||
|
|
@ -385,8 +386,9 @@ sub controlUrlOrigin {
|
|||
my $self = shift;
|
||||
if ( $self->param('url') ) {
|
||||
$self->{urldc} = decode_base64( $self->param('url') );
|
||||
# REJECT '<' in URL or encoded '%'
|
||||
return PE_BADURL if($self->{urldc} =~ /(?:<|\%(?:25|3C))/);
|
||||
|
||||
# REJECT '<' in URL or encoded '%' and non protected hosts
|
||||
return PE_BADURL if($self->{urldc} =~ /(?:<|\%(?:25|3C))/ or $self->{urldc} !~ m#https?://$self->{reVHosts}#);
|
||||
}
|
||||
elsif($self->{mustRedirect}) {
|
||||
$self->{urldc} = $self->{portal};
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user