2006-12-18 12:32:33 +01:00
|
|
|
|
package Lemonldap::Handlers::Generic4a2;
|
|
|
|
|
use strict;
|
|
|
|
|
|
|
|
|
|
##### use ######
|
|
|
|
|
use Apache2::URI();
|
2007-03-01 11:36:20 +01:00
|
|
|
|
use Apache2::Const;
|
|
|
|
|
use Apache2::Connection;
|
2007-03-15 11:33:40 +01:00
|
|
|
|
use Apache2::ServerUtil ();
|
2006-12-18 12:32:33 +01:00
|
|
|
|
use MIME::Base64;
|
|
|
|
|
use LWP::UserAgent;
|
|
|
|
|
use Lemonldap::Config::Parameters;
|
|
|
|
|
use Lemonldap::Config::Initparam;
|
|
|
|
|
use Lemonldap::Handlers::Utilities;
|
|
|
|
|
use Lemonldap::Handlers::Core;
|
|
|
|
|
use Apache2::Log();
|
|
|
|
|
use Apache2::ServerRec();
|
2007-03-01 11:36:20 +01:00
|
|
|
|
use CGI ':cgi-lib';
|
2006-12-18 12:32:33 +01:00
|
|
|
|
use CGI::Cookie;
|
|
|
|
|
use Crypt::CBC;
|
|
|
|
|
use URI::Escape;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
use Template;
|
|
|
|
|
use Sys::Hostname;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
#A retirer en prod
|
|
|
|
|
#use Data::Dumper;
|
|
|
|
|
#### common declaration #######
|
2007-03-01 11:36:20 +01:00
|
|
|
|
our( @ISA, $VERSION, @EXPORTS );
|
2008-01-21 18:35:55 +01:00
|
|
|
|
$VERSION = '3.5.6';
|
2007-03-01 11:36:20 +01:00
|
|
|
|
our $VERSION_LEMONLDAP = "3.1.0";
|
|
|
|
|
our $VERSION_INTERNAL = "3.1.0";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
####
|
|
|
|
|
####
|
|
|
|
|
#### my declaration #########
|
|
|
|
|
my %CONFIG;
|
|
|
|
|
my %CLIENT;
|
|
|
|
|
my $SAVE_MHURI;
|
|
|
|
|
my $NOM;
|
|
|
|
|
my $UA;
|
|
|
|
|
@ISA = qw(LWP::UserAgent );
|
|
|
|
|
my $ID_COLLECTED;
|
|
|
|
|
my $__STACK;
|
|
|
|
|
my %STACK;
|
|
|
|
|
my $ID_SAVE;
|
2007-03-15 11:33:40 +01:00
|
|
|
|
my $s = Apache2::ServerUtil->server;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
### this anonymous function will be call when child dead , it will delete berkeley db file
|
|
|
|
|
my $cleanup = sub {
|
|
|
|
|
my $s = Apache2::ServerUtil->server;
|
|
|
|
|
my $srv_cfg = $s->dir_config;
|
|
|
|
|
|
|
|
|
|
my $vhosts = 0;
|
|
|
|
|
my $path_other;
|
|
|
|
|
for ( my $ser = $s->next ; $ser ; $ser = $ser->next ) {
|
|
|
|
|
$vhosts++;
|
|
|
|
|
$path_other = $ser->dir_config('cachedbpath') unless $path_other;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
my $path = $srv_cfg->{'cachedbpath'} || $path_other;
|
|
|
|
|
unlink "$path/$$.db" if $path;
|
2007-03-15 11:33:40 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
};
|
2007-03-15 11:33:40 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
Apache2::ServerUtil->server->push_handlers( PerlChildExitHandler => $cleanup );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
sub handler {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $r = shift;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
# URL des pages d'erreur a ne pas traiter
|
|
|
|
|
if ( $r->uri =~ /^\/LemonErrorPages/ ) {
|
|
|
|
|
return DECLINED;
|
|
|
|
|
}
|
2007-03-09 17:25:41 +01:00
|
|
|
|
########################
|
|
|
|
|
## log initialization
|
|
|
|
|
########################
|
|
|
|
|
my $log = $r->log;
|
|
|
|
|
my $messagelog;
|
|
|
|
|
my $cache2file;
|
|
|
|
|
my $APACHE_CODE;
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
# Url a ne pas traiter meme sans conf
|
|
|
|
|
# exemple
|
|
|
|
|
# PerlSetVar ExcludeRegex
|
|
|
|
|
#(?i)(\.smi|\.swf|\.vrml|\.ico|\.tif|\.gif|\.jpg|\.jpeg|\.js|\.css|\.jpeg|\.png|\.avi|ajaxaction|pngbehavior\.jsp)
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $regex = $r->dir_config('excluderegex') ;
|
|
|
|
|
if (defined $regex) {
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$log->debug("REGEXP : $regex\n");
|
|
|
|
|
my $uri_input = $r->uri;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ($uri_input=~ /$regex/o) {
|
|
|
|
|
$log->debug("$uri_input : EXCLUDED\n");
|
|
|
|
|
return DECLINED;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
########################
|
|
|
|
|
## collect httpd param
|
|
|
|
|
########################
|
|
|
|
|
$ID_COLLECTED = '';
|
|
|
|
|
my $con = $r->dir_config();
|
|
|
|
|
|
|
|
|
|
$log->info($messagelog);
|
|
|
|
|
|
|
|
|
|
my $in_process = $r->dir_config('handlerid');
|
|
|
|
|
if ( $CONFIG{$in_process} ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2006-12-18 12:32:33 +01:00
|
|
|
|
"$CONFIG{$in_process}->{HANDLERID} XML $CONFIG{$in_process}->{XML} config already in use"
|
|
|
|
|
);
|
|
|
|
|
$ID_COLLECTED = $in_process;
|
|
|
|
|
}
|
|
|
|
|
else {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $conf = &Lemonldap::Config::Initparam::init_param_httpd($log,$con);
|
|
|
|
|
#Domain insensible a la casse
|
|
|
|
|
$conf->{DOMAIN} = lc($conf->{DOMAIN});
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#/Domain insensible a la casse
|
|
|
|
|
$ID_COLLECTED = $conf->{HANDLERID};
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$CONFIG{$ID_COLLECTED} = $conf;
|
|
|
|
|
|
|
|
|
|
### I will try retieve HANDLERID from httpd conf
|
|
|
|
|
if ($ID_COLLECTED) {
|
|
|
|
|
$NOM = $ID_COLLECTED;
|
|
|
|
|
$messagelog =
|
|
|
|
|
"$NOM Phase : handler initialization LOAD HANDLERID httpd.conf:$CONFIG{$ID_COLLECTED}->{HANDLERID} : succeded";
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
|
|
|
|
|
# I don't find anything for this handler in order to make link with XLM conf section
|
|
|
|
|
$messagelog =
|
|
|
|
|
"$NOM: Phase : handler initialization LOAD HANDLERID httpd.conf:failed";
|
|
|
|
|
}
|
|
|
|
|
$log->info($messagelog);
|
|
|
|
|
|
|
|
|
|
############################################
|
|
|
|
|
|
|
|
|
|
# my $ref = $CONFIG{$ID_COLLECTED}->{HANDLERID};
|
|
|
|
|
# $ref =~ s/\/.+// ;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2006-12-18 12:32:33 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: Phase : handler initialization LOAD XML file $CONFIG{$ID_COLLECTED}->{CONFIGFILE} and $CONFIG{$ID_COLLECTED}->{CONFIGDBPATH}"
|
|
|
|
|
);
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2006-12-18 12:32:33 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: domain matched $CONFIG{$ID_COLLECTED}->{DOMAIN}"
|
|
|
|
|
);
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( defined ($CONFIG{$ID_COLLECTED}->{CONFIGFILE}) )
|
|
|
|
|
{
|
2006-12-18 12:32:33 +01:00
|
|
|
|
# my $ref = $CONFIG{$ID_COLLECTED}->{HANDLERID};
|
|
|
|
|
# $ref =~ s/\/.+// ;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: Phase : handler initialization LOAD XML file $CONFIG{$ID_COLLECTED}->{CONFIGFILE} and $CONFIG{$ID_COLLECTED}->{CONFIGDBPATH}");
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: domain matched $CONFIG{$ID_COLLECTED}->{DOMAIN}" );
|
|
|
|
|
$conf = &Lemonldap::Config::Initparam::init_param_xml( $CONFIG{$ID_COLLECTED});
|
|
|
|
|
$log->info("$conf->{message}");
|
|
|
|
|
}else
|
|
|
|
|
{
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$conf = {};
|
|
|
|
|
}
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $c =
|
2006-12-18 12:32:33 +01:00
|
|
|
|
&Lemonldap::Config::Initparam::merge( $CONFIG{$ID_COLLECTED}, $conf );
|
|
|
|
|
$CONFIG{$ID_COLLECTED} = $c;
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
# $CONFIG{$ID_COLLECTED}->{KEYIPC} .= "$$.db" if ($CONFIG{$ID_COLLECTED}->{KEYIPC});
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#############################Test de CONFIG####################################
|
|
|
|
|
#################################################################################
|
|
|
|
|
|
|
|
|
|
## now I save the context of handler
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID} end of initialization");
|
|
|
|
|
|
|
|
|
|
## addon for FASTPATTERNS
|
|
|
|
|
if ( ( $CONFIG{$ID_COLLECTED}->{FASTPATTERNS} )
|
2007-03-01 11:36:20 +01:00
|
|
|
|
&& !( $CONFIG{$ID_COLLECTED}->{ANONYMOUSFUNC} ) )
|
2006-12-18 12:32:33 +01:00
|
|
|
|
{
|
|
|
|
|
my $sub =
|
2007-03-01 11:36:20 +01:00
|
|
|
|
&Lemonldap::Config::Initparam::built_functionics
|
|
|
|
|
( $CONFIG{$ID_COLLECTED}->{FASTPATTERNS} );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$CONFIG{$ID_COLLECTED}->{ANONYMOUSFUNC_SRC} = $sub;
|
|
|
|
|
$CONFIG{$ID_COLLECTED}->{ANONYMOUSFUNC} = eval "$sub";
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: Phase : FASTPATTERNS TABLE LOADED : $sub"
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
## addon for multihoming
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( ( $CONFIG{$ID_COLLECTED}->{MULTIHOMING} )
|
2007-03-01 11:36:20 +01:00
|
|
|
|
&& !( $CONFIG{$ID_COLLECTED}->{SELECTOR} ) )
|
2006-12-18 12:32:33 +01:00
|
|
|
|
{
|
|
|
|
|
my $sub = $CONFIG{$ID_COLLECTED}->{SUB};
|
|
|
|
|
$CONFIG{$ID_COLLECTED}->{SELECTOR_SRC} = $sub;
|
|
|
|
|
$CONFIG{$ID_COLLECTED}->{SELECTOR} = eval "$sub";
|
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
################
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
##
|
|
|
|
|
foreach ( keys %{ $CONFIG{$ID_COLLECTED} } ) {
|
|
|
|
|
if ( $_ ne "ENCRYPTIONKEY" ) {
|
|
|
|
|
$log->info("$ID_COLLECTED:$_ => $CONFIG{$ID_COLLECTED}->{$_}");
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
##### end of initialization
|
|
|
|
|
##### begin process request
|
|
|
|
|
my $uri = $r->uri;
|
|
|
|
|
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID} :uri requested: $uri");
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#### multihoming
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my $MHURI;
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{MH} ) {
|
|
|
|
|
$MHURI = $CONFIG{$ID_COLLECTED}->{SELECTOR}->($uri);
|
|
|
|
|
|
|
|
|
|
# Stop process if no multihosting
|
|
|
|
|
if ( ( $MHURI eq '1' ) || ( !($MHURI) ) ) {
|
|
|
|
|
$log->warn(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID} :multihoming failed for $uri"
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
return DECLINED;
|
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
# load combo config
|
2006-12-18 12:32:33 +01:00
|
|
|
|
### I switch the context#
|
|
|
|
|
my $old_collected = $ID_COLLECTED;
|
|
|
|
|
$ID_COLLECTED = $MHURI;
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$old_collected}->{HANDLERID} :SWITCH CONFIG $MHURI"
|
|
|
|
|
);
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{XML} ) {
|
|
|
|
|
$log->info(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID} :MULTIHOMING already in use "
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
my $c =
|
|
|
|
|
&Lemonldap::Config::Initparam::mergeMH( $CONFIG{$old_collected},
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$MHURI );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$CONFIG{$ID_COLLECTED} = $c;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID} :MULTIHOMING ON");
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#########################
|
|
|
|
|
##### for developper ###
|
2007-03-15 11:33:40 +01:00
|
|
|
|
if ( ( $uri =~ /_lemonldap_internal/i ) && ( $con->get('internaldebug') ) )
|
|
|
|
|
{
|
|
|
|
|
# if ( $uri =~ /_lemonldap_internal/i ) {
|
|
|
|
|
$r->handler("perl-script");
|
|
|
|
|
$r->push_handlers( PerlHandler => \&_lemonldap_internal );
|
|
|
|
|
return OK;
|
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( ( $CONFIG{$ID_COLLECTED}->{FASTPATTERNS} )
|
|
|
|
|
&& ( $CONFIG{$ID_COLLECTED}->{ANONYMOUSFUNC}->($uri) eq 'OK' ) )
|
2006-12-18 12:32:33 +01:00
|
|
|
|
{
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID} :uri FASTPATTERNS matched: $uri"
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
return DECLINED;
|
|
|
|
|
}
|
|
|
|
|
$APACHE_CODE = DECLINED;
|
|
|
|
|
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{ENABLELWP} ) {
|
|
|
|
|
$UA = __PACKAGE__->new;
|
|
|
|
|
$UA->agent( join "/", __PACKAGE__, $VERSION );
|
|
|
|
|
$log->info(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: Build-in proxy actived");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$r->handler("perl-script");
|
|
|
|
|
$r->push_handlers( PerlHandler => \&proxy_handler );
|
2007-06-04 16:42:37 +02:00
|
|
|
|
$APACHE_CODE= OK ;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
### before to enter in protected area
|
2006-12-18 12:32:33 +01:00
|
|
|
|
###
|
|
|
|
|
return $APACHE_CODE if ( $CONFIG{$ID_COLLECTED}->{DISABLEACCESSCONTROL} );
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
### raz cache level 1
|
2006-12-18 12:32:33 +01:00
|
|
|
|
# is this area protected
|
|
|
|
|
# configuration check
|
|
|
|
|
#
|
|
|
|
|
#
|
|
|
|
|
# first check cookie
|
|
|
|
|
|
|
|
|
|
# AUTHENTICATION
|
|
|
|
|
# cookie search
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#for apache 2
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my $__cookie;
|
|
|
|
|
my $entete2 = $r->headers_in();
|
|
|
|
|
my $host = $entete2->{Host};
|
|
|
|
|
|
|
|
|
|
#<Recuperation de l'adresse IP cliente>
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $connection = $r->connection();
|
|
|
|
|
my $client_addr = $connection->remote_ip();
|
2006-12-18 12:32:33 +01:00
|
|
|
|
#</Recuperation de l'adresse IP cliente>
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#<Modification pour test time out>
|
|
|
|
|
#Recuperation du Cookie
|
|
|
|
|
my $idx_tmp = $entete2->{'Cookie'};
|
|
|
|
|
my $idx;
|
|
|
|
|
my $timeout;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( defined( $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT} )
|
|
|
|
|
&& $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT} != 0 )
|
|
|
|
|
{
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
( $idx, $timeout ) =
|
|
|
|
|
Lemonldap::Handlers::Utilities::get_my_timeout(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$CONFIG{$ID_COLLECTED}, $idx_tmp );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$idx = $idx_tmp;
|
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#</Modification pour test time out>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
( my $id, my $cook ) =
|
2007-03-01 11:36:20 +01:00
|
|
|
|
Lemonldap::Handlers::Utilities::cleanupcookie( $CONFIG{$ID_COLLECTED},$idx );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
if ( $cook ne $idx ) {
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
### I must rewrite cookie header)
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$r->headers_in->unset('Cookie');
|
|
|
|
|
$r->headers_in->add( 'Cookie' => $cook ) if $cook;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$__cookie = $idx;
|
|
|
|
|
|
|
|
|
|
# Load id value from cookie
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#NEW if the config is 'softcontrol' no need cookie
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( ( !( $CONFIG{$ID_COLLECTED}->{SOFTCONTROL} ) and !$id ) ) {
|
|
|
|
|
|
|
|
|
|
# No cookie found: redirect to portal
|
|
|
|
|
$messagelog =
|
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID} : No cookie found for "
|
|
|
|
|
. $r->uri;
|
|
|
|
|
$log->info($messagelog);
|
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal( $r,
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$CONFIG{$ID_COLLECTED}, 'c' );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
my $label = $id || 'SOFTCONTROL';
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: id session : $label");
|
|
|
|
|
|
|
|
|
|
#Verification du time out
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if (!( $CONFIG{$ID_COLLECTED}->{SOFTCONTROL} ) and defined( $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT} )
|
|
|
|
|
and $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT} != 0 )
|
2006-12-18 12:32:33 +01:00
|
|
|
|
{
|
|
|
|
|
if ( time() > $timeout ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->warn("SESSION EXPIRED FOR INACTIVITY");
|
2007-11-06 17:15:01 +01:00
|
|
|
|
if ($CONFIG{$ID_COLLECTED}->{URLCDATIMEOUT}) {
|
2007-10-24 11:13:44 +02:00
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal( $r,
|
|
|
|
|
$CONFIG{$ID_COLLECTED}, 'x', $id );
|
|
|
|
|
|
|
|
|
|
} else
|
|
|
|
|
{
|
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal( $r,
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$CONFIG{$ID_COLLECTED}, 't', $id );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
2007-10-24 11:13:44 +02:00
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# SESSIONS CACHE
|
|
|
|
|
########################################################################################################################
|
|
|
|
|
#<SEARCH IN CACHE LEVEL 1>
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my $ligne_h;
|
|
|
|
|
my $sessExpTime;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
return $APACHE_CODE unless ($id);
|
|
|
|
|
if ( $id ne $ID_SAVE ) {
|
|
|
|
|
%CLIENT = '';
|
|
|
|
|
}
|
|
|
|
|
$ID_SAVE = $id;
|
|
|
|
|
my $cache1key;
|
|
|
|
|
#key of level one cache
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{CLIENTIPCHECK} ) {
|
|
|
|
|
$cache1key = "$id#$ID_COLLECTED#$client_addr";
|
|
|
|
|
}else{
|
|
|
|
|
$cache1key = "$id#$ID_COLLECTED";
|
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
#value of level one cache
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$ligne_h = $CLIENT{$cache1key};
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
if ($ligne_h) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( defined( $CONFIG{$ID_COLLECTED}->{SESSCACHEREFRESHPERIOD} ) ) {
|
|
|
|
|
my @tab = split ( ":", $ligne_h );
|
|
|
|
|
$sessExpTime = $tab[2];
|
|
|
|
|
}
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: match in cache level 1 for $cache1key") if $ligne_h;
|
|
|
|
|
|
|
|
|
|
#</SEARCH IN CACHE LEVEL 1>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
########################################################################################################################
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#<SEARCH IN CACHE LEVEL 2>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
else {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
# Level 2 test by IPC
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: No match in cache level 1 for $cache1key");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{CACHEDBPATH} ) {
|
|
|
|
|
my $message;
|
|
|
|
|
( $ligne_h, $message ) =
|
2007-03-01 11:36:20 +01:00
|
|
|
|
&Lemonldap::Handlers::Utilities::cache2( $CONFIG{$ID_COLLECTED}
|
|
|
|
|
->{CACHEDBPATH}, $$, $cache1key );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$__STACK = 1;
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}:$message");
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( $ligne_h && defined( $CONFIG{$ID_COLLECTED}->{SESSCACHEREFRESHPERIOD} )) {
|
|
|
|
|
my @tab2 = split ( ":", $ligne_h );
|
|
|
|
|
$sessExpTime = $tab2[2];
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#</SEARCH IN CACHE LEVEL 2>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
###################################################################################################################################
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#<SEARCH IN CACHE LEVEL 3>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
unless ($ligne_h) { # no match in cache level 1 and 2
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID} : Search in cache level 3 for $id");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my $dn;
|
|
|
|
|
my $etat = 0; # 0 = denied ,NULL = not found other values is OK ;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
|
|
|
|
#Search in the servers memcached
|
|
|
|
|
my $controle = &Lemonldap::Handlers::Core::locationRules(
|
|
|
|
|
config => $CONFIG{$ID_COLLECTED},
|
|
|
|
|
id => $id,
|
|
|
|
|
uri => $uri,
|
|
|
|
|
host => $host,
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
if ( $controle == 0 ) {
|
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal( $r, $CONFIG{$ID_COLLECTED}, 't', $id );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( !defined( $controle->{string} ) ) {
|
|
|
|
|
if ( $controle->{response} ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->notice("$CONFIG{$ID_COLLECTED}->{HANDLERID}: controle: $controle->{dn} $uri :DENIED ($controle->{response}) ");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
return $controle->{response};
|
|
|
|
|
}
|
|
|
|
|
$log->notice(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: $id ERROR TIMEOUT ");
|
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal( $r, $CONFIG{$ID_COLLECTED}, 't', $id );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
|
|
|
|
#Verification of the remote adress
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( ($controle->{clientIPAdress} ne $client_addr) && $CONFIG{$ID_COLLECTED}->{CLIENTIPCHECK} ) {
|
|
|
|
|
$log->notice("$CONFIG{$ID_COLLECTED}->{HANDLERID}: $id ERROR WRONG IP : $client_addr");
|
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal($r, $CONFIG{$ID_COLLECTED}, 'i', $id);
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my $header = &Lemonldap::Handlers::Core::getHeader(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
config => $CONFIG{$ID_COLLECTED},
|
|
|
|
|
dn => $controle->{dn},
|
|
|
|
|
uid => $controle->{uid},
|
|
|
|
|
profil => $controle->{string},
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$ligne_h = $header->{decoded};
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( defined( $CONFIG{$ID_COLLECTED}->{SESSCACHEREFRESHPERIOD} ) ) {
|
|
|
|
|
$sessExpTime = $controle->{SessExpTime};
|
|
|
|
|
$ligne_h = $ligne_h.":".$sessExpTime;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: $cache1key saving in cache level 2");
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$__STACK = 0;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
&Lemonldap::Handlers::Utilities::save_session( $cache1key,$ligne_h );
|
|
|
|
|
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: SESSION FIND IN CACHE 3 FOR ID $id");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: controle: $controle->{dn} $uri :ACCEPTED");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#</SEARCH IN CACHE LEVEL 3>
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#<UPDATING CACHE LEVEL 1>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$CLIENT{$cache1key} = $ligne_h;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: $cache1key saving in cache level 1");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#</UPDATING CACHE LEVEL 1>
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $titi;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
#<REFRESH LDAP>
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( defined( $CONFIG{$ID_COLLECTED}->{SESSCACHEREFRESHPERIOD} ) ) {
|
|
|
|
|
my $ttl;
|
|
|
|
|
if ( defined( $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT} ) ) {
|
|
|
|
|
$ttl = $CONFIG{$ID_COLLECTED}->{SESSCACHEREFRESHPERIOD} + $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT};
|
|
|
|
|
}else{
|
|
|
|
|
$ttl = $CONFIG{$ID_COLLECTED}->{SESSCACHEREFRESHPERIOD} * 2;
|
|
|
|
|
}
|
|
|
|
|
(my $return_code,my $HashSession,my $profil,my $reponse) = &Lemonldap::Handlers::Core::Check_Refresh( config => $CONFIG{$ID_COLLECTED},
|
|
|
|
|
id => $id,
|
|
|
|
|
uri => $uri,
|
|
|
|
|
host => $host,
|
|
|
|
|
logs => $log,
|
|
|
|
|
ExpTime => $sessExpTime);
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ($return_code == -1){
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal( $r, $CONFIG{$ID_COLLECTED}, 't', $id );
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if ($return_code != 0){
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: SessExpTime expired. Caches need to be refresh at all level");
|
|
|
|
|
if ($return_code == 1){
|
|
|
|
|
#Rafraichissement LDAP
|
|
|
|
|
#A modifier pour les versions ulte<74>riers
|
|
|
|
|
#
|
|
|
|
|
#
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$HashSession->{SessExpTime}= &Lemonldap::Handlers::Utilities::fake_refresh_ldap($HashSession,$CONFIG{$ID_COLLECTED},$ttl);
|
|
|
|
|
$titi = $HashSession->{SessExpTime};
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: Reninitializing the SessExpTime on the central server memcached");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#Updating cache 3
|
|
|
|
|
&Lemonldap::Handlers::Utilities::save_memcached_local($HashSession,$CONFIG{$ID_COLLECTED}->{SERVERS},$ttl);
|
|
|
|
|
#Creation du Header
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $new_header = &Lemonldap::Handlers::Core::getHeader(
|
|
|
|
|
config => $CONFIG{$ID_COLLECTED},
|
|
|
|
|
dn => $HashSession->{dn},
|
|
|
|
|
uid => $HashSession->{uid},
|
|
|
|
|
profil => $profil,
|
|
|
|
|
);
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$ligne_h = $new_header->{decoded};
|
|
|
|
|
$ligne_h = $ligne_h.":".$HashSession->{SessExpTime};
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#Updating cache 1
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$CLIENT{$cache1key} = $ligne_h;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#Updating cache 2
|
|
|
|
|
|
|
|
|
|
&Lemonldap::Handlers::Utilities::save_session( $cache1key,$ligne_h );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if (!defined($profil)) {
|
|
|
|
|
if ( defined($reponse) ) {
|
|
|
|
|
$log->notice("$CONFIG{$ID_COLLECTED}->{HANDLERID}: controle: $HashSession->{dn} $uri :DENIED ($reponse) ");
|
|
|
|
|
return $reponse;
|
|
|
|
|
}
|
|
|
|
|
$log->notice("$CONFIG{$ID_COLLECTED}->{HANDLERID}: $id ERROR TIMEOUT ");
|
|
|
|
|
return &Lemonldap::Handlers::Utilities::goPortal( $r, $CONFIG{$ID_COLLECTED}, 't', $id );
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
$log->notice("$CONFIG{$ID_COLLECTED}->{HANDLERID}: Caches has been refresh");
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
#</REFRESH LDAP>
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
# all is done for this phase we can cache the header .
|
|
|
|
|
# now we must up date the cache level 1 and 2 (IPC)
|
|
|
|
|
|
|
|
|
|
##### I must to resume here (the three caches )
|
|
|
|
|
####
|
|
|
|
|
###
|
|
|
|
|
#
|
|
|
|
|
### add user in access log
|
|
|
|
|
if ( defined( $CONFIG{$ID_COLLECTED}->{SESSCACHEREFRESHPERIOD} ) ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my @tab = split ( ":", $ligne_h );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$ligne_h = $tab[0] . ":" . $tab[1];
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
my $_header = &Lemonldap::Handlers::Core::forgeHeader(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
config => $CONFIG{$ID_COLLECTED},
|
|
|
|
|
line => $ligne_h,
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
2007-03-01 11:36:20 +01:00
|
|
|
|
my $sep = "_";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
#<TEST TIMEOUT>
|
|
|
|
|
if ( defined $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT} ) {
|
|
|
|
|
|
|
|
|
|
my $inact = $CONFIG{$ID_COLLECTED}->{INACTIVITYTIMEOUT};
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( $inact != 0 ) {
|
|
|
|
|
|
|
|
|
|
my $new_time = time() + $inact;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( defined( $CONFIG{$ID_COLLECTED}->{ENCRYPTIONKEY} ) ) {
|
|
|
|
|
my $cle = $CONFIG{$ID_COLLECTED}->{ENCRYPTIONKEY};
|
|
|
|
|
my $ciphe = new Crypt::CBC(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
-key => $cle,
|
|
|
|
|
-cipher => 'Blowfish',
|
|
|
|
|
-iv => 'lemonlda',
|
|
|
|
|
-header => 'none'
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
$new_time = $ciphe->encrypt_hex($new_time);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
my $val_test = $id . $sep . $new_time;
|
|
|
|
|
my $name = $CONFIG{$ID_COLLECTED}->{COOKIE};
|
|
|
|
|
my $domain = "." . $CONFIG{$ID_COLLECTED}->{DOMAIN};
|
|
|
|
|
|
|
|
|
|
my $new_cookie = CGI::Cookie->new(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
-name => $name,
|
|
|
|
|
-value => $val_test,
|
|
|
|
|
-domain => $domain,
|
|
|
|
|
-path => "/",
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
$r->headers_out->add( 'Set-Cookie' => $new_cookie );
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("Timeout re-initialized");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
else {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2007-10-24 11:13:44 +02:00
|
|
|
|
"The inactivity timeout has been positionned at O!!!!");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2007-10-24 11:13:44 +02:00
|
|
|
|
"The inactivity timeout hasn't been set." );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#</TEST TIMEOUT>
|
|
|
|
|
|
|
|
|
|
if ($_header) {
|
|
|
|
|
$r->user( $_header->{user} ) if $_header->{user};
|
|
|
|
|
my $hcode = $_header->{content};
|
|
|
|
|
|
|
|
|
|
############### We can insert the header #####################
|
|
|
|
|
|
|
|
|
|
$r->headers_in->add( $_header->{header} => $hcode );
|
|
|
|
|
$log->info(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: header genered :$_header->{header} => $hcode "
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
$log->info(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: header before encoding: $ligne_h"
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
$log->info(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: header after encoding: $hcode"
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}:no header genered ");
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
### supprimer en prod ####
|
2006-12-18 12:32:33 +01:00
|
|
|
|
# my $l = Dumper (%CONFIG );
|
|
|
|
|
return $APACHE_CODE
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
################
|
|
|
|
|
# #
|
|
|
|
|
# end handler #
|
|
|
|
|
# #
|
|
|
|
|
################
|
|
|
|
|
|
|
|
|
|
####################################
|
|
|
|
|
# proxy_handler :the lwp engine #
|
|
|
|
|
# #
|
|
|
|
|
####################################
|
|
|
|
|
#TODO : timeout
|
|
|
|
|
# 500 return code
|
2007-03-01 11:36:20 +01:00
|
|
|
|
# motifout instead motifin
|
2006-12-18 12:32:33 +01:00
|
|
|
|
sub proxy_handler {
|
|
|
|
|
my $r = shift;
|
|
|
|
|
|
|
|
|
|
# Transformation: GET /index.html becomes http://servername/index.html
|
|
|
|
|
# $url contains the real value (hided server)
|
|
|
|
|
# $url_init contains the asked value
|
|
|
|
|
#add this in order to log
|
|
|
|
|
my $log = $r->log;
|
|
|
|
|
my $url = $r->uri;
|
|
|
|
|
my $entete2 = $r->headers_in();
|
|
|
|
|
my $HOST = $entete2->{'Host'};
|
|
|
|
|
my $flag = 0;
|
|
|
|
|
my $host_target;
|
|
|
|
|
$url = "/" unless $url;
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
# replace formatin by formatout
|
2006-12-18 12:32:33 +01:00
|
|
|
|
#
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: LWP ENGINE URL $url");
|
|
|
|
|
$log->info("$CONFIG{$ID_COLLECTED}->{HANDLERID}: LWP ENGINE HOST $HOST");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{MOTIFOUT} ) {
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{MOTIFOUT} =~ /ANYWHERE/ ) {
|
|
|
|
|
$flag = 1;
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$r->headers_in->unset('Accept-Encoding');
|
2006-12-18 12:32:33 +01:00
|
|
|
|
( $host_target, my $suite ) = $url =~ /\/(.+?)\/(.+)/;
|
|
|
|
|
($host_target) = $url =~ /\/(.+)/ unless $host_target;
|
|
|
|
|
$host_target =~ s/\/$//;
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#$host=~ s/_/\./g;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$suite = "/" unless $suite;
|
|
|
|
|
$suite = "/" . $suite unless $suite =~ /^\//;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$suite = "/" unless $suite;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$url = $suite;
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2006-12-18 12:32:33 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}:LWP ANYWHERE DESTINATION actived $host_target -- $suite "
|
|
|
|
|
);
|
|
|
|
|
$CONFIG{$ID_COLLECTED}->{BASEPRIV} = "http://$host_target";
|
|
|
|
|
}
|
|
|
|
|
else {
|
2007-11-20 12:02:50 +01:00
|
|
|
|
if ($CONFIG{$ID_COLLECTED}->{MOTIFOUT} eq '/' ) {
|
|
|
|
|
$url =~
|
|
|
|
|
s/$CONFIG{$ID_COLLECTED}->{MOTIFIN}//;
|
|
|
|
|
} else {
|
|
|
|
|
$url =~
|
2006-12-18 12:32:33 +01:00
|
|
|
|
s/$CONFIG{$ID_COLLECTED}->{MOTIFIN}/$CONFIG{$ID_COLLECTED}->{MOTIFOUT}/;
|
2007-11-20 12:02:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$url .= "?" . $r->args if ( $r->args );
|
|
|
|
|
my $url_init = $CONFIG{$ID_COLLECTED}->{BASEPUB} . $url;
|
|
|
|
|
my $uuu = $url;
|
|
|
|
|
$url = $CONFIG{$ID_COLLECTED}->{BASEPRIV} . $uuu;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info( "$CONFIG{$ID_COLLECTED}->{HANDLERID}: URLPRIV ACTIVED: $url
|
2006-12-18 12:32:33 +01:00
|
|
|
|
URLPUB REQUESTED : $url_init"
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
my $request = HTTP::Request->new( $r->method, $url );
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$r->headers_in->do( sub {
|
|
|
|
|
$request->header(@_);
|
|
|
|
|
1;
|
|
|
|
|
} );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
# copy POST data, if any
|
|
|
|
|
if ( $r->method eq 'POST' ) {
|
2007-05-25 10:47:59 +02:00
|
|
|
|
my $len =0;
|
|
|
|
|
$len = $r->headers_in->{'Content-length'};
|
|
|
|
|
my $buf='';
|
|
|
|
|
if ($len < 0 ) { $len=0;}
|
|
|
|
|
if ($len > 0) {
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$r->read( $buf, $len );
|
2007-05-25 10:47:59 +02:00
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$request->content($buf);
|
2007-04-24 15:58:05 +02:00
|
|
|
|
$request->content_type( $r->headers_in->{'Content-Type'} );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
###begin: some modification like mod_proxy does
|
|
|
|
|
if ( $request->header('Host') ) {
|
|
|
|
|
my $host = $request->header('Host');
|
|
|
|
|
( my $priv ) = $CONFIG{$ID_COLLECTED}->{BASEPRIV} =~ /:\/\/(.+)/;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
( my $pub ) = $CONFIG{$ID_COLLECTED}->{BASEPUB} =~ /:\/\/(.+)/;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$host =~ s/$pub/$priv/;
|
2007-07-16 14:30:51 +02:00
|
|
|
|
$host =~ s/:\d+$// ;
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$request->header( 'Host' => $host );
|
|
|
|
|
|
2007-07-16 14:30:51 +02:00
|
|
|
|
#DEBUG 16/07/2007
|
|
|
|
|
|
2007-10-24 11:13:44 +02:00
|
|
|
|
#print STDERR "DEBUG ADONIS: PRIV: $priv PUB: $pub HOST_TARGET : $host_target " ;
|
2007-07-16 14:30:51 +02:00
|
|
|
|
#
|
|
|
|
|
#END
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
### here I modify keep alive by close
|
|
|
|
|
# if ($request->header('Connection')){
|
|
|
|
|
# $request->header('Connection' => 'close');
|
|
|
|
|
# }
|
|
|
|
|
# if ($request->header('Keep-Alive')){
|
|
|
|
|
# $request->header('Keep-Alive' => '');
|
|
|
|
|
# }
|
|
|
|
|
|
|
|
|
|
my $messagelog =
|
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: request " . $request->as_string();
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info($messagelog);
|
|
|
|
|
#> modif du 20/04/06 reverse condition
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( !$CONFIG{$ID_COLLECTED}->{CHASEREDIRECT} ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: LWP CHASEREDIRECT DESACTIVED(DEFAULT)");
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my @tt = ('HEAD');
|
|
|
|
|
$UA->requests_redirectable( \@tt );
|
2007-03-01 11:36:20 +01:00
|
|
|
|
} else
|
|
|
|
|
{
|
|
|
|
|
my @tt = ('HEAD','GET');
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$UA->requests_redirectable( \@tt );
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: LWP CHASEREDIRECT ACTIVED");
|
|
|
|
|
|
|
|
|
|
}
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
### deal this lwptimeout :
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{LWPTIMEOUT} ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2006-12-18 12:32:33 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}:LWP TIMEOUT :$CONFIG{$ID_COLLECTED}->{LWPTIMEOUT} armed"
|
|
|
|
|
);
|
|
|
|
|
$UA->timeout( $CONFIG{$ID_COLLECTED}->{LWPTIMEOUT} );
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# LWP proxy
|
|
|
|
|
# I 'll forward on an external proxy
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{APPLPROXY} ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info(
|
2006-12-18 12:32:33 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}:OUTPUT PROXY:$CONFIG{$ID_COLLECTED}->{APPLPROXY}"
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
$UA->proxy( http => $CONFIG{$ID_COLLECTED}->{APPLPROXY} );
|
|
|
|
|
}
|
|
|
|
|
if ( $url =~ /_lemonldap_debug/ ) {
|
|
|
|
|
$r->content_type('text/html');
|
|
|
|
|
$r->print(<<END);
|
|
|
|
|
<html>
|
|
|
|
|
<head><title>lemonldap websso</title></head>
|
|
|
|
|
<body>
|
|
|
|
|
<h1>Lemonldap websso headers</h1>
|
|
|
|
|
<p>
|
|
|
|
|
END
|
|
|
|
|
my $l = $request->as_string();
|
|
|
|
|
$l =~ s/\n/<br>/g;
|
|
|
|
|
$r->print($l);
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$r->print( "</body>
|
|
|
|
|
</html>" );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
return OK;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
####################################
|
|
|
|
|
# here implementation #
|
|
|
|
|
# https gateway #
|
|
|
|
|
# #
|
|
|
|
|
# #
|
|
|
|
|
# #
|
|
|
|
|
####################################
|
|
|
|
|
#
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{HTTPS} ) {
|
|
|
|
|
|
|
|
|
|
# on veut faire du https avec le serveur a proteger
|
|
|
|
|
eval "use Crypt::SSLeay;";
|
|
|
|
|
|
|
|
|
|
$ENV{HTTPS_VERSION} = '3';
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{AUTH} ) {
|
|
|
|
|
|
|
|
|
|
# lemonldap doit s'authentifier par certificat
|
|
|
|
|
if ( $CONFIG{$ID_COLLECTED}->{PKCS12} ) {
|
|
|
|
|
|
|
|
|
|
# la presence de pkcs12 est testee en premier
|
|
|
|
|
$ENV{HTTPS_PKCS12_FILE} = $CONFIG{$ID_COLLECTED}->{PKCS12};
|
|
|
|
|
$ENV{HTTPS_PKCS12_PASSWORD} =
|
|
|
|
|
$CONFIG{$ID_COLLECTED}->{PKCS12_PWD};
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$ENV{HTTPS_CERT_FILE} = $CONFIG{$ID_COLLECTED}->{CERT_FILE};
|
|
|
|
|
$ENV{HTTPS_KEY_FILE} = $CONFIG{$ID_COLLECTED}->{KEY_FILE};
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
#
|
|
|
|
|
####################
|
2006-12-18 12:32:33 +01:00
|
|
|
|
# fin https gateway#
|
|
|
|
|
####################
|
|
|
|
|
#
|
|
|
|
|
#
|
|
|
|
|
my $response = $UA->request($request);
|
|
|
|
|
|
|
|
|
|
### begin: somes bad requests have bad header .
|
|
|
|
|
$messagelog =
|
2007-03-01 11:36:20 +01:00
|
|
|
|
"$CONFIG{$ID_COLLECTED}->{HANDLERID}: response "
|
|
|
|
|
. $response->as_string();
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$log->info($messagelog);
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
my $content = $response->header('Content-type');
|
|
|
|
|
$content = 'text/html' unless $content;
|
|
|
|
|
$content =~ s/,/;/g;
|
|
|
|
|
|
|
|
|
|
### end: somes bad requests have bad header .
|
|
|
|
|
$r->content_type($content);
|
|
|
|
|
|
|
|
|
|
### begin: I correct on the fly some incomming header like mod_proxy does
|
|
|
|
|
if ( $response->header('Location') ) {
|
|
|
|
|
my $h = $response->header('Location');
|
2007-11-06 16:33:36 +01:00
|
|
|
|
### In case of multihoming context , sometimes location is not a well know location ,so I must adjust this handly
|
|
|
|
|
if ($CONFIG{$ID_COLLECTED}->{SOURCEREDIRECTION}) {
|
|
|
|
|
$h=~ s/$CONFIG{$ID_COLLECTED}->{SOURCEREDIRECTION}/$CONFIG{$ID_COLLECTED}->{TARGETREDIRECTION}/;
|
|
|
|
|
}
|
2007-07-16 14:30:51 +02:00
|
|
|
|
|
|
|
|
|
#Patch 16/07/2007 pour traitement du port dans le Location des 302
|
|
|
|
|
|
|
|
|
|
my $trait_loc;
|
|
|
|
|
|
|
|
|
|
if (( $h =~ /:\d+$/) && ($CONFIG{$ID_COLLECTED}->{BASEPRIV} =~ /:\d+$/ ) ) {
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$h =~
|
2007-03-01 11:36:20 +01:00
|
|
|
|
s/$CONFIG{$ID_COLLECTED}->{BASEPRIV}/$CONFIG{$ID_COLLECTED}->{BASEPUB}/
|
2006-12-18 12:32:33 +01:00
|
|
|
|
unless $flag;
|
2007-07-16 14:30:51 +02:00
|
|
|
|
$trait_loc = "Port dans Location ET Basepriv \n" ;
|
|
|
|
|
}elsif ( !( $h =~ /:\d+$/) && ! ($CONFIG{$ID_COLLECTED}->{BASEPRIV} =~ /:\d+$/ ) ) {
|
|
|
|
|
|
|
|
|
|
$h =~ s/$CONFIG{$ID_COLLECTED}->{BASEPRIV}/$CONFIG{$ID_COLLECTED}->{BASEPUB}/
|
|
|
|
|
unless $flag;
|
|
|
|
|
$trait_loc = "Aucun Port\n " ;
|
|
|
|
|
} else {
|
|
|
|
|
|
|
|
|
|
(my $privreduct ) = $CONFIG{$ID_COLLECTED}->{BASEPRIV} =~ /^(.+):\d+$/ ;
|
|
|
|
|
$h =~ s/$privreduct/$CONFIG{$ID_COLLECTED}->{BASEPUB}/
|
|
|
|
|
unless $flag;
|
|
|
|
|
$trait_loc = "Port dans Basepriv uniquement \n" ;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#print STDERR "Traitement Location : " . $trait_loc ;
|
|
|
|
|
#FIn de patch
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
if ($flag) {
|
|
|
|
|
$h =~ s/:\/\//:\/\/$HOST\//;
|
|
|
|
|
$h =~ s/http:/https:/g;
|
|
|
|
|
}
|
|
|
|
|
$response->header( 'Location' => $h );
|
2007-07-16 14:30:51 +02:00
|
|
|
|
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
############ a voir ########################
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( $response->header('Content-Base') ) {
|
|
|
|
|
my $h = $response->header('Content-Base');
|
|
|
|
|
$h =~
|
2007-03-01 11:36:20 +01:00
|
|
|
|
s/$CONFIG{$ID_COLLECTED}->{BASEPRIV}/$CONFIG{$ID_COLLECTED}->{BASEPUB}/
|
2006-12-18 12:32:33 +01:00
|
|
|
|
unless $flag;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
$h =~ s/:\/\//:\/\/$HOST\// if $flag;
|
2007-03-01 11:36:20 +01:00
|
|
|
|
;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
# $h =~ s/http:\/\//http:\/\/$HOST\//;
|
|
|
|
|
$response->header( 'Content-Base' => $h );
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
### end: I correct on the fly some incomming header like mod_proxy does
|
|
|
|
|
my $code = $response->code();
|
|
|
|
|
if ( $code == 500 ) {
|
|
|
|
|
$r->status(503);
|
|
|
|
|
return 503;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
$r->status( $response->code() );
|
|
|
|
|
}
|
|
|
|
|
$r->status_line( join " ", $response->code(), $response->message );
|
2007-03-01 11:36:20 +01:00
|
|
|
|
$response->scan( sub {
|
|
|
|
|
( my $cle, my $val ) = @_;
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
if ( $cle =~ /set-cookie/i ) {
|
|
|
|
|
my $lcookie =
|
|
|
|
|
Lemonldap::Handlers::Utilities::rewrite_cookie( $val,
|
|
|
|
|
$CONFIG{$ID_COLLECTED} );
|
|
|
|
|
$r->headers_out->add( $cle => $lcookie );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
# $r->headers_out->add($cle => $lcookie[1] ) if $lcookie[1];
|
|
|
|
|
}
|
|
|
|
|
else { $r->headers_out->add( $cle => $val ) unless $cle =~ /Client/; }
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
} );
|
2006-12-18 12:32:33 +01:00
|
|
|
|
if ( $r->header_only ) {
|
|
|
|
|
return OK;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$content = \$response->content;
|
|
|
|
|
my $html = $$content;
|
2007-09-24 15:13:48 +02:00
|
|
|
|
if ( $flag == 1 or $CONFIG{$ID_COLLECTED}->{REWRITEHTML} ) { #### IF MODE ANYWHERE ####
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
######################################################################
|
|
|
|
|
# here I 'm modifying the html source for yahoo.fr and google.fr #
|
2007-03-01 11:36:20 +01:00
|
|
|
|
# I think that I must improve modifications but It's just for demo #
|
|
|
|
|
# the site target must be KISS keep it Simple and Stupid #
|
2006-12-18 12:32:33 +01:00
|
|
|
|
######################################################################
|
|
|
|
|
$html = &Lemonldap::Handlers::Core::ParseHtml(
|
2007-03-01 11:36:20 +01:00
|
|
|
|
html => $html,
|
|
|
|
|
https => $ENV{HTTPS},
|
|
|
|
|
config => $CONFIG{$ID_COLLECTED},
|
|
|
|
|
host => $HOST,
|
2007-09-24 14:19:04 +02:00
|
|
|
|
uri =>$url,
|
2007-03-01 11:36:20 +01:00
|
|
|
|
target => $host_target
|
2006-12-18 12:32:33 +01:00
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
$r->content_type('text/html') unless $$content;
|
|
|
|
|
$r->print( $html || $response->error_as_HTML );
|
|
|
|
|
$log->notice("$CONFIG{$ID_COLLECTED}->{HANDLERID}: $url response sent");
|
|
|
|
|
return OK;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#####################
|
|
|
|
|
# #
|
|
|
|
|
# end proxy_handler #
|
|
|
|
|
# lwp engine #
|
|
|
|
|
# #
|
|
|
|
|
#####################
|
|
|
|
|
|
|
|
|
|
###########################################################
|
|
|
|
|
# _lemonldap_internal handler #
|
|
|
|
|
# add at your url /_lemonldap_internal #
|
|
|
|
|
# eg : http://appli1.demo.net/_lemonldap_internal #
|
|
|
|
|
# in order to dump the internal config of apache children #
|
|
|
|
|
# add ?id=handler append another config handler on output #
|
|
|
|
|
# #
|
|
|
|
|
###########################################################
|
|
|
|
|
|
|
|
|
|
sub _lemonldap_internal {
|
|
|
|
|
my $r = shift;
|
|
|
|
|
my $p = $r->args;
|
|
|
|
|
my @parax = split "&", $p;
|
|
|
|
|
my @pr;
|
|
|
|
|
|
|
|
|
|
foreach (@parax) {
|
|
|
|
|
( my $cle, my $val ) = split "=", $_;
|
|
|
|
|
push @pr, $cle;
|
|
|
|
|
push @pr, $val;
|
|
|
|
|
}
|
|
|
|
|
my %param = @pr;
|
|
|
|
|
|
|
|
|
|
$r->content_type('text/html');
|
|
|
|
|
$r->print(<<END);
|
|
|
|
|
<html>
|
|
|
|
|
<head><title>lemonldap websso</title></head>
|
|
|
|
|
<body>
|
|
|
|
|
<h1>Lemonldap websso internal table</h1>
|
|
|
|
|
<p>
|
|
|
|
|
|
|
|
|
|
END
|
|
|
|
|
|
|
|
|
|
foreach ( keys %CONFIG ) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "$_<br>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "<hr>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my $tmp = $CONFIG{$ID_COLLECTED};
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "<h3>$ID_COLLECTED on $$</H3>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
foreach ( keys %$tmp ) {
|
|
|
|
|
if ( ref $tmp->{$_} ) {
|
|
|
|
|
my $t = ref $tmp->{$_};
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "$_ => $t reference<br>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
else {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "$_ => $tmp->{$_}<br>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
my $s = $param{'id'};
|
|
|
|
|
if ($s) {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "<hr>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
my $tmp = $CONFIG{$s};
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "<h3>$s on $$ (features)</H3>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
foreach ( keys %$tmp ) {
|
|
|
|
|
if ( ref $tmp->{$_} ) {
|
|
|
|
|
my $t = ref $tmp->{$_};
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "$_ => $t reference<br>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
else {
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "$_ => $tmp->{$_}<br>\n";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
print "</body>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
</html>
|
2007-03-01 11:36:20 +01:00
|
|
|
|
";
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
return OK;
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
############################
|
|
|
|
|
# #
|
|
|
|
|
# end _lemonldap_internal #
|
|
|
|
|
# handler #
|
|
|
|
|
# #
|
|
|
|
|
############################
|
|
|
|
|
|
|
|
|
|
1;
|
|
|
|
|
|
|
|
|
|
###############################
|
|
|
|
|
### fin etape 1
|
|
|
|
|
##############################
|
|
|
|
|
|
|
|
|
|
=pod
|
|
|
|
|
|
|
|
|
|
=for html <center> <H1> Lemonldap::Handlers::Generic4a2 </H1></center>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
|
|
Lemonldap::Handlers::Generic - Perl extension for Lemonldap sso system
|
|
|
|
|
|
|
|
|
|
Lemonldap::Handlers::Generic4a2 - Handler for Apache2 Lemonldap SSO
|
|
|
|
|
system
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
|
|
|
|
Lemonldap::Handlers::Generic4a2SSL - Handler full SSL Apache2 Lemonldap SSO
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
|
|
In httpd.conf
|
|
|
|
|
|
|
|
|
|
.....
|
|
|
|
|
perltranshandler Lemonldap::Handlers::Generic4a2
|
|
|
|
|
.....
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
|
|
Generic4a2 is the central piece of websso framework .
|
|
|
|
|
This module provides several methods but the principal goal of this is the handler function .
|
|
|
|
|
It can be combined with mod_proxy or mod_rewrite and all other apache's modules .
|
|
|
|
|
It provides also an built-in http proxy with LWP .
|
|
|
|
|
see http://lemonldap.sf.net for more infos .
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=head2 Parameters (see also doc folder)
|
|
|
|
|
|
|
|
|
|
A minimal configuration must provide infos about :
|
|
|
|
|
|
|
|
|
|
=over 1
|
|
|
|
|
|
|
|
|
|
=item config
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
LemonldapConfig "/foo/bar/file_config.xml"
|
|
|
|
|
The filename of the mean XML Config :It's REQUIRED
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
=item domain
|
2007-03-01 11:36:20 +01:00
|
|
|
|
|
|
|
|
|
LemonldapDomain foo.bar
|
2006-12-18 12:32:33 +01:00
|
|
|
|
It fixes the value of domain for the application protected by this handler (see below)
|
|
|
|
|
|
|
|
|
|
=item xml section in config
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
LemonldapHandlerId <xml section>
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
It fixes the value of XML section in config
|
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=head2 Example (a KISS example, see also eg folder)
|
|
|
|
|
|
|
|
|
|
In httpd.conf
|
|
|
|
|
|
|
|
|
|
<virtualHost 127.0.0.1:80>
|
|
|
|
|
servername authen.demo.net
|
|
|
|
|
PerlModule Apache2::compat
|
|
|
|
|
PerlModule Bundle::Apache2
|
|
|
|
|
PerlModule Lemonldap::Handlers::Generic4a2
|
|
|
|
|
perltranshandler Lemonldap::Handlers::Generic4a2
|
2007-03-01 11:36:20 +01:00
|
|
|
|
PerlSetVar LemonldapDomain demo.net
|
|
|
|
|
PerlSetVar LemonldapConfig /usr/local/apache/conf/application_new.xml
|
|
|
|
|
PerlSetVar LemonldapHandlerID myintranet
|
2006-12-18 12:32:33 +01:00
|
|
|
|
proxypass /intranet http://lemonldap.sourceforge.net
|
|
|
|
|
proxypassreverse /intranet http://lemonldap.sourceforge.net
|
|
|
|
|
documentroot /usr/local/apache/htdocs
|
|
|
|
|
</virtualhost>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
In /usr/local/apache/conf/application_new.xml
|
|
|
|
|
<lemonconfig>
|
|
|
|
|
<domain id="demo.net"
|
|
|
|
|
Cookie="lemondemo"
|
|
|
|
|
>
|
|
|
|
|
<handler
|
|
|
|
|
id="myintranet"
|
2007-03-01 11:36:20 +01:00
|
|
|
|
DisabledControl="1"
|
2006-12-18 12:32:33 +01:00
|
|
|
|
/>
|
|
|
|
|
</domain>
|
|
|
|
|
</lemonconfig>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Now you can put http://authen.demo.net/intranet/ in your browser and you will see lemonldap's site
|
|
|
|
|
AND now you can control who and where goes on your site .
|
|
|
|
|
|
|
|
|
|
You can pass parameters from httpd.conf with perlsetvar facilities or put them in xml file
|
|
|
|
|
|
|
|
|
|
=head2 Functions
|
|
|
|
|
|
|
|
|
|
=over 1
|
|
|
|
|
|
|
|
|
|
=item handler
|
|
|
|
|
|
|
|
|
|
It's the mean function which does all jobs . If the enebledproxy parameter is set to 1 ,this function
|
|
|
|
|
will push proxy_handler function reference on the handler's stack . If not it returns DECLINED (mod_proxy will be actived)
|
|
|
|
|
|
|
|
|
|
=item proxy_handler
|
|
|
|
|
|
|
|
|
|
It's the built-in proxy (LWP) web embedded in lemonldap framework . It is actived by enabledproxy parameter .
|
|
|
|
|
Some parameters are about this proxy and its behaviour
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
=item _lemonldap_internal
|
|
|
|
|
|
|
|
|
|
append this keyword at the end of url and you will can see all config for a specific apache's child
|
|
|
|
|
|
2006-12-18 12:32:33 +01:00
|
|
|
|
=item _lemonldap_debug
|
|
|
|
|
|
|
|
|
|
append this keyword at the end of url and you will can see all headers send to host.
|
|
|
|
|
Available ONLY with built-in proxy
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=head2 Features
|
|
|
|
|
|
|
|
|
|
Generic4a2 is build arround perl's modules .
|
|
|
|
|
|
|
|
|
|
Those modules are :
|
|
|
|
|
|
|
|
|
|
=over 1
|
|
|
|
|
|
|
|
|
|
=item Utilities :
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
collection of function
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
=item Core :
|
|
|
|
|
|
|
|
|
|
It provides basics services like the cache service, forge header service or authorization service.
|
|
|
|
|
|
|
|
|
|
Core.pm can use YOUR own services for all this cycle . It's plugger . Lemonldap framework is available
|
2007-03-01 11:36:20 +01:00
|
|
|
|
with somes services but you can with Core.pm propose your schemas.
|
2006-12-18 12:32:33 +01:00
|
|
|
|
News parameters were added in XML DTD in order to describe the sequence.
|
|
|
|
|
|
|
|
|
|
=item MatrixPolicy :
|
|
|
|
|
|
|
|
|
|
manage authorization process , based on the hash of session (like preceding version)
|
|
|
|
|
|
|
|
|
|
=item Memsession :
|
|
|
|
|
|
2007-03-01 11:36:20 +01:00
|
|
|
|
manage the backend of session (cache level 3)
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
=item AuthorizationHeader :
|
|
|
|
|
|
|
|
|
|
manage the construction of header
|
|
|
|
|
|
|
|
|
|
=item RewriteHTML :
|
|
|
|
|
|
|
|
|
|
Rewrite on fly html source in order to ajust somes tags like BASE , href or src
|
|
|
|
|
Available ONLY with built-in proxy
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
=head4 More features
|
|
|
|
|
|
|
|
|
|
=over 1
|
|
|
|
|
|
|
|
|
|
=item Authentification
|
|
|
|
|
|
|
|
|
|
Keep in mind that the handler doesn't know HOW authenticate anybody but only knows WHERE authenticate .
|
|
|
|
|
The parameter 'portal' tells it where to send the authentification request.
|
|
|
|
|
|
|
|
|
|
=item Caches
|
|
|
|
|
|
|
|
|
|
Thre are three levels of cache in lemonldap .
|
|
|
|
|
|
|
|
|
|
*First cache (level 1) is a very KISS , it's a memory structure in the program .
|
|
|
|
|
*Next cache (level 2) is realised by using berkeleyDB hash
|
|
|
|
|
*Last cache (level 3) is realised by using memcached (see Apache::Session::Memorycached on CPAN)
|
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
|
|
|
|
|
Lemonldap(3), Lemonldap::Portal::Standard
|
|
|
|
|
|
|
|
|
|
http://lemonldap.sourceforge.net/
|
|
|
|
|
|
|
|
|
|
"Writing Apache Modules with Perl and C" by Lincoln Stein E<amp> Doug
|
|
|
|
|
MacEachern - O'REILLY
|
|
|
|
|
|
|
|
|
|
=over 1
|
|
|
|
|
|
|
|
|
|
=item Eric German, E<lt>germanlinux@yahoo.frE<gt>
|
|
|
|
|
|
|
|
|
|
=item Isabelle Serre, E<lt>isabelle.serre@justice.gouv.frE<gt>
|
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
|
2007-03-15 22:20:29 +01:00
|
|
|
|
Copyright (C) 2004 by Eric German E<amp> Isabelle Serre
|
2006-12-18 12:32:33 +01:00
|
|
|
|
|
|
|
|
|
Lemonldap originaly written by Eric german who decided to publish him in 2003
|
|
|
|
|
under the terms of the GNU General Public License version 2.
|
|
|
|
|
|
|
|
|
|
=over 1
|
|
|
|
|
|
|
|
|
|
=item This package is under the GNU General Public License, Version 2.
|
|
|
|
|
|
|
|
|
|
=item The primary copyright holder is Eric German.
|
|
|
|
|
|
|
|
|
|
=item Portions are copyrighted under the same license as Perl itself.
|
|
|
|
|
|
|
|
|
|
=item Portions are copyrighted by Doug MacEachern and Lincoln Stein.
|
|
|
|
|
This library is under the GNU General Public License, Version 2.
|
|
|
|
|
|
|
|
|
|
=item Portage under Apache2 is made with help of : Ali Pouya and
|
|
|
|
|
Shervin Ahmadi (MINEFI/DGI)
|
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
|
the Free Software Foundation; version 2 dated June, 1991.
|
|
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
A copy of the GNU General Public License is available in the source tree;
|
|
|
|
|
if not, write to the Free Software Foundation, Inc.,
|
|
|
|
|
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
|
|
|
|
|
|
|
|
=cut
|