Commit 6dc27571 authored by Yadd's avatar Yadd
Browse files

LEMONLDAP::NG : * avoid a little warning in tests

                * Manager/Sessions.pm and purgeCentralCache now use the same Apache::Session get_key_from_all_sessions() function
parent de7edc73
......@@ -49,7 +49,7 @@ Description: Lemonldap::NG apache administration interface part
Package: liblemonldap-ng-manager-perl
Architecture: all
Depends: libxml-simple-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libjs-jquery, liblemonldap-ng-handler-perl
Depends: libxml-simple-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libjs-jquery, liblemonldap-ng-handler-perl (= ${binary:Version})
Recommends: libcache-cache-perl, libapache-session-perl, libsoap-lite-perl
Description: Lemonldap::NG apache manager part
Lemonldap::NG is a complete Web-SSO system that can run with reverse-proxies
......@@ -59,7 +59,7 @@ Description: Lemonldap::NG apache manager part
Package: liblemonldap-ng-portal-perl
Architecture: all
Depends: libapache-session-perl, libnet-ldap-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libhtml-template-perl, libjs-jquery, liblemonldap-ng-handler-perl, libxml-libxml-perl
Depends: libapache-session-perl, libnet-ldap-perl, liblemonldap-ng-conf-perl (= ${binary:Version}), libhtml-template-perl, libjs-jquery, liblemonldap-ng-handler-perl (= ${binary:Version}), libxml-libxml-perl
Suggests: liblasso-perl, libcgi-session-perl, slapd
Description: Lemonldap::NG apache authentication portal part
Lemonldap::NG is a complete Web-SSO system that can run with reverse-proxies
......
Changes
lib/Lemonldap/NG/Common.pm
lib/Lemonldap/NG/Common/Apache/Session.pm
lib/Lemonldap/NG/Common/Apache/Session/SOAP.pm
lib/Lemonldap/NG/Common/CGI.pm
lib/Lemonldap/NG/Common/Conf.pm
......
package Lemonldap::NG::Common::Apache::Session;
use Storable qw(thaw);
BEGIN {
sub Apache::Session::get_key_from_all_sessions {
return 0;
}
sub Apache::Session::MySQL::get_key_from_all_sessions {
my $class = shift;
my $args = shift;
my $data = shift;
# TODO : replace die by abort
my $dbh =
DBI->connect( $args->{DataSource}, $args->{UserName},
$args->{Password} )
or die("$!$@");
my $sth = $dbh->prepare('SELECT id,a_session from sessions');
$sth->execute;
my %res;
while ( my @row = $sth->fetchrow_array ) {
if ( ref($data) eq 'CODE' ) {
my $tmp = &$data( thaw( $row[1] ), $row[0] );
$res{ $row[0] }->{$_} = $tmp if ( defined($tmp) );
}
elsif ($data) {
$data = [$data] unless ( ref($data) );
my $tmp = thaw( $row[1] );
$res{ $row[0] }->{$_} = $tmp->{$_} foreach (@$data);
}
else {
$res{ $row[0] } = thaw( $row[1] );
}
}
return \%res;
}
*Apache::Session::Postgres::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
*Apache::Session::Oracle::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
*Apache::Session::Sybase::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
*Apache::Session::Informix::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
sub Apache::Session::File::get_key_from_all_sessions {
my $class = shift;
my $args = shift;
my $data = shift;
$args->{Directory} ||= '/tmp';
# TODO : replace die by abort
unless ( opendir DIR, $args->{Directory} ) {
die "Cannot open directory $args->{Directory}\n";
}
my @t =
grep { -f "$args->{Directory}/$_" and /^[A-Za-z0-9@\-]+$/ }
readdir(DIR);
closedir DIR;
my %res;
for my $f (@t) {
open F, "$args->{Directory}/$f";
my $row = join '', <F>;
if ( ref($data) eq 'CODE' ) {
$res{$f}->{$_} = &$data( thaw($row), $f );
}
elsif ($data) {
$data = [$data] unless ( ref($data) );
my $tmp = thaw($row);
$res{$f}->{$_} = $tmp->{$_} foreach (@$data);
}
else {
$res{$f} = thaw($row);
}
}
return \%res;
}
sub Apache::Session::DB_File::get_key_from_all_sessions {
my $class = shift;
my $args = shift;
if ( !tied %{ $class->{dbm} } ) {
my $rv = tie %{ $class->{dbm} }, 'DB_File', $args->{FileName};
# TODO : replace die by abort
if ( !$rv ) {
die "Could not open dbm file " . $args->{FileName} . ": $!";
}
}
return keys( %{ $class->{dbm} } );
}
}
1;
......@@ -2,7 +2,7 @@ package Lemonldap::NG::Manager::Sessions;
use strict;
use Lemonldap::NG::Handler::CGI qw(:globalStorage :locationRules);
use Storable qw(nfreeze thaw);
use Lemonldap::NG::Common::Apache::Session;
our $VERSION = '0.1';
......@@ -13,97 +13,6 @@ our @ISA = qw(Lemonldap::NG::Handler::CGI);
# This module is written to be used by cron to clean old sessions from
# Apache::Session.
BEGIN {
sub Apache::Session::get_key_from_all_sessions {
return 0;
}
sub Apache::Session::MySQL::get_key_from_all_sessions {
my $class = shift;
my $args = shift;
my $data = shift;
# TODO : replace die by abort
my $dbh =
DBI->connect( $args->{DataSource}, $args->{UserName},
$args->{Password} )
or die("$!$@");
my $sth = $dbh->prepare('SELECT id,a_session from sessions');
$sth->execute;
my %res;
while ( my @row = $sth->fetchrow_array ) {
if ( ref($data) eq 'CODE' ) {
$res{ $row[0] }->{$_} = &$data( thaw( $row[1] ), $row[0] );
}
elsif ($data) {
$data = [$data] unless ( ref($data) );
my $tmp = thaw( $row[1] );
$res{ $row[0] }->{$_} = $tmp->{$_} foreach (@$data);
}
else {
$res{ $row[0] } = thaw( $row[1] );
}
}
return \%res;
}
*Apache::Session::Postgres::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
*Apache::Session::Oracle::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
*Apache::Session::Sybase::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
*Apache::Session::Informix::get_key_from_all_sessions =
\&Apache::Session::MySQL::get_key_from_all_sessions;
sub Apache::Session::File::get_key_from_all_sessions {
my $class = shift;
my $args = shift;
my $data = shift;
$args->{Directory} ||= '/tmp';
# TODO : replace die by abort
unless ( opendir DIR, $args->{Directory} ) {
die "Cannot open directory $args->{Directory}\n";
}
my @t =
grep { -f "$args->{Directory}/$_" and /^[A-Za-z0-9@\-]+$/ }
readdir(DIR);
closedir DIR;
my %res;
for my $f (@t) {
open F, "$args->{Directory}/$f";
my $row = join '', <F>;
if ( ref($data) eq 'CODE' ) {
$res{$f}->{$_} = &$data( thaw($row), $f );
}
elsif ($data) {
$data = [$data] unless ( ref($data) );
my $tmp = thaw($row);
$res{$f}->{$_} = $tmp->{$_} foreach (@$data);
}
else {
$res{$f} = thaw($row);
}
}
return \%res;
}
sub Apache::Session::DB_File::get_key_from_all_sessions {
my $class = shift;
my $args = shift;
if ( !tied %{ $class->{dbm} } ) {
my $rv = tie %{ $class->{dbm} }, 'DB_File', $args->{FileName};
# TODO : replace die by abort
if ( !$rv ) {
die "Could not open dbm file " . $args->{FileName} . ": $!";
}
}
return keys( %{ $class->{dbm} } );
}
}
sub new {
my ( $class, $args ) = @_;
my $self = $class->SUPER::new($args)
......
#!/usr/bin/perl
use strict;
# Cleaner for Lemonldap::NG : removes old sessions from Apache::Session
#
# This module is written to be used by cron to clean old sessions from
# Apache::Session.
BEGIN {
sub Apache::Session::get_all_sessions {
return 0;
}
sub Apache::Session::MySQL::get_all_sessions {
my $class = shift;
my $args = shift;
my $dbh =
DBI->connect( $args->{DataSource}, $args->{UserName},
$args->{Password} )
or die("$!$@");
my $sth = $dbh->prepare('SELECT id from sessions');
$sth->execute;
my @res;
while ( my @row = $sth->fetchrow_array ) {
push @res, @row;
}
return @res;
}
*Apache::Session::Postgres::get_all_sessions =
\&Apache::Session::MySQL::get_all_sessions;
*Apache::Session::Oracle::get_all_sessions =
\&Apache::Session::MySQL::get_all_sessions;
*Apache::Session::Sybase::get_all_sessions =
\&Apache::Session::MySQL::get_all_sessions;
*Apache::Session::Informix::get_all_sessions =
\&Apache::Session::MySQL::get_all_sessions;
sub Apache::Session::File::get_all_sessions {
my $class = shift;
my $args = shift;
$args->{Directory} ||= '/tmp';
unless ( opendir DIR, $args->{Directory} ) {
die "Cannot open directory $args->{Directory}\n";
}
my @t =
grep { -f "$args->{Directory}/$_" and /^[A-Za-z0-9@\-]+$/ }
readdir(DIR);
closedir DIR;
return @t;
}
sub Apache::Session::DB_File::get_all_sessions {
my $class = shift;
my $args = shift;
if ( !tied %{ $class->{dbm} } ) {
my $rv = tie %{ $class->{dbm} }, 'DB_File', $args->{FileName};
if ( !$rv ) {
die "Could not open dbm file " . $args->{FileName} . ": $!";
}
}
return keys( %{ $class->{dbm} } );
}
}
use Lemonldap::NG::Common::Conf;
use Lemonldap::NG::Common::Conf::Constants;
use Lemonldap::NG::Common::Apache::Session;
use strict;
use DBI;
my $lmconf = Lemonldap::NG::Common::Conf->new(
{
......@@ -88,7 +25,16 @@ die $@ if ($@);
$conf->{timeout} ||= 7200;
my @t = $tmp->get_all_sessions( $conf->{globalStorageOptions} );
my @t;
$tmp->get_key_from_all_sessions(
$conf->{globalStorageOptions},
sub {
my $entry = shift;
my $id = shift;
push @t, $id if ( time - $entry->{_utime} > $conf->{timeout} );
undef;
}
);
for my $id (@t) {
my %h;
......@@ -96,14 +42,7 @@ for my $id (@t) {
if ($@) {
next;
}
else {
if ( time - $h{_utime} > $conf->{timeout} ) {
tied(%h)->delete;
}
else {
untie %h;
}
}
tied(%h)->delete;
}
1;
......
......@@ -13,6 +13,7 @@ BEGIN { use_ok('Lemonldap::NG::Portal::Simple') }
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
$ENV{"REQUEST_METHOD"} = 'GET';
my $p;
ok(
$p = Lemonldap::NG::Portal::Simple->new(
......
......@@ -13,6 +13,7 @@ BEGIN { use_ok('Lemonldap::NG::Portal::Simple') }
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
$ENV{"REQUEST_METHOD"} = 'GET';
my $p;
ok(
$p = Lemonldap::NG::Portal::Simple->new(
......
......@@ -26,6 +26,7 @@ SKIP: {
"Problem with Lemonldap::NG::Portal::Simple, Lemonldap::NG::Portal::AuthCAS will not be tested",
1
if ($@);
$ENV{"REQUEST_METHOD"} = 'GET';
ok(
$p = Lemonldap::NG::Portal::Simple->new(
{
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment