* Help system skeleton in Manager
* Correction in apache-1.3 configuration file * Rights corrections in example files (Apache::Registry needs +x for apache-1.3 * perltidy on all files
This commit is contained in:
Xavier Guimard
parent
f1a9171c83
commit
90522e3e96
|
|
@ -1,5 +1,8 @@
|
|||
Revision history for Perl extension Lemonldap::NG::Handler.
|
||||
|
||||
0.72 Thu Jan 4 9:24:18 2007
|
||||
- Correction in apache-1.3 configuration example file
|
||||
|
||||
0.71 Sun Dec 31 13:47:49 2006
|
||||
- Bug corrections in Vhosts: default header does not work
|
||||
Safe does not work because lmSetHeaderIn
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
Changes
|
||||
example/lmH-apache.conf
|
||||
example/lmH-apache2.conf
|
||||
example/MyHandler.pm
|
||||
lib/Lemonldap/NG/Handler.pm
|
||||
lib/Lemonldap/NG/Handler/Proxy.pm
|
||||
|
|
|
|||
|
|
@ -1,24 +1,7 @@
|
|||
#Listen 127.0.0.3:80
|
||||
# On Apache2, uncomment this:
|
||||
# PerlOptions +GlobalRequest
|
||||
<VirtualHost 127.0.0.3:*>
|
||||
|
||||
ServerName test.example.com
|
||||
|
||||
PerlRequire __DIR__/handler/MyHandler.pm
|
||||
DocumentRoot __DIR__
|
||||
<Directory __DIR__>
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
</Directory>
|
||||
<Files *.pl>
|
||||
SetHandler perl-script
|
||||
PerlResponseHandler ModPerl::Registry
|
||||
</Files>
|
||||
|
||||
<IfModule mod_dir.c>
|
||||
DirectoryIndex index.pl index.html
|
||||
</IfModule>
|
||||
|
||||
PerlInitHandler My::Package
|
||||
<Location /reload>
|
||||
Order deny,allow
|
||||
|
|
@ -27,4 +10,20 @@
|
|||
PerlInitHandler My::Package->refresh
|
||||
</Location>
|
||||
|
||||
# Just to make example running (index.pl display authenticated user)
|
||||
DocumentRoot __DIR__
|
||||
<Directory __DIR__>
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
Options +ExecCGI
|
||||
</Directory>
|
||||
<Files *.pl>
|
||||
SetHandler perl-script
|
||||
PerlHandler Apache::Registry
|
||||
</Files>
|
||||
|
||||
<IfModule mod_dir.c>
|
||||
DirectoryIndex index.pl index.html
|
||||
</IfModule>
|
||||
|
||||
</VirtualHost>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,29 @@
|
|||
PerlOptions +GlobalRequest
|
||||
<VirtualHost 127.0.0.3:*>
|
||||
|
||||
ServerName test.example.com
|
||||
PerlRequire __DIR__/handler/MyHandler.pm
|
||||
PerlInitHandler My::Package
|
||||
<Location /reload>
|
||||
Order deny,allow
|
||||
Deny from all
|
||||
Allow from 127.0.0.0/8
|
||||
PerlInitHandler My::Package->refresh
|
||||
</Location>
|
||||
|
||||
# Just to make example running (index.pl display authenticated user)
|
||||
DocumentRoot __DIR__
|
||||
<Directory __DIR__>
|
||||
Order allow,deny
|
||||
Allow from all
|
||||
</Directory>
|
||||
<Files *.pl>
|
||||
SetHandler perl-script
|
||||
PerlResponseHandler ModPerl::Registry
|
||||
</Files>
|
||||
|
||||
<IfModule mod_dir.c>
|
||||
DirectoryIndex index.pl index.html
|
||||
</IfModule>
|
||||
|
||||
</VirtualHost>
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
package Lemonldap::NG::Handler;
|
||||
|
||||
print STDERR "See Lemonldap::NG::Handler(3) to know which Lemonldap::NG::Handler::* module to use.";
|
||||
our $VERSION = "0.71";
|
||||
print STDERR
|
||||
"See Lemonldap::NG::Handler(3) to know which Lemonldap::NG::Handler::* module to use.";
|
||||
our $VERSION = "0.72";
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
|
|
@ -53,7 +53,10 @@ sub run($$) {
|
|||
$_[1] =~ s/lemon=[^;]*;?// if ( $_[0] =~ /Cookie/i );
|
||||
return 1 if ( $_[1] =~ /^$/ );
|
||||
$request->header(@_) unless ( $_[0] =~ /^(Host|Referer)$/i );
|
||||
$class->lmLog( "$class: header pushed to the server: " . $_[0] . ": " . $_[1], 'debug' );
|
||||
$class->lmLog(
|
||||
"$class: header pushed to the server: " . $_[0] . ": " . $_[1],
|
||||
'debug'
|
||||
);
|
||||
1;
|
||||
}
|
||||
);
|
||||
|
|
@ -90,7 +93,7 @@ sub cb_content {
|
|||
sub headers {
|
||||
$class = shift;
|
||||
my $response = shift;
|
||||
my $tmp = $response->header('Content-Type');
|
||||
my $tmp = $response->header('Content-Type');
|
||||
$r->content_type($tmp) if ($tmp);
|
||||
|
||||
# Modif demandée par mail
|
||||
|
|
@ -99,7 +102,8 @@ sub headers {
|
|||
$r->status_line( join ' ', $response->code, $response->message );
|
||||
|
||||
# Scan LWP response headers to generate Apache response headers
|
||||
my ( $location_old, $location_new ) = split /[;,]+/, $r->dir_config('LmLocationToReplace');
|
||||
my ( $location_old, $location_new ) = split /[;,]+/,
|
||||
$r->dir_config('LmLocationToReplace');
|
||||
$response->scan(
|
||||
sub {
|
||||
|
||||
|
|
@ -107,7 +111,10 @@ sub headers {
|
|||
$_[1] =~ s#$location_old#$location_new#
|
||||
if ( $location_old and $location_new and $_[0] =~ /Location/i );
|
||||
lmSetErrHeaderOut( $r, @_ );
|
||||
$class->lmLog( "$class: header pushed to the client: " . $_[0] . ": " . $_[1], 'debug' );
|
||||
$class->lmLog(
|
||||
"$class: header pushed to the client: " . $_[0] . ": " . $_[1],
|
||||
'debug'
|
||||
);
|
||||
1;
|
||||
}
|
||||
);
|
||||
|
|
|
|||
|
|
@ -18,19 +18,20 @@ our $lmConf;
|
|||
|
||||
BEGIN {
|
||||
if ( MP() == 2 ) {
|
||||
eval {
|
||||
require threads::shared;
|
||||
eval {
|
||||
require threads::shared;
|
||||
Apache2::compat->import();
|
||||
threads::shared::share($childLock);
|
||||
threads::shared::share($childLock);
|
||||
threads::shared::share($childLock);
|
||||
threads::shared::share($childLock);
|
||||
threads::shared::share($childLock);
|
||||
};
|
||||
};
|
||||
}
|
||||
*EXPORT_TAGS = *Lemonldap::NG::Handler::Simple::EXPORT_TAGS;
|
||||
*EXPORT_OK = *Lemonldap::NG::Handler::Simple::EXPORT_OK;
|
||||
push( @{ $EXPORT_TAGS{$_} }, qw($reloadTime $lastReload) ) foreach (qw(variables localStorage));
|
||||
push( @{ $EXPORT_TAGS{$_} }, qw($reloadTime $lastReload) )
|
||||
foreach (qw(variables localStorage));
|
||||
push @EXPORT_OK, qw($reloadTime $lastReload);
|
||||
}
|
||||
|
||||
|
|
@ -44,8 +45,8 @@ sub init($$) {
|
|||
}
|
||||
|
||||
sub localInit {
|
||||
my($class, $args) = @_;
|
||||
$lmConf = Lemonldap::NG::Manager::Conf->new ( $args->{configStorage} );
|
||||
my ( $class, $args ) = @_;
|
||||
$lmConf = Lemonldap::NG::Manager::Conf->new( $args->{configStorage} );
|
||||
$class->defaultValuesInit($args);
|
||||
$class->SUPER::localInit($args);
|
||||
}
|
||||
|
|
@ -79,7 +80,8 @@ sub localConfUpdate($$) {
|
|||
my ( $class, $r ) = @_;
|
||||
my $args;
|
||||
return SERVER_ERROR unless ($refLocalStorage);
|
||||
unless ( $args = $refLocalStorage->get("conf") and $class->confTest($args) ) {
|
||||
unless ( $args = $refLocalStorage->get("conf") and $class->confTest($args) )
|
||||
{
|
||||
|
||||
# TODO: LOCK
|
||||
#unless ( $class->confTest($args) ) {
|
||||
|
|
@ -97,7 +99,7 @@ sub globalConfUpdate {
|
|||
my $tmp = $class->getConf;
|
||||
|
||||
# getConf can return an Apache constant in case of error
|
||||
return $tmp unless (ref($tmp));
|
||||
return $tmp unless ( ref($tmp) );
|
||||
$class->setConf($tmp);
|
||||
OK;
|
||||
}
|
||||
|
|
@ -112,9 +114,9 @@ sub setConf {
|
|||
|
||||
sub getConf {
|
||||
my $class = shift;
|
||||
my $tmp = $lmConf->getConf;
|
||||
unless(ref($tmp)) {
|
||||
$class->lmLog( "$class: Unable to load configuration", 'error');
|
||||
my $tmp = $lmConf->getConf;
|
||||
unless ( ref($tmp) ) {
|
||||
$class->lmLog( "$class: Unable to load configuration", 'error' );
|
||||
return SERVER_ERROR;
|
||||
}
|
||||
return $tmp;
|
||||
|
|
|
|||
|
|
@ -28,11 +28,11 @@ my ( $dbh, $cfgNum ) = ( undef, 0 );
|
|||
sub localInit($$) {
|
||||
my ( $class, $args ) = @_;
|
||||
$args->configStorage = {
|
||||
type => 'DBI',
|
||||
dbiChain => $args->{dbiChain},
|
||||
dbiUser => $args->{dbiUser},
|
||||
dbiPassword => $args->{dbiPassword},
|
||||
dbiTable => $args->{dbiTable},
|
||||
type => 'DBI',
|
||||
dbiChain => $args->{dbiChain},
|
||||
dbiUser => $args->{dbiUser},
|
||||
dbiPassword => $args->{dbiPassword},
|
||||
dbiTable => $args->{dbiTable},
|
||||
};
|
||||
$class->SUPER::localInit($args);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,24 +6,19 @@ use MIME::Base64;
|
|||
use Exporter 'import';
|
||||
use Safe;
|
||||
|
||||
our $VERSION = '0.71';
|
||||
our $VERSION = '0.72';
|
||||
|
||||
our %EXPORT_TAGS = (
|
||||
localStorage => [
|
||||
qw( $localStorage $localStorageOptions $refLocalStorage )
|
||||
],
|
||||
globalStorage => [
|
||||
qw( $globalStorage $globalStorageOptions )
|
||||
],
|
||||
localStorage =>
|
||||
[ qw( $localStorage $localStorageOptions $refLocalStorage ) ],
|
||||
globalStorage => [ qw( $globalStorage $globalStorageOptions ) ],
|
||||
locationRules => [
|
||||
qw(
|
||||
$locationCondition $defaultCondition $locationCount
|
||||
$locationRegexp $apacheRequest $datas $safe
|
||||
)
|
||||
],
|
||||
import => [
|
||||
qw( import @EXPORT_OK @EXPORT %EXPORT_TAGS )
|
||||
],
|
||||
import => [ qw( import @EXPORT_OK @EXPORT %EXPORT_TAGS ) ],
|
||||
headers => [
|
||||
qw(
|
||||
$forgeHeaders
|
||||
|
|
@ -34,29 +29,28 @@ our %EXPORT_TAGS = (
|
|||
lmSetErrHeaderOut
|
||||
)
|
||||
],
|
||||
traces => [
|
||||
qw( $whatToTrace )
|
||||
],
|
||||
apache => [
|
||||
qw( MP lmLog OK REDIRECT FORBIDDEN DONE DECLINED SERVER_ERROR )
|
||||
],
|
||||
traces => [ qw( $whatToTrace ) ],
|
||||
apache =>
|
||||
[ qw( MP lmLog OK REDIRECT FORBIDDEN DONE DECLINED SERVER_ERROR ) ],
|
||||
);
|
||||
|
||||
our @EXPORT_OK = ();
|
||||
push( @EXPORT_OK, @{ $EXPORT_TAGS{$_} } ) foreach (
|
||||
push( @EXPORT_OK, @{ $EXPORT_TAGS{$_} } )
|
||||
foreach (
|
||||
qw( localStorage globalStorage locationRules import headers traces apache )
|
||||
);
|
||||
);
|
||||
$EXPORT_TAGS{all} = \@EXPORT_OK;
|
||||
|
||||
our @EXPORT = ();
|
||||
|
||||
# Shared variables
|
||||
our (
|
||||
$locationRegexp, $locationCondition, $defaultCondition, $forgeHeaders,
|
||||
$apacheRequest, $locationCount, $cookieName, $portal,
|
||||
$datas, $globalStorage, $globalStorageOptions, $localStorage,
|
||||
$localStorageOptions, $whatToTrace, $https, $refLocalStorage,
|
||||
$safe,
|
||||
$locationRegexp, $locationCondition, $defaultCondition,
|
||||
$forgeHeaders, $apacheRequest, $locationCount,
|
||||
$cookieName, $portal, $datas,
|
||||
$globalStorage, $globalStorageOptions, $localStorage,
|
||||
$localStorageOptions, $whatToTrace, $https,
|
||||
$refLocalStorage, $safe,
|
||||
);
|
||||
|
||||
##########################################
|
||||
|
|
@ -209,7 +203,7 @@ sub lmHeaderOut {
|
|||
|
||||
# Security jail
|
||||
$safe = new Safe;
|
||||
$safe->share('&encode_base64','$datas', '&lmSetHeaderIn', '$apacheRequest');
|
||||
$safe->share( '&encode_base64', '$datas', '&lmSetHeaderIn', '$apacheRequest' );
|
||||
|
||||
# init() : by default, it calls localInit and globalInit, but with
|
||||
# a shared configuration, init() is overloaded to call only
|
||||
|
|
@ -234,7 +228,9 @@ sub localInit($$) {
|
|||
|
||||
# At each Apache (re)start, we've to clear the cache to avoid living
|
||||
# with old datas
|
||||
eval '$refLocalStorage = new ' . $localStorage . '($localStorageOptions);';
|
||||
eval '$refLocalStorage = new '
|
||||
. $localStorage
|
||||
. '($localStorageOptions);';
|
||||
if ( defined $refLocalStorage ) {
|
||||
$refLocalStorage->clear();
|
||||
}
|
||||
|
|
@ -251,12 +247,19 @@ sub localInit($$) {
|
|||
# performances.
|
||||
no strict;
|
||||
if ( MP() == 2 ) {
|
||||
Apache->push_handlers( PerlChildInitHandler => sub { return $class->initLocalStorage( $_[1], $_[0] ); } );
|
||||
Apache->push_handlers( PerlCleanupHandler => sub { return $class->cleanLocalStorage(@_); } );
|
||||
Apache->push_handlers( PerlChildInitHandler =>
|
||||
sub { return $class->initLocalStorage( $_[1], $_[0] ); } );
|
||||
Apache->push_handlers(
|
||||
PerlCleanupHandler => sub { return $class->cleanLocalStorage(@_); }
|
||||
);
|
||||
}
|
||||
else {
|
||||
Apache->push_handlers( PerlChildInitHandler => sub { return $class->initLocalStorage(@_); } );
|
||||
Apache->push_handlers( PerlCleanupHandler => sub { return $class->cleanLocalStorage(@_); } );
|
||||
Apache->push_handlers(
|
||||
PerlChildInitHandler => sub { return $class->initLocalStorage(@_); }
|
||||
);
|
||||
Apache->push_handlers(
|
||||
PerlCleanupHandler => sub { return $class->cleanLocalStorage(@_); }
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -282,11 +285,13 @@ sub locationRulesInit {
|
|||
# Pre compilation : both regexp and conditions
|
||||
foreach ( keys %{ $args->{locationRules} } ) {
|
||||
if ( $_ eq 'default' ) {
|
||||
$defaultCondition = $class->conditionSub( $args->{locationRules}->{$_} );
|
||||
$defaultCondition =
|
||||
$class->conditionSub( $args->{locationRules}->{$_} );
|
||||
}
|
||||
else {
|
||||
$locationCondition->[$locationCount] = $class->conditionSub( $args->{locationRules}->{$_} );
|
||||
$locationRegexp->[$locationCount] = qr/$_/;
|
||||
$locationCondition->[$locationCount] =
|
||||
$class->conditionSub( $args->{locationRules}->{$_} );
|
||||
$locationRegexp->[$locationCount] = qr/$_/;
|
||||
$locationCount++;
|
||||
}
|
||||
}
|
||||
|
|
@ -315,8 +320,8 @@ sub defaultValuesInit {
|
|||
my ( $class, $args ) = @_;
|
||||
|
||||
# Other values
|
||||
$cookieName ||= $args->{cookieName} || 'lemon';
|
||||
$whatToTrace ||= $args->{whatToTrace} || '$uid';
|
||||
$cookieName = $args->{cookieName} || 'lemon';
|
||||
$whatToTrace = $args->{whatToTrace} || '$uid';
|
||||
$whatToTrace =~ s/\$//g;
|
||||
$https = $args->{https} unless defined($https);
|
||||
$https = 1 unless defined($https);
|
||||
|
|
@ -359,12 +364,16 @@ sub forgeHeadersInit {
|
|||
|
||||
my $sub;
|
||||
foreach ( keys %tmp ) {
|
||||
$sub .= "lmSetHeaderIn(\$apacheRequest,'$_' => join('',split(/[\\r\\n]+/," . $tmp{$_} . ")));";
|
||||
$sub .=
|
||||
"lmSetHeaderIn(\$apacheRequest,'$_' => join('',split(/[\\r\\n]+/,"
|
||||
. $tmp{$_} . ")));";
|
||||
}
|
||||
|
||||
#$sub = "\$forgeHeaders = sub {$sub};";
|
||||
#eval "$sub";
|
||||
$forgeHeaders = $safe->reval("sub {$sub};");
|
||||
$class->lmLog( "$class: Unable to forge headers: $@: sub {$sub}", 'error' ) if ($@);
|
||||
$class->lmLog( "$class: Unable to forge headers: $@: sub {$sub}", 'error' )
|
||||
if ($@);
|
||||
}
|
||||
|
||||
################
|
||||
|
|
@ -386,8 +395,10 @@ sub forbidden {
|
|||
my $class = shift;
|
||||
|
||||
# We use Apache::Log here
|
||||
$class->lmLog( 'The user "' . $datas->{$whatToTrace} . '" was reject when he tried to access to ' . shift,
|
||||
'notice' );
|
||||
$class->lmLog(
|
||||
'The user "' . $datas->{$whatToTrace} . '" was reject when he tried to access to ' . shift,
|
||||
'notice'
|
||||
);
|
||||
return FORBIDDEN;
|
||||
}
|
||||
|
||||
|
|
@ -401,9 +412,18 @@ sub hideCookie {
|
|||
# Redirect non-authenticated users to the portal
|
||||
sub goToPortal() {
|
||||
my ( $class, $url ) = @_;
|
||||
my $urlc_init = encode_base64( "http" . ( $https ? "s" : "" ) . "://" . $apacheRequest->get_server_name() . $url );
|
||||
my $urlc_init =
|
||||
encode_base64( "http"
|
||||
. ( $https ? "s" : "" ) . "://"
|
||||
. $apacheRequest->get_server_name()
|
||||
. $url );
|
||||
$urlc_init =~ s/[\n\s]//g;
|
||||
$class->lmLog( "Redirect " . $apacheRequest->connection->remote_ip . " to portal (url was $url)", 'debug' );
|
||||
$class->lmLog(
|
||||
"Redirect "
|
||||
. $apacheRequest->connection->remote_ip
|
||||
. " to portal (url was $url)",
|
||||
'debug'
|
||||
);
|
||||
$apacheRequest->headers_out->set( 'Location' => "$portal?url=$urlc_init" );
|
||||
return REDIRECT;
|
||||
}
|
||||
|
|
@ -413,12 +433,17 @@ sub run ($$) {
|
|||
my $class;
|
||||
( $class, $apacheRequest ) = @_;
|
||||
|
||||
my $uri = $apacheRequest->uri . ( $apacheRequest->args ? "?" . $apacheRequest->args : "" );
|
||||
my $uri =
|
||||
$apacheRequest->uri
|
||||
. ( $apacheRequest->args ? "?" . $apacheRequest->args : "" );
|
||||
|
||||
# AUTHENTICATION
|
||||
# I - recover the cookie
|
||||
my $id;
|
||||
unless ( ($id) = ( lmHeaderIn( $apacheRequest, 'Cookie' ) =~ /$cookieName=([^; ]+);?/o ) ) {
|
||||
unless ( ($id) =
|
||||
( lmHeaderIn( $apacheRequest, 'Cookie' ) =~ /$cookieName=([^; ]+);?/o )
|
||||
)
|
||||
{
|
||||
$class->lmLog( "$class: No cookie found", 'info' );
|
||||
return $class->goToPortal($uri);
|
||||
}
|
||||
|
|
@ -437,7 +462,8 @@ sub run ($$) {
|
|||
if ($@) {
|
||||
|
||||
# The cookie isn't yet available
|
||||
$class->lmLog( "The cookie $id isn't yet available: $@", 'info' );
|
||||
$class->lmLog( "The cookie $id isn't yet available: $@",
|
||||
'info' );
|
||||
return $class->goToPortal($uri);
|
||||
}
|
||||
$datas->{$_} = $h{$_} foreach ( keys %h );
|
||||
|
|
@ -456,7 +482,12 @@ sub run ($$) {
|
|||
|
||||
# AUTHORIZATION
|
||||
return $class->forbidden($uri) unless ( $class->grant($uri) );
|
||||
$class->lmLog( "User " . $datas->{$whatToTrace} . " was authorizated to access to $uri", 'debug' );
|
||||
$class->lmLog(
|
||||
"User "
|
||||
. $datas->{$whatToTrace}
|
||||
. " was authorizated to access to $uri",
|
||||
'debug'
|
||||
);
|
||||
|
||||
# ACCOUNTING
|
||||
# 2 - Inform remote application
|
||||
|
|
@ -475,7 +506,9 @@ sub sendHeaders {
|
|||
sub initLocalStorage {
|
||||
my ( $class, $r ) = @_;
|
||||
if ( $localStorage and not $refLocalStorage ) {
|
||||
eval '$refLocalStorage = new ' . $localStorage . '($localStorageOptions);';
|
||||
eval '$refLocalStorage = new '
|
||||
. $localStorage
|
||||
. '($localStorageOptions);';
|
||||
}
|
||||
$class->lmLog( "Local cache initialization failed: $@", 'error' )
|
||||
unless ( defined $refLocalStorage );
|
||||
|
|
|
|||
|
|
@ -12,7 +12,9 @@ sub locationRulesInit {
|
|||
$locationCount->{$vhost} = 0;
|
||||
foreach ( keys %{ $args->{locationRules}->{$vhost} } ) {
|
||||
if ( $_ eq 'default' ) {
|
||||
$defaultCondition->{$vhost} = $class->conditionSub( $args->{locationRules}->{$vhost}->{$_} );
|
||||
$defaultCondition->{$vhost} =
|
||||
$class->conditionSub(
|
||||
$args->{locationRules}->{$vhost}->{$_} );
|
||||
}
|
||||
else {
|
||||
$locationCondition->{$vhost}->[ $locationCount->{$vhost} ] =
|
||||
|
|
@ -41,12 +43,17 @@ sub forgeHeadersInit {
|
|||
|
||||
my $sub;
|
||||
foreach ( keys %tmp ) {
|
||||
$sub .= "lmSetHeaderIn(\$apacheRequest,'$_' => join('',split(/[\\r\\n]+/," . $tmp{$_} . ")));";
|
||||
$sub .=
|
||||
"lmSetHeaderIn(\$apacheRequest,'$_' => join('',split(/[\\r\\n]+/,"
|
||||
. $tmp{$_} . ")));";
|
||||
}
|
||||
|
||||
#$sub = "\$forgeHeaders->{'$vhost'} = sub {$sub};";
|
||||
#eval "$sub";
|
||||
$forgeHeaders->{$vhost} = $safe->reval("sub {$sub}");
|
||||
$class->lmLog( "$class: Unable to forge headers: $@: sub {$sub}", 'error' ) if ($@);
|
||||
$forgeHeaders->{$vhost} = $safe->reval("sub {$sub}");
|
||||
$class->lmLog( "$class: Unable to forge headers: $@: sub {$sub}",
|
||||
'error' )
|
||||
if ($@);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -71,7 +78,10 @@ sub grant {
|
|||
}
|
||||
}
|
||||
unless ( $defaultCondition->{$vhost} ) {
|
||||
$class->lmLog( "User rejected because VirtualHost \"$vhost\" has no configuration", 'warn' );
|
||||
$class->lmLog(
|
||||
"User rejected because VirtualHost \"$vhost\" has no configuration",
|
||||
'warn'
|
||||
);
|
||||
}
|
||||
return &{ $defaultCondition->{$vhost} };
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
Revision history for Perl extension Lemonldap::NG::Manager.
|
||||
|
||||
0.3 Thu Jan 4 9:22:34 2007
|
||||
- Help system skeleton
|
||||
|
||||
0.2 Sun Dec 31 16:40:04 2006
|
||||
- Localization (fr and en)
|
||||
|
||||
|
|
|
|||
|
|
@ -52,6 +52,7 @@ lib/Lemonldap/NG/Manager/Base.pm
|
|||
lib/Lemonldap/NG/Manager/Conf.pm
|
||||
lib/Lemonldap/NG/Manager/Conf/DBI.pm
|
||||
lib/Lemonldap/NG/Manager/Conf/File.pm
|
||||
lib/Lemonldap/NG/Manager/Help.pm
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
META.yml Module meta-data (added by MakeMaker)
|
||||
|
|
|
|||
|
|
@ -7,17 +7,14 @@ use XML::Simple;
|
|||
use Lemonldap::NG::Manager::Base;
|
||||
use Lemonldap::NG::Manager::Conf;
|
||||
use Lemonldap::NG::Manager::_HTML;
|
||||
require Lemonldap::NG::Manager::_i18n;
|
||||
require Lemonldap::NG::Manager::Help;
|
||||
|
||||
our @ISA = qw(Lemonldap::NG::Manager::Base);
|
||||
|
||||
our $VERSION = '0.2';
|
||||
our $VERSION = '0.3';
|
||||
|
||||
sub new {
|
||||
unless(__PACKAGE__->can('ldapServer')) {
|
||||
require Lemonldap::NG::Manager::_i18n;
|
||||
Lemonldap::NG::Manager::_i18n::import($ENV{HTTP_ACCEPT_LANGUAGE});
|
||||
}
|
||||
|
||||
my ( $class, $args ) = @_;
|
||||
my $self = $class->SUPER::new();
|
||||
unless ($args) {
|
||||
|
|
@ -90,12 +87,18 @@ sub print_lmjs {
|
|||
sub print_help {
|
||||
my $self = shift;
|
||||
print $self->header_public;
|
||||
print "TODO: help";
|
||||
Lemonldap::NG::Manager::Help::import( $ENV{HTTP_ACCEPT_LANGUAGE} )
|
||||
unless ( $self->can('help_groups') );
|
||||
my $chap = $self->param('help');
|
||||
eval { no strict "refs"; &{"help_$chap"} };
|
||||
}
|
||||
|
||||
# Configuration download subroutines
|
||||
sub print_conf {
|
||||
my $self = shift;
|
||||
unless ( __PACKAGE__->can('ldapServer') ) {
|
||||
Lemonldap::NG::Manager::_i18n::import( $ENV{HTTP_ACCEPT_LANGUAGE} );
|
||||
}
|
||||
print $self->header( -type => "text/xml", '-Cache-Control' => 'private' );
|
||||
$self->printXmlConf;
|
||||
exit;
|
||||
|
|
@ -117,7 +120,7 @@ sub printXmlConf {
|
|||
item => {
|
||||
id => 'root',
|
||||
open => 1,
|
||||
text => &configuration." $config->{cfgNum}",
|
||||
text => &configuration . " $config->{cfgNum}",
|
||||
item => {
|
||||
generalParameters => {
|
||||
text => &generalParameters,
|
||||
|
|
@ -133,9 +136,8 @@ sub printXmlConf {
|
|||
sessionStorage => {
|
||||
text => &sessionStorage,
|
||||
item => {
|
||||
globalStorageOptions => {
|
||||
text => &globalStorageOptions,
|
||||
}
|
||||
globalStorageOptions =>
|
||||
{ text => &globalStorageOptions, }
|
||||
},
|
||||
},
|
||||
authParams => {
|
||||
|
|
@ -153,70 +155,53 @@ sub printXmlConf {
|
|||
},
|
||||
};
|
||||
my $generalParameters = $tree->{item}->{item}->{generalParameters}->{item};
|
||||
my $exportedVars = $tree->{item}->{item}->{generalParameters}->{item}->{exportedVars}->{item};
|
||||
my $ldapParameters = $tree->{item}->{item}->{generalParameters}->{item}->{ldapParameters}->{item};
|
||||
my $sessionStorage = $tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}->{item};
|
||||
my $globalStorageOptions = $tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}->{item}->{globalStorageOptions}->{item};
|
||||
my $authParams = $tree->{item}->{item}->{generalParameters}->{item}->{authParams}->{item};
|
||||
$authParams->{authentication} = $self->xmlField(
|
||||
"value",
|
||||
$config->{authentication} || 'ldap',
|
||||
&authenticationType,
|
||||
);
|
||||
my $exportedVars =
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{exportedVars}
|
||||
->{item};
|
||||
my $ldapParameters =
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{ldapParameters}
|
||||
->{item};
|
||||
my $sessionStorage =
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
||||
->{item};
|
||||
my $globalStorageOptions =
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
||||
->{item}->{globalStorageOptions}->{item};
|
||||
my $authParams =
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{authParams}->{item};
|
||||
$authParams->{authentication} =
|
||||
$self->xmlField( "value", $config->{authentication} || 'ldap',
|
||||
&authenticationType, );
|
||||
$authParams->{portal} =
|
||||
$self->xmlField(
|
||||
"value",
|
||||
$config->{portal} || 'http://portal/',
|
||||
$self->xmlField( "value", $config->{portal} || 'http://portal/',
|
||||
"Portail" );
|
||||
$authParams->{securedCookie} = $self->xmlField(
|
||||
"value",
|
||||
$config->{securedCookie} || 0,
|
||||
&securedCookie,
|
||||
);
|
||||
$authParams->{securedCookie} =
|
||||
$self->xmlField( "value", $config->{securedCookie} || 0, &securedCookie,
|
||||
);
|
||||
|
||||
$generalParameters->{domain} =
|
||||
$self->xmlField(
|
||||
"value",
|
||||
$config->{domain} || 'example.com',
|
||||
&domain,
|
||||
);
|
||||
$generalParameters->{cookieName} = $self->xmlField(
|
||||
"value",
|
||||
$config->{cookieName} || 'lemonldap',
|
||||
&cookieName,
|
||||
);
|
||||
$self->xmlField( "value", $config->{domain} || 'example.com', &domain, );
|
||||
$generalParameters->{cookieName} =
|
||||
$self->xmlField( "value", $config->{cookieName} || 'lemonldap',
|
||||
&cookieName, );
|
||||
|
||||
$sessionStorage->{globalStorage} = $self->xmlField(
|
||||
"value",
|
||||
$sessionStorage->{globalStorage} =
|
||||
$self->xmlField( "value",
|
||||
$config->{globalStorage} || 'Apache::Session::File',
|
||||
&apacheSessionModule,
|
||||
);
|
||||
&apacheSessionModule, );
|
||||
|
||||
$ldapParameters->{ldapServer} = $self->xmlField(
|
||||
"value",
|
||||
$config->{ldapServer} || 'localhost',
|
||||
&ldapServer,
|
||||
);
|
||||
$ldapParameters->{ldapPort} = $self->xmlField(
|
||||
"value",
|
||||
$config->{ldapPort} || 389,
|
||||
&ldapPort,
|
||||
);
|
||||
$ldapParameters->{ldapBase} = $self->xmlField(
|
||||
"value",
|
||||
$config->{ldapBase} || ' ',
|
||||
&ldapBase,
|
||||
);
|
||||
$ldapParameters->{managerDn} = $self->xmlField(
|
||||
"value",
|
||||
$config->{managerDn} || ' ',
|
||||
&managerDn,
|
||||
);
|
||||
$ldapParameters->{managerPassword} = $self->xmlField(
|
||||
"value",
|
||||
$config->{managerPassword} || ' ',
|
||||
&managerPassword,
|
||||
);
|
||||
$ldapParameters->{ldapServer} =
|
||||
$self->xmlField( "value", $config->{ldapServer} || 'localhost',
|
||||
&ldapServer, );
|
||||
$ldapParameters->{ldapPort} =
|
||||
$self->xmlField( "value", $config->{ldapPort} || 389, &ldapPort, );
|
||||
$ldapParameters->{ldapBase} =
|
||||
$self->xmlField( "value", $config->{ldapBase} || ' ', &ldapBase, );
|
||||
$ldapParameters->{managerDn} =
|
||||
$self->xmlField( "value", $config->{managerDn} || ' ', &managerDn, );
|
||||
$ldapParameters->{managerPassword} =
|
||||
$self->xmlField( "value", $config->{managerPassword} || ' ',
|
||||
&managerPassword, );
|
||||
|
||||
if ( $config->{exportedVars} ) {
|
||||
while ( my ( $n, $att ) = each( %{ $config->{exportedVars} } ) ) {
|
||||
|
|
@ -230,10 +215,13 @@ sub printXmlConf {
|
|||
}
|
||||
|
||||
if ( $config->{globalStorageOptions} ) {
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}->{item}->{globalStorageOptions}->{item} = {};
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
||||
->{item}->{globalStorageOptions}->{item} = {};
|
||||
$globalStorageOptions =
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}->{item}->{globalStorageOptions}->{item};
|
||||
while ( my ( $n, $opt ) = each( %{ $config->{globalStorageOptions} } ) ) {
|
||||
$tree->{item}->{item}->{generalParameters}->{item}->{sessionStorage}
|
||||
->{item}->{globalStorageOptions}->{item};
|
||||
while ( my ( $n, $opt ) = each( %{ $config->{globalStorageOptions} } ) )
|
||||
{
|
||||
$globalStorageOptions->{$n} = $self->xmlField( "both", $opt, $n );
|
||||
}
|
||||
}
|
||||
|
|
@ -246,7 +234,8 @@ sub printXmlConf {
|
|||
my $virtualHost = $tree->{item}->{item}->{virtualHosts}->{item};
|
||||
while ( my ( $host, $rules ) = each( %{ $config->{locationRules} } ) ) {
|
||||
$virtualHost->{$host} = $self->xmlField( "text", 'i', $host );
|
||||
my ( $ih, $ir ) = ( "exportedHeaders_$indice", "locationRules_$indice" );
|
||||
my ( $ih, $ir ) =
|
||||
( "exportedHeaders_$indice", "locationRules_$indice" );
|
||||
$virtualHost->{$host}->{item} = {
|
||||
"$ih" => { text => &httpHeaders, },
|
||||
"$ir" => { text => &locationRules, },
|
||||
|
|
@ -275,7 +264,8 @@ sub printXmlConf {
|
|||
|
||||
print XMLout(
|
||||
$tree,
|
||||
XMLDecl => "<?xml version='1.0' encoding='iso-8859-1'?>",
|
||||
|
||||
#XMLDecl => "<?xml version='1.0' encoding='iso-8859-1'?>",
|
||||
RootName => 'tree',
|
||||
KeyAttr => { item => 'id', username => 'name' },
|
||||
NoIndent => 1
|
||||
|
|
@ -338,11 +328,13 @@ sub upload {
|
|||
}
|
||||
$config->{cookieName} = $tree->{generalParameters}->{cookieName}->{value};
|
||||
$config->{domain} = $tree->{generalParameters}->{domain}->{value};
|
||||
$config->{globalStorage} = $tree->{generalParameters}->{sessionStorage}->{globalStorage}->{value};
|
||||
$config->{globalStorage} =
|
||||
$tree->{generalParameters}->{sessionStorage}->{globalStorage}->{value};
|
||||
while (
|
||||
my ( $v, $h ) = each(
|
||||
%{
|
||||
$tree->{generalParameters}->{sessionStorage}->{globalStorageOptions}
|
||||
$tree->{generalParameters}->{sessionStorage}
|
||||
->{globalStorageOptions}
|
||||
}
|
||||
)
|
||||
)
|
||||
|
|
@ -388,6 +380,8 @@ sub config {
|
|||
return $self->{_config};
|
||||
}
|
||||
|
||||
# Those sub are loaded en demand. With &header_public, they are not loaded each
|
||||
# time.
|
||||
*css = *Lemonldap::NG::Manager::_HTML::css;
|
||||
*javascript = *Lemonldap::NG::Manager::_HTML::javascript;
|
||||
*main = *Lemonldap::NG::Manager::_HTML::main;
|
||||
|
|
|
|||
|
|
@ -16,29 +16,47 @@ sub header {
|
|||
}
|
||||
|
||||
sub header_public {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
$filename ||= $ENV{SCRIPT_FILENAME};
|
||||
my @tmp = stat($filename);
|
||||
my @tmp = stat($filename);
|
||||
my $date = $tmp[9];
|
||||
my $hd = gmtime($date);
|
||||
$hd =~s/^(\w+)\s+(\w+)\s+(\d+)\s+([\d:]+)\s+(\d+)$/$1, $3 $2 $5 $4 GMT/;
|
||||
my $hd = gmtime($date);
|
||||
$hd =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+([\d:]+)\s+(\d+)$/$1, $3 $2 $5 $4 GMT/;
|
||||
my $year = $5;
|
||||
my $cm = $2;
|
||||
# TODO
|
||||
if(my $ref = $ENV{TODO_HTTP_IF_MODIFIED_SINCE}) {
|
||||
my %month = (jan => 0, feb => 1, mar => 2, apr => 3, may => 4, jun => 5, jul => 6, aug => 7, sep => 8, oct => 9, nov => 10, dec => 11);
|
||||
if($ref =~ /^\w+,\s+(\d+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)/) {
|
||||
my $m = $month{lc($2)};
|
||||
$year-- if($m > $month{lc($cm)});
|
||||
$ref = timegm($6,$5,$4,$1,$m,$3);
|
||||
if($ref == $date) {
|
||||
print $self->SUPER::header(-status => '304 Not Modified', @_ );
|
||||
exit;
|
||||
}
|
||||
}
|
||||
my $cm = $2;
|
||||
|
||||
# TODO
|
||||
if ( my $ref = $ENV{TODO_HTTP_IF_MODIFIED_SINCE} ) {
|
||||
my %month = (
|
||||
jan => 0,
|
||||
feb => 1,
|
||||
mar => 2,
|
||||
apr => 3,
|
||||
may => 4,
|
||||
jun => 5,
|
||||
jul => 6,
|
||||
aug => 7,
|
||||
sep => 8,
|
||||
oct => 9,
|
||||
nov => 10,
|
||||
dec => 11
|
||||
);
|
||||
if ( $ref =~ /^\w+,\s+(\d+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)/ ) {
|
||||
my $m = $month{ lc($2) };
|
||||
$year-- if ( $m > $month{ lc($cm) } );
|
||||
$ref = timegm( $6, $5, $4, $1, $m, $3 );
|
||||
if ( $ref == $date ) {
|
||||
print $self->SUPER::header( -status => '304 Not Modified', @_ );
|
||||
exit;
|
||||
}
|
||||
}
|
||||
}
|
||||
return $self->SUPER::header( '-Last-Modified' => $hd, '-Cache-Control' => 'public', @_ );
|
||||
return $self->SUPER::header(
|
||||
'-Last-Modified' => $hd,
|
||||
'-Cache-Control' => 'public',
|
||||
@_
|
||||
);
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -18,56 +18,57 @@ sub new {
|
|||
}
|
||||
$args ||= {};
|
||||
my $self = bless $args, $class;
|
||||
unless($self->{mdone}) {
|
||||
unless($self->{type}) {
|
||||
print STDERR "configStorage: type is not defined\n";
|
||||
return 0;
|
||||
unless ( $self->{mdone} ) {
|
||||
unless ( $self->{type} ) {
|
||||
print STDERR "configStorage: type is not defined\n";
|
||||
return 0;
|
||||
}
|
||||
$self->{type} = "Lemonldap::NG::Manager::Conf::$self->{type}" unless $self->{type} =~ /^Lemonldap/;
|
||||
$self->{type} = "Lemonldap::NG::Manager::Conf::$self->{type}"
|
||||
unless $self->{type} =~ /^Lemonldap/;
|
||||
eval "require $self->{type}";
|
||||
die ($@) if($@);
|
||||
die($@) if ($@);
|
||||
push @ISA, $self->{type};
|
||||
return 0 unless $self->prereq;
|
||||
$self->{mdone}++;
|
||||
$self->{mdone}++;
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub saveConf {
|
||||
my($self,$conf) = @_;
|
||||
my ( $self, $conf ) = @_;
|
||||
my $fields;
|
||||
while(my($k,$v) = each(%$conf)) {
|
||||
if(ref($v)) {
|
||||
$fields->{$k} = "'" . encode_base64( freeze( $v ) ) . "'";
|
||||
$fields->{$k} =~ s/[\r\n]//g;
|
||||
}
|
||||
elsif($v =~ /^\d+/) {
|
||||
$fields->{$k} = "$v";
|
||||
}
|
||||
else {
|
||||
$fields->{$k} = "'$v'";
|
||||
}
|
||||
while ( my ( $k, $v ) = each(%$conf) ) {
|
||||
if ( ref($v) ) {
|
||||
$fields->{$k} = "'" . encode_base64( freeze($v) ) . "'";
|
||||
$fields->{$k} =~ s/[\r\n]//g;
|
||||
}
|
||||
elsif ( $v =~ /^\d+/ ) {
|
||||
$fields->{$k} = "$v";
|
||||
}
|
||||
else {
|
||||
$fields->{$k} = "'$v'";
|
||||
}
|
||||
}
|
||||
$fields->{cfgNum} = $self->lastCfg+1;
|
||||
$fields->{cfgNum} = $self->lastCfg + 1;
|
||||
return $self->store($fields);
|
||||
}
|
||||
|
||||
sub getConf {
|
||||
my($self, $args) = @_;
|
||||
my ( $self, $args ) = @_;
|
||||
$args->{cfgNum} ||= $self->lastCfg;
|
||||
return undef unless $args->{cfgNum};
|
||||
my $fields = $self->load($args->{cfgNum}, $args->{fields});
|
||||
my $fields = $self->load( $args->{cfgNum}, $args->{fields} );
|
||||
my $conf;
|
||||
while(my($k,$v) = each(%$fields)) {
|
||||
my $tmp;
|
||||
eval "\$tmp = thaw(decode_base64($v))";
|
||||
if($@ or not($tmp)) {
|
||||
$v =~ s/^'(.*)'$/$1/;
|
||||
$conf->{$k} = $v;
|
||||
}
|
||||
else {
|
||||
$conf->{$k} = $tmp;
|
||||
}
|
||||
while ( my ( $k, $v ) = each(%$fields) ) {
|
||||
my $tmp;
|
||||
eval "\$tmp = thaw(decode_base64($v))";
|
||||
if ( $@ or not($tmp) ) {
|
||||
$v =~ s/^'(.*)'$/$1/;
|
||||
$conf->{$k} = $v;
|
||||
}
|
||||
else {
|
||||
$conf->{$k} = $tmp;
|
||||
}
|
||||
}
|
||||
return $conf;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -9,11 +9,12 @@ our $VERSION = 0.1;
|
|||
|
||||
sub prereq {
|
||||
my $self = shift;
|
||||
unless($self->{dbiChain}) {
|
||||
print STDERR 'No dbiChain found';
|
||||
return 0;
|
||||
unless ( $self->{dbiChain} ) {
|
||||
print STDERR 'No dbiChain found';
|
||||
return 0;
|
||||
}
|
||||
print STDERR __PACKAGE__ . 'Warning: "dbiUser" parameter is not set' unless($self->{dbiUser});
|
||||
print STDERR __PACKAGE__ . 'Warning: "dbiUser" parameter is not set'
|
||||
unless ( $self->{dbiUser} );
|
||||
$self->{dbiTable} ||= "lmConfig";
|
||||
1;
|
||||
}
|
||||
|
|
@ -21,24 +22,28 @@ sub prereq {
|
|||
sub available {
|
||||
my $self = shift;
|
||||
$self->_connect;
|
||||
my $sth = $self->{dbh}->prepare( "SELECT cfgNum from " . $self->{dbiTable} . " order by cfgNum" );
|
||||
my $sth =
|
||||
$self->{dbh}->prepare(
|
||||
"SELECT cfgNum from " . $self->{dbiTable} . " order by cfgNum" );
|
||||
$sth->execute();
|
||||
my @conf;
|
||||
while(my @row = $sth->fetchrow_array) {
|
||||
push @conf, $row[0];
|
||||
while ( my @row = $sth->fetchrow_array ) {
|
||||
push @conf, $row[0];
|
||||
}
|
||||
return @conf;
|
||||
}
|
||||
|
||||
sub lastCfg {
|
||||
my $self = shift;
|
||||
my @row = $self->{dbh}->selectrow_array( "SELECT max(cfgNum) from " . $self->{dbiTable} );
|
||||
my @row =
|
||||
$self->{dbh}
|
||||
->selectrow_array( "SELECT max(cfgNum) from " . $self->{dbiTable} );
|
||||
return $row[0];
|
||||
}
|
||||
|
||||
sub _connect {
|
||||
my $self=shift;
|
||||
$self->{dbh} = DBI->connect_cached(
|
||||
my $self = shift;
|
||||
$self->{dbh} = DBI->connect_cached(
|
||||
$self->{dbiChain}, $self->{dbiUser},
|
||||
$self->{dbiPassword}, { RaiseError => 1 }
|
||||
);
|
||||
|
|
@ -46,23 +51,31 @@ sub _connect {
|
|||
}
|
||||
|
||||
sub store {
|
||||
my($self,$fields) = @_;
|
||||
my ( $self, $fields ) = @_;
|
||||
$self->_connect;
|
||||
my $tmp = $self->{dbh}->do( "insert into " . $self->{dbiTable} . " (" . join( ",", keys(%$fields) ) . ") values (" . join( ",", values(%$fields) ) . ")" );
|
||||
unless($tmp) {
|
||||
print STDERR "Database error: ".$self->{dbh}->errstr."\n";
|
||||
return 0;
|
||||
my $tmp =
|
||||
$self->{dbh}->do( "insert into "
|
||||
. $self->{dbiTable} . " ("
|
||||
. join( ",", keys(%$fields) )
|
||||
. ") values ("
|
||||
. join( ",", values(%$fields) )
|
||||
. ")" );
|
||||
unless ($tmp) {
|
||||
print STDERR "Database error: " . $self->{dbh}->errstr . "\n";
|
||||
return 0;
|
||||
}
|
||||
return $fields->{cfgNum};
|
||||
}
|
||||
|
||||
sub load {
|
||||
my($self,$cfgNum,$fields) = @_;
|
||||
my ( $self, $cfgNum, $fields ) = @_;
|
||||
$self->_connect;
|
||||
$fields = join(/,/, @$fields) || '*';
|
||||
my $row = $self->{dbh}->selectrow_hashref( "SELECT $fields from " . $self->{dbiTable} . " WHERE cfgNum=$cfgNum" );
|
||||
unless($row) {
|
||||
print STDERR "Database error: ".$self->{dbh}->errstr."\n";
|
||||
$fields = join( /,/, @$fields ) || '*';
|
||||
my $row =
|
||||
$self->{dbh}->selectrow_hashref(
|
||||
"SELECT $fields from " . $self->{dbiTable} . " WHERE cfgNum=$cfgNum" );
|
||||
unless ($row) {
|
||||
print STDERR "Database error: " . $self->{dbh}->errstr . "\n";
|
||||
}
|
||||
return $row;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,13 +6,13 @@ our $VERSION = 0.1;
|
|||
|
||||
sub prereq {
|
||||
my $self = shift;
|
||||
unless($self->{dirName}) {
|
||||
print STDERR "No directory specified (dirName) !";
|
||||
return 0;
|
||||
unless ( $self->{dirName} ) {
|
||||
print STDERR "No directory specified (dirName) !";
|
||||
return 0;
|
||||
}
|
||||
unless(-d $self->{dirName}) {
|
||||
print STDERR "Directory \"$self->{dirName}\" does not exist !";
|
||||
return 0;
|
||||
unless ( -d $self->{dirName} ) {
|
||||
print STDERR "Directory \"$self->{dirName}\" does not exist !";
|
||||
return 0;
|
||||
}
|
||||
1;
|
||||
}
|
||||
|
|
@ -22,20 +22,20 @@ sub available {
|
|||
opendir D, $self->{dirName};
|
||||
my @conf = readdir(D);
|
||||
close D;
|
||||
@conf = sort { $a <=> $b } map { /lmConf-(\d+)/ ? $1:()} @conf;
|
||||
@conf = sort { $a <=> $b } map { /lmConf-(\d+)/ ? $1 : () } @conf;
|
||||
return @conf;
|
||||
}
|
||||
|
||||
sub lastCfg {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my @avail = $self->available;
|
||||
return $avail[$#avail];
|
||||
}
|
||||
|
||||
sub store {
|
||||
my($self,$fields) = @_;
|
||||
open FILE, '>' . $self->{dirName}."/lmConf-".$fields->{cfgNum};
|
||||
while(my($k,$v) = each(%$fields)) {
|
||||
my ( $self, $fields ) = @_;
|
||||
open FILE, '>' . $self->{dirName} . "/lmConf-" . $fields->{cfgNum};
|
||||
while ( my ( $k, $v ) = each(%$fields) ) {
|
||||
print FILE "$k\n\t$v\n\n";
|
||||
}
|
||||
close FILE;
|
||||
|
|
@ -43,24 +43,23 @@ sub store {
|
|||
}
|
||||
|
||||
sub load {
|
||||
my($self,$cfgNum,$fields) = @_;
|
||||
my ( $self, $cfgNum, $fields ) = @_;
|
||||
my $f;
|
||||
local $/ = "";
|
||||
open FILE, $self->{dirName}."/lmConf-$cfgNum";
|
||||
while(<FILE>) {
|
||||
my($k,$v) = split /\n\s+/;
|
||||
chomp $k;
|
||||
$v =~ s/\n*$//;
|
||||
if($fields) {
|
||||
$f->{$k} = $v if(grep {$_ eq $k} @$fields);
|
||||
}
|
||||
else {
|
||||
$f->{$k} = $v;
|
||||
}
|
||||
open FILE, $self->{dirName} . "/lmConf-$cfgNum";
|
||||
while (<FILE>) {
|
||||
my ( $k, $v ) = split /\n\s+/;
|
||||
chomp $k;
|
||||
$v =~ s/\n*$//;
|
||||
if ($fields) {
|
||||
$f->{$k} = $v if ( grep { $_ eq $k } @$fields );
|
||||
}
|
||||
else {
|
||||
$f->{$k} = $v;
|
||||
}
|
||||
}
|
||||
close FILE;
|
||||
return $f;
|
||||
}
|
||||
|
||||
;
|
||||
__END__
|
||||
|
|
|
|||
|
|
@ -0,0 +1,90 @@
|
|||
package Lemonldap::NG::Manager::Help;
|
||||
|
||||
use AutoLoader qw(AUTOLOAD);
|
||||
use UNIVERSAL qw(can);
|
||||
our $VERSION = '0.1';
|
||||
|
||||
sub import {
|
||||
my ($caller_package) = caller;
|
||||
my $lang = shift;
|
||||
$lang = lc($lang);
|
||||
foreach ( split( /[,;]/, $lang ) ) {
|
||||
next if /=/;
|
||||
s/fr-fr/fr/;
|
||||
s/en-us/en/;
|
||||
if ( __PACKAGE__->can("help_groups_$_") ) {
|
||||
$l = $_;
|
||||
last;
|
||||
}
|
||||
}
|
||||
$l ||= "en";
|
||||
foreach $h (qw(virtualHosts groups ldap vars storage)) {
|
||||
*{"${caller_package}::help_$h"} = \&{"help_${h}_$l"};
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=pod
|
||||
=cut
|
||||
sub help_virtualHosts_en {
|
||||
print <<EOT;
|
||||
<h3>Virtual Hosts</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_groups_en {
|
||||
print <<EOT;
|
||||
<h3>User Groups</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_ldap_en {
|
||||
print <<EOT;
|
||||
<h3>LDAP Parameters</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_vars_en {
|
||||
print <<EOT;
|
||||
<h3>Variables (LDAP attributes)</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_storage_en {
|
||||
print <<EOT;
|
||||
<h3>Sessions Storage</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_virtualHosts_fr {
|
||||
print <<EOT;
|
||||
<h3>Hôtes virtuels</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_groups_fr {
|
||||
print <<EOT;
|
||||
<h3>Groupes d'utilisateurs</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_ldap_fr {
|
||||
print <<EOT;
|
||||
<h3>Paramètres LDAP</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_vars_fr {
|
||||
print <<EOT;
|
||||
<h3>Variables (attributs LDAP)</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
sub help_storage_fr {
|
||||
print <<EOT;
|
||||
<h3>Stockage des sessions</h3>
|
||||
EOT
|
||||
}
|
||||
|
||||
|
|
@ -9,6 +9,7 @@ our $VERSION = '0.05';
|
|||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=pod
|
||||
=cut
|
||||
sub css {
|
||||
|
|
@ -291,16 +292,21 @@ EOT
|
|||
sub start_html {
|
||||
my $self = shift;
|
||||
my %args = @_;
|
||||
$args{'-style'} = { -src => [ $args{'-style'} ] } if($args{'-style'} and !ref($args{'-style'}));
|
||||
push @{$args{'-style'}->{'-src'}}, "$ENV{SCRIPT_NAME}?lmQuery=css";
|
||||
$args{'-style'} = { -src => [ $args{'-style'} ] }
|
||||
if ( $args{'-style'} and !ref( $args{'-style'} ) );
|
||||
push @{ $args{'-style'}->{'-src'} }, "$ENV{SCRIPT_NAME}?lmQuery=css";
|
||||
$args{'-title'} ||= 'Lemonldap::NG Configuration';
|
||||
$self->CGI::start_html(%args);
|
||||
}
|
||||
|
||||
sub main {
|
||||
|
||||
# Lemonldap::Manager javascripts;
|
||||
print qq#<script type="text/javascript" src="$ENV{SCRIPT_NAME}?lmQuery=libjs"></script>\n#;
|
||||
print qq#<script type="text/javascript" src="$ENV{SCRIPT_NAME}?lmQuery=lmjs"></script>\n#;
|
||||
print
|
||||
qq#<script type="text/javascript" src="$ENV{SCRIPT_NAME}?lmQuery=libjs"></script>\n#;
|
||||
print
|
||||
qq#<script type="text/javascript" src="$ENV{SCRIPT_NAME}?lmQuery=lmjs"></script>\n#;
|
||||
|
||||
# HTML code
|
||||
print <<EOT;
|
||||
<div id='xBody'>
|
||||
|
|
@ -354,4 +360,3 @@ sub main {
|
|||
EOT
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -5,20 +5,20 @@ use UNIVERSAL qw(can);
|
|||
our $VERSION = '0.1';
|
||||
|
||||
sub import {
|
||||
my($caller_package) = caller;
|
||||
my ($caller_package) = caller;
|
||||
my $lang = shift;
|
||||
$lang = lc($lang);
|
||||
$lang =~ s/-/_/g;
|
||||
foreach(split(/[,;]/,$lang)) {
|
||||
foreach ( split( /[,;]/, $lang ) ) {
|
||||
next if /=/;
|
||||
if(__PACKAGE__->can($_)) {
|
||||
$functions = &$_;
|
||||
last;
|
||||
}
|
||||
if ( __PACKAGE__->can($_) ) {
|
||||
$functions = &$_;
|
||||
last;
|
||||
}
|
||||
}
|
||||
$functions ||= &en;
|
||||
while (my($f,$v) = each(%$functions)) {
|
||||
*{"${caller_package}::$f"} = sub{ $v };
|
||||
while ( my ( $f, $v ) = each(%$functions) ) {
|
||||
*{"${caller_package}::$f"} = sub { $v };
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -27,57 +27,57 @@ sub import {
|
|||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=pod
|
||||
=cut
|
||||
|
||||
sub fr {
|
||||
return {
|
||||
configuration => 'Configuration',
|
||||
exportedVars => 'Attributs LDAP à exporter',
|
||||
generalParameters => 'Paramètres généraux',
|
||||
ldapParameters => 'Paramètres LDAP',
|
||||
sessionStorage => 'Stockage des sessions',
|
||||
globalStorageOptions => 'Paramètres du module Apache::Session',
|
||||
authParams => "Paramètres d'authentification",
|
||||
userGroups => "Groupes d'utilisateurs",
|
||||
virtualHosts => "Hôtes virtuels",
|
||||
authenticationType => "Type d'authentification",
|
||||
securedCookie => 'Cookie sécurisé (SSL)',
|
||||
domain => 'Domaine',
|
||||
cookieName => 'Nom du cookie',
|
||||
apacheSessionModule => 'Module Apache::Session',
|
||||
ldapServer => 'Serveur LDAP',
|
||||
ldapPort => 'Port du serveur LDAP',
|
||||
ldapBase => 'Base de recherche LDAP',
|
||||
managerDn => 'Compte de connexion LDAP',
|
||||
managerPassword => 'Mot de passe LDAP',
|
||||
httpHeaders => 'En-têtes HTTP',
|
||||
locationRules => 'Règles',
|
||||
}
|
||||
configuration => 'Configuration',
|
||||
exportedVars => 'Attributs LDAP à; exporter',
|
||||
generalParameters => 'Paramètres généraux',
|
||||
ldapParameters => 'Paramètres LDAP',
|
||||
sessionStorage => 'Stockage des sessions',
|
||||
globalStorageOptions => 'Paramètres du module Apache::Session',
|
||||
authParams => "Paramètres d'authentification",
|
||||
userGroups => "Groupes d'utilisateurs",
|
||||
virtualHosts => "Hôtes virtuels",
|
||||
authenticationType => "Type d'authentification",
|
||||
securedCookie => 'Cookie sécurisé (SSL)',
|
||||
domain => 'Domaine',
|
||||
cookieName => 'Nom du cookie',
|
||||
apacheSessionModule => 'Module Apache::Session',
|
||||
ldapServer => 'Serveur LDAP',
|
||||
ldapPort => 'Port du serveur LDAP',
|
||||
ldapBase => 'Base de recherche LDAP',
|
||||
managerDn => 'Compte de connexion LDAP',
|
||||
managerPassword => 'Mot de passe LDAP',
|
||||
httpHeaders => 'En-têtes HTTP',
|
||||
locationRules => 'Règles',
|
||||
};
|
||||
}
|
||||
|
||||
sub en {
|
||||
return {
|
||||
configuration => 'Configuration',
|
||||
exportedVars => 'Exported Variables',
|
||||
generalParameters => 'General Parameters',
|
||||
ldapParameters => 'LDAP Parameters',
|
||||
sessionStorage => 'Session Storage',
|
||||
globalStorageOptions => 'Session Storage Parameters',
|
||||
authParams => "Authentication Parameters",
|
||||
userGroups => "User Groups",
|
||||
virtualHosts => "Virtual Hosts",
|
||||
authenticationType => "Authentifition Type",
|
||||
securedCookie => 'Secured Cookie (SSL)',
|
||||
domain => 'Domain',
|
||||
cookieName => 'Cookie Name',
|
||||
apacheSessionModule => 'Apache::Session module',
|
||||
ldapServer => 'LDAP Server',
|
||||
ldapPort => 'LDAP Server Port',
|
||||
ldapBase => 'LDAP Search Base',
|
||||
managerDn => 'LDAP Account',
|
||||
managerPassword => 'LDAP Password',
|
||||
httpHeaders => 'HTTP Headers',
|
||||
locationRules => 'Rules',
|
||||
}
|
||||
configuration => 'Configuration',
|
||||
exportedVars => 'Exported Variables',
|
||||
generalParameters => 'General Parameters',
|
||||
ldapParameters => 'LDAP Parameters',
|
||||
sessionStorage => 'Session Storage',
|
||||
globalStorageOptions => 'Session Storage Parameters',
|
||||
authParams => "Authentication Parameters",
|
||||
userGroups => "User Groups",
|
||||
virtualHosts => "Virtual Hosts",
|
||||
authenticationType => "Authentifition Type",
|
||||
securedCookie => 'Secured Cookie (SSL)',
|
||||
domain => 'Domain',
|
||||
cookieName => 'Cookie Name',
|
||||
apacheSessionModule => 'Apache::Session module',
|
||||
ldapServer => 'LDAP Server',
|
||||
ldapPort => 'LDAP Server Port',
|
||||
ldapBase => 'LDAP Search Base',
|
||||
managerDn => 'LDAP Account',
|
||||
managerPassword => 'LDAP Password',
|
||||
httpHeaders => 'HTTP Headers',
|
||||
locationRules => 'Rules',
|
||||
};
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
package Lemonldap::NG::Portal;
|
||||
|
||||
print STDERR "See Lemonldap::NG::Portal(3) to know which Lemonldap::NG::Portal::* module to use.";
|
||||
print STDERR
|
||||
"See Lemonldap::NG::Portal(3) to know which Lemonldap::NG::Portal::* module to use.";
|
||||
our $VERSION = "0.51";
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -18,7 +18,8 @@ our $safe = new Safe;
|
|||
sub getConf {
|
||||
my $self = shift;
|
||||
$self->SUPER::getConf(@_);
|
||||
$self->{lmConf} = Lemonldap::NG::Manager::Conf->new( $self->{configStorage} )
|
||||
$self->{lmConf} =
|
||||
Lemonldap::NG::Manager::Conf->new( $self->{configStorage} )
|
||||
unless $self->{lmConf};
|
||||
return 0 unless ( ref( $self->{lmConf} ) );
|
||||
my $tmp = $self->{lmConf}->getConf;
|
||||
|
|
@ -68,7 +69,7 @@ sub scanexpr {
|
|||
# Perl expressions
|
||||
if ( s/^{(.*)}$/$1/ or $_ !~ /^\(.*\)$/ ) {
|
||||
s/\$(\w+)/\$self->{sessionInfo}->{$1}/g;
|
||||
$safe->share ( '$self', '$result' );
|
||||
$safe->share( '$self', '$result' );
|
||||
$result = $safe->reval($_);
|
||||
return $result ? "1" : "0";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ our $VERSION = '0.31';
|
|||
our @ISA = qw(Lemonldap::NG::Portal::SharedConf);
|
||||
|
||||
sub getConf {
|
||||
my($self, $args) = @_;
|
||||
my ( $self, $args ) = @_;
|
||||
$self->{configStorage} = {
|
||||
type => "DBI",
|
||||
dbiChain => $self->{dbiChain},
|
||||
|
|
|
|||
|
|
@ -40,7 +40,8 @@ our %EXPORT_TAGS = (
|
|||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw( PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS
|
||||
our @EXPORT =
|
||||
qw( PE_OK PE_SESSIONEXPIRED PE_FORMEMPTY PE_WRONGMANAGERACCOUNT PE_USERNOTFOUND PE_BADCREDENTIALS
|
||||
PE_LDAPCONNECTFAILED PE_LDAPERROR PE_APACHESESSIONERROR PE_FIRSTACCESS PE_BADCERTIFICATE import );
|
||||
|
||||
sub new {
|
||||
|
|
@ -116,7 +117,8 @@ sub error {
|
|||
sub process {
|
||||
my ($self) = @_;
|
||||
$self->{error} = PE_OK;
|
||||
foreach my $sub qw(controlUrlOrigin extractFormInfo formateParams formateFilter
|
||||
foreach my $sub
|
||||
qw(controlUrlOrigin extractFormInfo formateParams formateFilter
|
||||
connectLDAP bind search setSessionInfo setGroups authenticate store unbind
|
||||
buildCookie log autoRedirect) {
|
||||
if ( $self->{$sub} )
|
||||
|
|
@ -215,7 +217,8 @@ sub bind {
|
|||
my $self = shift;
|
||||
$self->connectLDAP unless ( $self->{ldap} );
|
||||
return PE_WRONGMANAGERACCOUNT
|
||||
unless ( &_bind( $self->{ldap}, $self->{managerDn}, $self->{managerPassword} ) );
|
||||
unless (
|
||||
&_bind( $self->{ldap}, $self->{managerDn}, $self->{managerPassword} ) );
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
|
|
@ -245,7 +248,8 @@ sub setSessionInfo {
|
|||
}
|
||||
elsif ( ref( $self->{exportedVars} ) eq 'HASH' ) {
|
||||
foreach ( keys %{ $self->{exportedVars} } ) {
|
||||
$self->{sessionInfo}->{$_} = $self->{entry}->get_value( $self->{exportedVars}->{$_} ) || "";
|
||||
$self->{sessionInfo}->{$_} =
|
||||
$self->{entry}->get_value( $self->{exportedVars}->{$_} ) || "";
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -281,10 +285,13 @@ sub authenticate {
|
|||
sub store {
|
||||
my ($self) = @_;
|
||||
my %h;
|
||||
eval { tie %h, $self->{globalStorage}, undef, $self->{globalStorageOptions}; };
|
||||
eval {
|
||||
tie %h, $self->{globalStorage}, undef, $self->{globalStorageOptions};
|
||||
};
|
||||
return PE_APACHESESSIONERROR if ($@);
|
||||
$self->{id} = $h{_session_id};
|
||||
$h{$_} = $self->{sessionInfo}->{$_} foreach ( keys %{ $self->{sessionInfo} } );
|
||||
$h{$_} = $self->{sessionInfo}->{$_}
|
||||
foreach ( keys %{ $self->{sessionInfo} } );
|
||||
$h{_utime} = time();
|
||||
untie %h;
|
||||
PE_OK;
|
||||
|
|
|
|||
Loading…
Reference in New Issue