lemonldap-ng/modules/lemonldap-ng-portal/example/scripts/purgeCentralCache
2008-11-12 15:35:27 +00:00

111 lines
2.7 KiB
Perl
Executable File

#!/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::Manager::Conf;
use Lemonldap::NG::Manager::Conf::Constants;
use strict;
use DBI;
my $lmconf = Lemonldap::NG::Manager::Conf->new(
{
type => 'File',
dirName => '__CONFDIR__',
}
);
my $conf = $lmconf->getConf or die "Unable to get configuration ($!)";
my $tmp = $conf->{globalStorage};
eval "use $tmp";
die $@ if ($@);
$conf->{timeout} ||= 7200;
my @t = $tmp->get_all_sessions( $conf->{globalStorageOptions} );
for my $id (@t) {
my %h;
eval { tie %h, $tmp, $id, $conf->{globalStorageOptions} };
if ($@) {
next;
}
else {
if ( time - $h{_utime} > $conf->{timeout} ) {
tied(%h)->delete;
}
else {
untie %h;
}
}
}
1;