make tidy

This commit is contained in:
Clément Oudot 2014-07-24 15:48:32 +00:00
parent e011600113
commit f97f5c72e0
21 changed files with 277 additions and 245 deletions

View File

@ -51,6 +51,7 @@ sub populate {
$self->{object_store} =
Lemonldap::NG::Common::Apache::Session::Store->new($self);
}
# If cache is configured, use our specific lock_manager object module
if ( $self->{args}->{localStorage} ) {
$self->{args}->{lock_manager} = $self->{lock_manager};

View File

@ -5,9 +5,8 @@ use strict;
my $VERSION = '1.4.1';
sub new {
my $class = shift;
my $class = shift;
my $session = shift;
my $self = {};
@ -16,7 +15,6 @@ sub new {
return $self;
}
sub module {
my $self = shift;
return $self->{args}->{lock_manager};
@ -34,18 +32,18 @@ sub cache {
return $self->{cache};
}
sub acquire_read_lock {
sub acquire_read_lock {
my $self = shift;
my $session = shift;
# Get session from cache
my $id = $session->{data}->{_session_id};
if ( $self->cache->get($id) ) {
# got session from cache, no need to ask for locks
if ( $self->cache->get($id) ) {
# got session from cache, no need to ask for locks
}
else {
$self->module->acquire_read_lock($session);
$self->module->acquire_read_lock($session);
}
}
@ -63,20 +61,20 @@ sub release_write_lock {
$self->module->release_write_lock($session);
}
sub release_all_locks {
sub release_all_locks {
my $self = shift;
my $session = shift;
# Get session from cache
my $id = $session->{data}->{_session_id};
if ( $self->cache->get($id) ) {
# got session from cache, no need to ask for locks
if ( $self->cache->get($id) ) {
# got session from cache, no need to ask for locks
}
else {
$self->module->release_all_locks($session);
$self->module->release_all_locks($session);
}
}
1;

View File

@ -29,6 +29,7 @@ sub update {
#TODO: remove cache on all LL::NG instances if updateCache == 1
unless ( $session->{args}->{updateCache} == -1 ) {
# Update session in cache
my $id = $session->{data}->{_session_id};
$self->cache->remove($id) if ( $self->cache->get($id) );
@ -36,6 +37,7 @@ sub update {
}
unless ( $session->{args}->{updateCache} == 2 ) {
# Update session in backend
return $self->module->update($session);
}
@ -70,12 +72,14 @@ sub remove {
#TODO: remove cache on all LL::NG instances if updateCache == 1
unless ( $session->{args}->{updateCache} == -1 ) {
# Remove session from cache
my $id = $session->{data}->{_session_id};
$self->cache->remove($id) if ( $self->cache->get($id) );
}
unless ( $session->{args}->{updateCache} == 2 ) {
# Remove session from backend
return $self->module->remove($session);
}

View File

@ -75,8 +75,7 @@ sub checkLogonHours {
# @return current date on format YYYYMMDDHHMMSS
sub date {
my $gmt = shift;
my ( $sec, $min, $hour, $mday, $mon, $year )
= $gmt ? gmtime : localtime;
my ( $sec, $min, $hour, $mday, $mon, $year ) = $gmt ? gmtime : localtime;
$year += 1900;
$mon += 1;

View File

@ -12,24 +12,23 @@ our ( %EXPORT_TAGS, @EXPORT_OK, @EXPORT );
],
functions => [
qw( &hostname &remote_ip &uri &uri_with_args
&unparsed_uri &args &method &header_in )
&unparsed_uri &args &method &header_in )
]
);
push( @EXPORT_OK, @{ $EXPORT_TAGS{$_} } ) foreach ( keys %EXPORT_TAGS );
$EXPORT_TAGS{all} = \@EXPORT_OK;
# definition of MP() (kept for compatibility till MP is completely vanished)
if ( exists $ENV{MOD_PERL} ) {
if ( $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ) {
eval 'use constant MP => 2;';
}
else {
eval 'use constant MP => 1;';
}
if ( $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ) {
eval 'use constant MP => 2;';
}
else {
eval 'use constant MP => 1;';
}
}
else {
eval 'use constant MP => 0;';
eval 'use constant MP => 0;';
}
# Load appropriate specific API module :
@ -40,7 +39,7 @@ my $gi = $ENV{GATEWAY_INTERFACE};
my $mp = $ENV{MOD_PERL_API_VERSION};
my $mode =
$gi && $gi =~ /^CGI/ ? "CGI"
: $mp && $mp >= 2 ? "ApacheMP2"
: $mp && $mp >= 2 ? "ApacheMP2"
: $mp ? "ApacheMP1"
: $main::{'nginx::'} ? "Nginx"
: "CGI";

View File

@ -5,11 +5,9 @@ use Exporter 'import';
our $VERSION = '1.4.0';
our ( %EXPORT_TAGS, @EXPORT_OK, @EXPORT );
BEGIN{
# no http codes defined for ApacheMP1, but tag kept for compatibility with API
%EXPORT_TAGS = (
httpCodes => [],
);
BEGIN {
# no http codes defined for ApacheMP1, but tag kept for compatibility with API
%EXPORT_TAGS = ( httpCodes => [], );
push( @EXPORT_OK, @{ $EXPORT_TAGS{$_} } ) foreach ( keys %EXPORT_TAGS );
$EXPORT_TAGS{all} = \@EXPORT_OK;
}
@ -19,12 +17,12 @@ use Apache;
use Apache::Log;
use Apache::Constants qw(:common :response);
## @method void setServerSignature(string sign)
# modifies web server signature
# @param $sign String to add to server signature
# @param $sign String to add to server signature
sub setServerSignature {
my ($class, $sign) = @_;
my ( $class, $sign ) = @_;
#TODO
}
@ -32,7 +30,8 @@ sub setServerSignature {
# share or not the variable (if authorized by specific module)
# @param $variable the name of the variable to share
sub thread_share {
my ($class, $variable) = @_;
my ( $class, $variable ) = @_;
# nothing to do in ApacheMP1
}
@ -103,7 +102,7 @@ sub set_header_out {
# @param request Apache2::RequestRec current request
# @return host string Host value
sub hostname {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
return $r->hostname;
}
@ -112,7 +111,7 @@ sub hostname {
# @param request Apache2::RequestRec current request
# @return IP_Addr string client IP
sub remote_ip {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
return $r->remote_ip;
}
@ -121,7 +120,7 @@ sub remote_ip {
# @param request Apache2::RequestRec current request
# @return is_initial_req boolean
sub is_initial_req {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
return 1;
}
@ -129,8 +128,8 @@ sub is_initial_req {
# gets the query string
# @param request Apache2::RequestRec current request
# @return args string Query string
sub args {
my ($class, $r) = @_;
sub args {
my ( $class, $r ) = @_;
return $r->args();
}
@ -143,7 +142,7 @@ sub args {
# @param request Apache2::RequestRec current request
# @return path portion of the URI, normalized
sub uri {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
my $uri = $r->uri;
$uri =~ s#//+#/#g;
$uri =~ s#\?#%3F#g;
@ -155,8 +154,8 @@ sub uri {
# @param request Apache2::RequestRec current request
# @return URI with normalized path portion
sub uri_with_args {
my ($class, $r) = @_;
return $class->uri($r) . ( $r->args ? "?" . $r->args : "");
my ( $class, $r ) = @_;
return $class->uri($r) . ( $r->args ? "?" . $r->args : "" );
}
## @method string unparsed_uri(Apache2::RequestRec request)
@ -164,7 +163,7 @@ sub uri_with_args {
# @param request Apache2::RequestRec current request
# @return full original request URI, with arguments
sub unparsed_uri {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
return $r->unparsed_uri;
}
@ -173,7 +172,7 @@ sub unparsed_uri {
# @param request Apache2::RequestRec current request
# @return port string server port
sub get_server_port {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
return $r->get_server_port;
}
@ -182,7 +181,7 @@ sub get_server_port {
# @param data Text to add in response body
# @param request Apache2::RequestRec Current request
sub print {
my ($class, $data, $r) = @_;
my ( $class, $data, $r ) = @_;
$r->print($data);
}

View File

@ -5,14 +5,14 @@ use Exporter 'import';
our $VERSION = '1.4.0';
our ( %EXPORT_TAGS, @EXPORT_OK, @EXPORT );
BEGIN{
BEGIN {
%EXPORT_TAGS = (
httpCodes => [
qw( OK REDIRECT FORBIDDEN DONE DECLINED SERVER_ERROR AUTH_REQUIRED MAINTENANCE )
],
functions => [
qw( &hostname &remote_ip &uri &uri_with_args
&unparsed_uri &args &method &header_in )
&unparsed_uri &args &method &header_in )
]
);
push( @EXPORT_OK, @{ $EXPORT_TAGS{$_} } ) foreach ( keys %EXPORT_TAGS );
@ -30,20 +30,21 @@ use Apache2::Const;
use Apache2::Filter;
use APR::Table;
use constant FORBIDDEN => Apache2::Const::FORBIDDEN;
use constant REDIRECT => Apache2::Const::REDIRECT;
use constant OK => Apache2::Const::OK;
use constant DECLINED => Apache2::Const::DECLINED;
use constant DONE => Apache2::Const::DONE;
use constant SERVER_ERROR => Apache2::Const::SERVER_ERROR;
use constant FORBIDDEN => Apache2::Const::FORBIDDEN;
use constant REDIRECT => Apache2::Const::REDIRECT;
use constant OK => Apache2::Const::OK;
use constant DECLINED => Apache2::Const::DECLINED;
use constant DONE => Apache2::Const::DONE;
use constant SERVER_ERROR => Apache2::Const::SERVER_ERROR;
use constant AUTH_REQUIRED => Apache2::Const::AUTH_REQUIRED;
use constant MAINTENANCE => Apache2::Const::HTTP_SERVICE_UNAVAILABLE;
use constant MAINTENANCE => Apache2::Const::HTTP_SERVICE_UNAVAILABLE;
eval { require threads::shared; };
print STDERR "You probably would have better perfs by enabling threads::shared\n"
if ($@);
print STDERR
"You probably would have better perfs by enabling threads::shared\n"
if ($@);
my $request; # Apache2::RequestRec object for current request
my $request; # Apache2::RequestRec object for current request
## @method void thread_share(string $variable)
# try to share $variable between threads
@ -51,15 +52,15 @@ my $request; # Apache2::RequestRec object for current request
# else it fails to compile if threads::shared is not loaded
# @param $variable the name of the variable to share
sub thread_share {
my ($class, $variable) = @_;
my ( $class, $variable ) = @_;
eval "threads::shared::share(\$variable);";
}
## @method void setServerSignature(string sign)
# modifies web server signature
# @param $sign String to add to server signature
# @param $sign String to add to server signature
sub setServerSignature {
my ($class, $sign) = @_;
my ( $class, $sign ) = @_;
Apache2::ServerUtil->server->push_handlers(
PerlPostConfigHandler => sub {
my ( $c, $l, $t, $s ) = splice @_;
@ -79,6 +80,7 @@ sub newRequest {
# @param $level string loglevel
sub lmLog {
my ( $class, $msg, $level ) = @_;
# TODO: remove the useless tag 'ApacheMP2.pm(70):' in debug logs
Apache2::ServerRec->log->$level($msg);
}
@ -87,7 +89,7 @@ sub lmLog {
# sets remote_user
# @param user string username
sub set_user {
my ($class, $user) = @_;
my ( $class, $user ) = @_;
$request->user($user);
}
@ -96,8 +98,8 @@ sub set_user {
# @param header string request header
# @return request header value
sub header_in {
my ($class, $header) = @_;
$header ||= $class; # to use header_in as a method or as a function
my ( $class, $header ) = @_;
$header ||= $class; # to use header_in as a method or as a function
return $request->headers_in->{$header};
}
@ -105,7 +107,7 @@ sub header_in {
# sets or modifies request headers
# @param headers hash containing header names => header value
sub set_header_in {
my ($class, %headers) = @_;
my ( $class, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$request->headers_in->set( $h => $v );
}
@ -117,25 +119,27 @@ sub set_header_in {
# header 'Auth-User' is removed, 'Auth_User' be removed also
# @param headers array with header names to remove
sub unset_header_in {
my ($class, @headers) = @_;
my ( $class, @headers ) = @_;
foreach my $h1 (@headers) {
$h1 = lc $h1;
$h1 =~ s/-/_/g;
$request->headers_in->do( sub {
my $h = shift;
my $h2 = lc $h;
$h2 =~ s/-/_/g;
$request->headers_in->unset($h) if ( $h1 eq $h2 );
return 1;
} );
$request->headers_in->do(
sub {
my $h = shift;
my $h2 = lc $h;
$h2 =~ s/-/_/g;
$request->headers_in->unset($h) if ( $h1 eq $h2 );
return 1;
}
);
}
}
}
## @method void set_header_out(hash headers)
# sets response headers
# @param headers hash containing header names => header value
sub set_header_out {
my ($class, %headers) = @_;
my ( $class, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$request->err_headers_out->set( $h => $v );
}
@ -168,7 +172,7 @@ sub is_initial_req {
## @method string args(string args)
# gets the query string
# @return args string Query string
sub args {
sub args {
my $class = shift;
return $request->args();
}
@ -182,7 +186,7 @@ sub args {
# @return path portion of the URI, normalized
sub uri {
my $class = shift;
my $uri = $request->uri;
my $uri = $request->uri;
$uri =~ s#//+#/#g;
$uri =~ s#\?#%3F#g;
return $uri;
@ -193,7 +197,7 @@ sub uri {
# @return URI with normalized path portion
sub uri_with_args {
my $class = shift;
return uri . ( $request->args ? "?" . $request->args : "");
return uri . ( $request->args ? "?" . $request->args : "" );
}
## @method string unparsed_uri
@ -224,7 +228,7 @@ sub method {
# write data in HTTP response body
# @param data Text to add in response body
sub print {
my ($class, $data) = @_;
my ( $class, $data ) = @_;
$request->print($data);
}
@ -232,47 +236,54 @@ sub print {
# add data at end of html head
# @param data Text to add in html head
sub addToHtmlHead {
my ($class, $data) = @_;
$request->add_output_filter( sub {
my $f = shift;
my $buffer;
my ( $class, $data ) = @_;
$request->add_output_filter(
sub {
my $f = shift;
my $buffer;
my $body = $f->ctx || "";
$body .= $buffer while ($f->read($buffer));
unless ($f->seen_eos) {
$f->ctx($body);
} else {
$body =~ s/(<\/head>)/$data$1/i or $body =~ s/(<body>)/$1$data/i;
$f->print($body);
my $body = $f->ctx || "";
$body .= $buffer while ( $f->read($buffer) );
unless ( $f->seen_eos ) {
$f->ctx($body);
}
else {
$body =~ s/(<\/head>)/$data$1/i
or $body =~ s/(<body>)/$1$data/i;
$f->print($body);
}
return OK;
}
return OK;
} );
);
}
## @method void setPostParams(hashref $params)
# add or modify parameters in POST request body
# @param $params hashref containing name => value
sub setPostParams {
my ($class, $params) = @_;
$request->add_input_filter( sub {
my $f = shift;
my $buffer;
my ( $class, $params ) = @_;
$request->add_input_filter(
sub {
my $f = shift;
my $buffer;
# Filter only POST request body
if ( $f->r->method eq "POST" ) {
my $body;
while ($f->read($buffer)) { $body .= $buffer; }
while ( my ($name, $value) = each ( %$params ) ) {
$body =~ s/((^|&))$name=[^\&]*/$1$name=$value/
or $body .= "&$name=$value";
# Filter only POST request body
if ( $f->r->method eq "POST" ) {
my $body;
while ( $f->read($buffer) ) { $body .= $buffer; }
while ( my ( $name, $value ) = each(%$params) ) {
$body =~ s/((^|&))$name=[^\&]*/$1$name=$value/
or $body .= "&$name=$value";
}
$body =~ s/^&//;
$f->print($body);
}
$body =~ s/^&//;
$f->print($body);
} else {
$f->print($buffer) while ($f->read($buffer));
else {
$f->print($buffer) while ( $f->read($buffer) );
}
return OK;
}
return OK;
} );
);
}
1;

View File

@ -5,14 +5,14 @@ use Exporter 'import';
our $VERSION = '1.4.0';
our ( %EXPORT_TAGS, @EXPORT_OK, @EXPORT );
BEGIN{
BEGIN {
%EXPORT_TAGS = (
httpCodes => [
qw( OK REDIRECT FORBIDDEN DONE DECLINED SERVER_ERROR AUTH_REQUIRED MAINTENANCE $logLevel )
],
functions => [
qw( &hostname &remote_ip &uri &uri_with_args
&unparsed_uri &args &method &header_in )
&unparsed_uri &args &method &header_in )
]
);
push( @EXPORT_OK, @{ $EXPORT_TAGS{$_} } ) foreach ( keys %EXPORT_TAGS );
@ -20,26 +20,26 @@ BEGIN{
}
# Specific modules and constants for Test or CGI
use constant FORBIDDEN => 403;
use constant REDIRECT => 302;
use constant OK => 0;
use constant DECLINED => 0;
use constant DONE => 0;
use constant SERVER_ERROR => 500;
use constant FORBIDDEN => 403;
use constant REDIRECT => 302;
use constant OK => 0;
use constant DECLINED => 0;
use constant DONE => 0;
use constant SERVER_ERROR => 500;
use constant AUTH_REQUIRED => 401;
use constant MAINTENANCE => 503;
use constant MAINTENANCE => 503;
# Log level, since it can't be set in server config
# Default value 'notice' can be changed in lemonldap-ng.ini or in init args
our $logLevel = "notice";
my $request; # object to store data about current request
my $request; # object to store data about current request
## @method void setServerSignature(string sign)
# modifies web server signature
# @param $sign String to add to server signature
# @param $sign String to add to server signature
sub setServerSignature {
my ($class, $sign) = @_;
my ( $class, $sign ) = @_;
$ENV{SERVER_SOFTWARE} .= " $sign";
}
@ -47,11 +47,12 @@ sub setServerSignature {
# share or not the variable (if authorized by specific module)
# @param $variable the name of the variable to share
sub thread_share {
# nothing to do in CGI
}
sub newRequest {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
$request = $r;
}
@ -79,7 +80,7 @@ sub set_user {
# @return request header value
sub header_in {
my ( $class, $header ) = @_;
$header ||= $class; # to use header_in as a method or as a function
$header ||= $class; # to use header_in as a method or as a function
return $ENV{ cgiName($header) };
}
@ -137,7 +138,7 @@ sub is_initial_req {
## @method string args(string args)
# gets the query string
# @return args string Query string
sub args {
sub args {
return $ENV{QUERY_STRING};
}
@ -159,7 +160,7 @@ sub uri {
# returns the URI, with arguments and with path portion normalized
# @return URI with normalized path portion
sub uri_with_args {
return &uri . ( $ENV{QUERY_STRING} ? "?$ENV{QUERY_STRING}" : "");
return &uri . ( $ENV{QUERY_STRING} ? "?$ENV{QUERY_STRING}" : "" );
}
## @method string unparsed_uri
@ -187,7 +188,7 @@ sub method {
# write data in HTTP response body
# @param data Text to add in response body
sub print {
my ($class, $data) = @_;
my ( $class, $data ) = @_;
$request->{respBody} .= $data;
}

View File

@ -3,13 +3,12 @@ package Lemonldap::NG::Handler::API::Nginx;
our $VERSION = '1.4.0';
our ( %EXPORT_TAGS, @EXPORT_OK, @EXPORT );
## @method void thread_share(string $variable)
# share or not the variable (if authorized by specific module)
# @param $variable the name of the variable to share
sub thread_share {
my ($class, $variable) = @_;
my ( $class, $variable ) = @_;
# nothing to do in Nginx
}

View File

@ -21,21 +21,25 @@ sub new {
# Get access control rule
my $rule = $localConfig->{protection};
$rule =~ s/^rule\s*:?\s*//;
$rule = $rule eq "none" ? "skip"
: $rule eq "authenticate" ? "accept"
: $rule eq "manager" ? ""
: $rule;
$rule =
$rule eq "none" ? "skip"
: $rule eq "authenticate" ? "accept"
: $rule eq "manager" ? ""
: $rule;
my $request = {};
Lemonldap::NG::Handler::API->newRequest($request);
my $res = $self->run($rule);
if ($res == 403) {
$self->abort('Forbidden', "You don't have rights to access this page");
} elsif ($res) {
if ( $res == 403 ) {
$self->abort( 'Forbidden',
"You don't have rights to access this page" );
}
elsif ($res) {
print $self->header( -status => $res, %{ $request->{respHeaders} } );
$self->quit;
} else {
}
else {
return $self;
}
}

View File

@ -2,10 +2,10 @@ package Lemonldap::NG::Handler::Main::Logger;
use Lemonldap::NG::Handler::API qw( :httpCodes );
my $logLevel; # To control Lemonldap::NG logs: allows to overwrite
# log level defined in server config, or to set it
# if it can't be configured elsewhere (e.g. on CGIs)
my $logLevels = { # To compare log levels
my $logLevel; # To control Lemonldap::NG logs: allows to overwrite
# log level defined in server config, or to set it
# if it can't be configured elsewhere (e.g. on CGIs)
my $logLevels = { # To compare log levels
emerg => 7,
alert => 6,
crit => 5,
@ -42,10 +42,12 @@ sub lmLog {
if ( $level eq 'debug' ) {
$file =~ s#.+/##;
Lemonldap::NG::Handler::API->lmLog( "$file($line): $msg", "debug" );
} else {
}
else {
Lemonldap::NG::Handler::API->lmLog( "$file($line):", "debug" )
if ( $logLevel == 0 );
Lemonldap::NG::Handler::API->lmLog( "Lemonldap::NG::Handler: $msg", $level );
if ( $logLevel == 0 );
Lemonldap::NG::Handler::API->lmLog( "Lemonldap::NG::Handler: $msg",
$level );
}
}

View File

@ -75,10 +75,12 @@ sub configReload {
"Loading configuration $conf->{cfgNum} for process $$", "info" );
foreach my $sub (
qw( jailInit defaultValuesInit portalInit locationRulesInit
sessionStorageInit headersInit postUrlInit aliasInit ) ) {
Lemonldap::NG::Handler::Main::Logger->lmLog(
"Process $$ calls $sub", "debug" );
qw( jailInit defaultValuesInit portalInit locationRulesInit
sessionStorageInit headersInit postUrlInit aliasInit )
)
{
Lemonldap::NG::Handler::Main::Logger->lmLog( "Process $$ calls $sub",
"debug" );
$class->$sub( $conf, $tsv );
}
return 1;
@ -103,16 +105,17 @@ sub jailInit {
# @param $args reference to the configuration hash
sub defaultValuesInit {
my ( $class, $conf, $tsv ) = @_;
$tsv->{$_} = $conf->{$_}
foreach (qw(
$tsv->{$_} = $conf->{$_} foreach (
qw(
cda cookieExpiration cookieName
customFunctions httpOnly securedCookie
timeoutActivity useRedirectOnError useRedirectOnForbidden
useSafeJail whatToTrace
));
)
);
$tsv->{cipher} = Lemonldap::NG::Common::Crypto->new($conf->{key});
$tsv->{cipher} = Lemonldap::NG::Common::Crypto->new( $conf->{key} );
foreach my $opt (qw(https port maintenance)) {
next unless defined $conf->{$opt};
@ -128,7 +131,7 @@ sub defaultValuesInit {
Lemonldap::NG::Handler::Main::Logger->lmLog(
"Options $opt for vhost $vhost: $val", 'debug' );
$tsv->{$opt}->{$vhost} = $val
if ( $val >= 0 ); # Keep default value if $val is negative
if ( $val >= 0 ); # Keep default value if $val is negative
}
}
}
@ -142,7 +145,7 @@ sub portalInit {
my ( $class, $conf, $tsv ) = @_;
die("portal parameter required") unless ( $conf->{portal} );
if ( $conf->{portal} =~ /[\$\(&\|"']/ ) {
($tsv->{portal}) = $class->conditionSub( $conf->{portal}, $tsv );
( $tsv->{portal} ) = $class->conditionSub( $conf->{portal}, $tsv );
}
else {
$tsv->{portal} = sub { return $conf->{portal} };
@ -166,18 +169,17 @@ sub locationRulesInit {
my ( $class, $conf, $tsv ) = @_;
while ( my ( $vhost, $rules ) = each( %{ $conf->{locationRules} } ) ) {
foreach my $url ( sort keys %{ $rules } ) {
my ( $cond, $prot )
= $class->conditionSub( $rules->{$url}, $tsv );
foreach my $url ( sort keys %{$rules} ) {
my ( $cond, $prot ) = $class->conditionSub( $rules->{$url}, $tsv );
if ( $url eq 'default' ) {
$tsv->{defaultCondition}->{$vhost} = $cond;
$tsv->{defaultCondition}->{$vhost} = $cond;
$tsv->{defaultProtection}->{$vhost} = $prot;
}
else {
push @{ $tsv->{locationCondition}->{$vhost} } , $cond;
push @{ $tsv->{locationCondition}->{$vhost} }, $cond;
push @{ $tsv->{locationProtection}->{$vhost} }, $prot;
push @{ $tsv->{locationRegexp}->{$vhost} } , qr/$url/;
push @{ $tsv->{locationRegexp}->{$vhost} }, qr/$url/;
push @{ $tsv->{locationConditionText}->{$vhost} },
/^\(\?#(.*?)\)/ ? $1 : /^(.*?)##(.+)$/ ? $2 : $url;
$tsv->{locationCount}->{$vhost}++;
@ -205,18 +207,19 @@ sub sessionStorageInit {
die($@) if ($@);
$tsv->{sessionStorageOptions} = $conf->{globalStorageOptions};
if ($conf->{localSessionStorage}) {
if ( $conf->{localSessionStorage} ) {
$tsv->{sessionCacheModule} = $conf->{localSessionStorage};
$tsv->{sessionCacheOptions} = $conf->{localSessionStorageOptions};
$tsv->{sessionCacheOptions}->{default_expires_in} ||= 600;
if ($conf->{status}) {
if ( $conf->{status} ) {
my $params = "";
if ($tsv->{sessionCacheModule}) {
if ( $tsv->{sessionCacheModule} ) {
require Data::Dumper;
$params = " $tsv->{sessionCacheModule},"
. Data::Dumper->new( [ $tsv->{sessionCacheOptions} ] )
->Terse(1)->Indent(0)->Dump; # To send params on one line
$params =
" $tsv->{sessionCacheModule},"
. Data::Dumper->new( [ $tsv->{sessionCacheOptions} ] )
->Terse(1)->Indent(0)->Dump; # To send params on one line
}
print { $tsv->{statusPipe} } "RELOADCACHE$params";
}
@ -236,7 +239,7 @@ sub headersInit {
$tsv->{headerList}->{$vhost} = [ keys %headers ];
my $sub;
foreach ( keys %headers ) {
my $val = $class->substitute($headers{$_});
my $val = $class->substitute( $headers{$_} );
$sub .= "'$_' => $val,";
}
@ -257,14 +260,15 @@ sub postUrlInit {
# Browse all vhost
foreach my $vhost ( keys %{ $conf->{post} } ) {
# Browse all POST URI
while ( my ( $url, $d ) = each( %{ $conf->{post}->{$vhost} } ) ) {
Lemonldap::NG::Handler::Main::Logger->lmLog(
"Compiling POST data for $url", 'debug' );
# Where to POST
my ( $postUrl, $jqueryUrl, $formSelector, $buttonSelector )
= split( /\|/, $d->{postUrl} );
my ( $postUrl, $jqueryUrl, $formSelector, $buttonSelector ) =
split( /\|/, $d->{postUrl} );
$postUrl ||= $url;
my $sub;
@ -272,9 +276,9 @@ sub postUrlInit {
my $val = $class->substitute($value);
$sub .= "'$input' => $val,";
}
$tsv->{inputPostData}->{$vhost}->{$postUrl}
= $tsv->{outputPostData}->{$vhost}->{$url}
= $tsv->{jail}->jail_reval("sub{$sub}");
$tsv->{inputPostData}->{$vhost}->{$postUrl} =
$tsv->{outputPostData}->{$vhost}->{$url} =
$tsv->{jail}->jail_reval("sub{$sub}");
$tsv->{postFormParams}->{$vhost}->{$url} = {
jqueryUrl => $jqueryUrl,
@ -350,7 +354,8 @@ sub conditionSub {
my $r = shift;
$r->add_output_filter(
sub {
return Lemonldap::NG::Handler::Main->redirectFilter( $u, @_ );
return Lemonldap::NG::Handler::Main->redirectFilter( $u,
@_ );
}
);
1;
@ -370,7 +375,8 @@ sub conditionSub {
my $r = shift->r;
return Lemonldap::NG::Handler::Main->redirectFilter(
&{ $tsv->{portal} }() . "?url="
. Lemonldap::NG::Handler::Main->encodeUrl( $r, $u )
. Lemonldap::NG::Handler::Main->encodeUrl( $r,
$u )
. "&logout=1",
@_
);
@ -405,6 +411,7 @@ sub aliasInit {
}
return 1;
}
# TODO: support wildcards in aliases
sub substitute {

View File

@ -26,14 +26,14 @@ use Lemonldap::NG::Common::Conf::Constants; #inherits
use base qw(Lemonldap::NG::Handler::Main);
our $VERSION = '1.4.0';
our $lmConf; # Lemonldap::NG::Common::Conf object to get config
our $localConfig; # Local configuration parameters, i.e. defined
# in lemonldap-ng.ini or in startup parameters
our $cfgNum = 0; # Number of the loaded remote configuration
our $lastCheck = 0; # Date of last configuration check (unix time)
our $checkTime = 600; # Time between 2 configuration check (in seconds);
# default value is 600, can be reset in local config
our $VERSION = '1.4.0';
our $lmConf; # Lemonldap::NG::Common::Conf object to get config
our $localConfig; # Local configuration parameters, i.e. defined
# in lemonldap-ng.ini or in startup parameters
our $cfgNum = 0; # Number of the loaded remote configuration
our $lastCheck = 0; # Date of last configuration check (unix time)
our $checkTime = 600; # Time between 2 configuration check (in seconds);
# default value is 600, can be reset in local config
BEGIN {
Lemonldap::NG::Handler::API->thread_share($cfgNum);
@ -59,31 +59,32 @@ sub init($$) {
my ( $class, $args ) = @_;
# According to doc, localStorage can be declared in $args root,
# but it must be in $args->{configStorage}
# but it must be in $args->{configStorage}
foreach (qw(localStorage localStorageOptions)) {
$args->{configStorage}->{$_} ||= $args->{$_};
}
$lmConf = Lemonldap::NG::Common::Conf->new($args->{configStorage});
die( "$class : unable to build configuration: "
. "$Lemonldap::NG::Common::Conf::msg" ) unless ($lmConf);
$lmConf = Lemonldap::NG::Common::Conf->new( $args->{configStorage} );
die( "$class : unable to build configuration: "
. "$Lemonldap::NG::Common::Conf::msg" )
unless ($lmConf);
# Merge local configuration parameters so that params defined in
# startup parameters have precedence over lemonldap-ng.ini params
$localConfig = {
%{ $lmConf->getLocalConf(HANDLERSECTION) },
%{ $args }
};
$localConfig = { %{ $lmConf->getLocalConf(HANDLERSECTION) }, %{$args} };
$checkTime = $localConfig->{checkTime} || $checkTime;
# Few actions that must be done at server startup:
# * set log level for Lemonldap::NG logs
Lemonldap::NG::Handler::Main::Logger->logLevelInit( $localConfig->{logLevel} );
Lemonldap::NG::Handler::Main::Logger->logLevelInit(
$localConfig->{logLevel} );
# * set server signature
$class->serverSignatureInit unless ($localConfig->{hideSignature});
$class->serverSignatureInit unless ( $localConfig->{hideSignature} );
# * launch status process
$class->statusInit($tsv) if ($localConfig->{status});
$class->statusInit($tsv) if ( $localConfig->{status} );
}
# @method void serverSignatureInit
@ -91,8 +92,8 @@ sub init($$) {
sub serverSignatureInit {
my $class = shift;
Lemonldap::NG::Handler::API->setServerSignature(
"Lemonldap::NG/" . $Lemonldap::NG::Handler::VERSION
) if ( $Lemonldap::NG::Handler::VERSION );
"Lemonldap::NG/" . $Lemonldap::NG::Handler::VERSION )
if ($Lemonldap::NG::Handler::VERSION);
}
## @ifn protected void statusInit()
@ -103,6 +104,7 @@ sub statusInit {
$statusPipe = IO::Pipe->new;
$statusOut = IO::Pipe->new;
if ( my $pid = fork() ) {
# TODO: log new process pid
$statusPipe->writer();
$statusOut->reader();
@ -117,7 +119,7 @@ sub statusInit {
open STDIN, "<&$fdin";
open STDOUT, ">&$fdout";
exec 'perl', '-MLemonldap::NG::Handler::Status',
map( { "-I$_" } @INC),
map( {"-I$_"} @INC ),
'-e &Lemonldap::NG::Handler::Status::run()';
}
}
@ -150,8 +152,8 @@ sub run {
unless ( $class->checkConf );
}
if ( my $rule = shift ) {
my ( $cond, $prot )
= Lemonldap::NG::Handler::Reload->conditionSub($rule, $tsv);
my ( $cond, $prot ) =
Lemonldap::NG::Handler::Reload->conditionSub( $rule, $tsv );
return $class->SUPER::run( $cond, $prot );
}
return $class->SUPER::run();
@ -183,8 +185,8 @@ sub checkConf {
"Get configuration $conf->{cfgNum} ($Lemonldap::NG::Common::Conf::msg)",
'debug'
);
$lastCheck = time();
$cfgNum = $conf->{cfgNum};
$lastCheck = time();
$cfgNum = $conf->{cfgNum};
$conf->{$_} = $localConfig->{$_} foreach ( keys %$localConfig );
Lemonldap::NG::Handler::Reload->configReload( $conf, $tsv );
}

View File

@ -32,9 +32,10 @@ sub fetchId {
if ( my $creds = Lemonldap::NG::Handler::API->header_in('Authorization') ) {
$creds =~ s/^Basic\s+//;
my @date = localtime;
my $day = $date[5] * 366 + $date[7];
return Digest::MD5::md5_hex($creds . $day);
} else {
my $day = $date[5] * 366 + $date[7];
return Digest::MD5::md5_hex( $creds . $day );
}
else {
return 0;
}
}
@ -52,7 +53,8 @@ sub retrieveSession {
# Then ask portal to create it
if ( $class->createSession($id) ) {
return $class->SUPER::retrieveSession($id);
} else {
}
else {
return 0;
}
}
@ -69,10 +71,9 @@ sub createSession {
$xheader .= Lemonldap::NG::Handler::API->remote_ip;
my $soapHeaders = HTTP::Headers->new( "X-Forwarded-For" => $xheader );
my $soapClient = SOAP::Lite->proxy(
$class->portal(),
default_headers => $soapHeaders
)->uri('urn:Lemonldap::NG::Common::CGI::SOAPService');
my $soapClient =
SOAP::Lite->proxy( $class->portal(), default_headers => $soapHeaders )
->uri('urn:Lemonldap::NG::Common::CGI::SOAPService');
my $creds = Lemonldap::NG::Handler::API->header_in('Authorization');
$creds =~ s/^Basic\s+//;
@ -83,12 +84,12 @@ sub createSession {
# Catch SOAP errors
if ( $soapRequest->fault ) {
$class->abort(
"SOAP request to the portal failed: "
$class->abort( "SOAP request to the portal failed: "
. $soapRequest->fault->{faultstring} );
}
else {
my $res = $soapRequest->result();
# If authentication failed, display error
if ( $res->{errorCode} ) {
Lemonldap::NG::Handler::Main::Logger->lmLog(
@ -97,7 +98,8 @@ sub createSession {
'notice'
);
return 0;
} else {
}
else {
return 1;
}
}
@ -107,7 +109,8 @@ sub createSession {
# Hide user credentials to the protected application
sub hideCookie {
my $class = shift;
Lemonldap::NG::Handler::Main::Logger->lmLog( "removing Authorization header", 'debug' );
Lemonldap::NG::Handler::Main::Logger->lmLog(
"removing Authorization header", 'debug' );
Lemonldap::NG::Handler::API->unset_header_in('Authorization');
}
@ -121,7 +124,8 @@ sub goToPortal {
my ( $class, $url, $arg ) = @_;
if ($arg) {
return $class->SUPER::goToPortal( $url, $arg );
} else {
}
else {
Lemonldap::NG::Handler::API->set_header_out(
'WWW-Authenticate' => 'Basic realm="LemonLDAP::NG"' );
return AUTH_REQUIRED;

View File

@ -26,22 +26,22 @@ sub retrieveSession {
my $utime = $class->fetchUTime;
if ( $res && $Lemonldap::NG::Handler::Main::datas->{_utime} < $utime ) {
$Lemonldap::NG::Handler::Main::session->remove( {updateCache => 2} );
$Lemonldap::NG::Handler::Main::session->remove( { updateCache => 2 } );
$Lemonldap::NG::Handler::Main::datasUpdate = 0;
$res = $class->SUPER::retrieveSession($id);
if ( $Lemonldap::NG::Handler::Main::datas->{_utime} < $utime ) {
Lemonldap::NG::Handler::Main::Logger->lmLog(
"Session $id datas too old: dated as utime="
. $Lemonldap::NG::Handler::Main::datas->{_utime}
. ", but requested with utime > $utime",
'warn' );
. $Lemonldap::NG::Handler::Main::datas->{_utime}
. ", but requested with utime > $utime",
'warn'
);
}
}
return $res;
}
## @rmethod protected $ fetchUTime()
# Get user cookies and search for Lemonldap::NG update cookie.
# @param $r current request

View File

@ -152,10 +152,10 @@ sub run {
}
elsif (/^RELOADCACHE(?:\s+(\S+?),(\S+))?$/) {
if ( my ($cacheModule, $cacheOptions) = ( $1, $2 ) ) {
if ( my ( $cacheModule, $cacheOptions ) = ( $1, $2 ) ) {
eval "use $cacheModule;"
. "\$cache = new $cacheModule(\$cacheOptions);";
print STDERR "$@\n" if ($@); # TODO: use lmLog instead
. "\$cache = new $cacheModule(\$cacheOptions);";
print STDERR "$@\n" if ($@); # TODO: use lmLog instead
}
else {
$cache = undef;
@ -219,8 +219,7 @@ sub run {
# Local cache
if ($cache) {
my @t =
$cache->get_keys( $_[1]->{namespace} );
my @t = $cache->get_keys( $_[1]->{namespace} );
print "<div id=\"cache\"><p>\nLocal Cache : " . @t
. " objects\n</p></div>\n";
}

View File

@ -9,7 +9,7 @@ use strict;
use warnings;
use Test::More tests => 10;
BEGIN { use_ok( 'Lemonldap::NG::Handler::Main', qw(:all) ) }
BEGIN { use_ok( 'Lemonldap::NG::Handler::Main', qw(:all) ) }
BEGIN { use_ok( 'Lemonldap::NG::Handler::Reload', qw(:all) ) }
# get a standard basic configuration in $args hashref
@ -58,13 +58,17 @@ my $conf = {
# - headerListInit
# - forgeHeadersInit
# - postUrlInit
ok( Lemonldap::NG::Handler::Reload->configReload( $conf, $Lemonldap::NG::Handler::Main::tsv ) );
ok(
Lemonldap::NG::Handler::Reload->configReload(
$conf, $Lemonldap::NG::Handler::Main::tsv
)
);
ok( &{ $tsv->{portal} }() eq 'http://auth.example.com/', 'portal' );
ok( $h->grant( '/s' ), 'basic rule "accept"' );
ok( !$h->grant( '/no' ), 'basic rule "deny"' );
ok( $h->grant( '/a/a' ), 'bad ordered rule 1/2' );
ok( $h->grant( '/a' ), 'bad ordered rule 2/2' );
ok( !$h->grant( '/b/a' ), 'good ordered rule 1/2' );
ok( $h->grant( '/b' ), 'good ordered rule 2/2' );
ok( $h->grant('/s'), 'basic rule "accept"' );
ok( !$h->grant('/no'), 'basic rule "deny"' );
ok( $h->grant('/a/a'), 'bad ordered rule 1/2' );
ok( $h->grant('/a'), 'bad ordered rule 2/2' );
ok( !$h->grant('/b/a'), 'good ordered rule 1/2' );
ok( $h->grant('/b'), 'good ordered rule 2/2' );

View File

@ -85,8 +85,7 @@ ok(
ok(
Lemonldap::NG::Handler::Reload->headersInit(
{ exportedHeaders => { www1 => { Auth => '$uid', } } },
$tsv
{ exportedHeaders => { www1 => { Auth => '$uid', } } }, $tsv
),
'forgeHeadersInit'
);

View File

@ -60,10 +60,11 @@ if ( $numTests == 3 ) {
# Create a fake Apache2::RequestRec
my $mock = Test::MockObject->new();
my $ret;
$mock->fake_module( 'Lemonldap::NG::Handler::API',
newRequest => sub { print STDERR "newRequest\n" },
header_in => sub { "" },
hostname => sub { 'test.example.com' },
$mock->fake_module(
'Lemonldap::NG::Handler::API',
newRequest => sub { print STDERR "newRequest\n" },
header_in => sub { "" },
hostname => sub { 'test.example.com' },
is_initial_req => sub { '1' },
remote_ip => sub { '127.0.0.1' },
args => sub { undef },
@ -71,16 +72,15 @@ if ( $numTests == 3 ) {
uri => sub { '/' },
uri_with_args => sub { '/' },
get_server_port => sub { '80' },
set_header_out => sub { $ret = join( ':', $_[1], $_[2], ); }, );
set_header_out => sub { $ret = join( ':', $_[1], $_[2], ); },
);
our $apacheRequest;
my $h = bless {}, 'Lemonldap::NG::Handler';
ok(
$h->handler($apacheRequest),
'run Handler with basic configuration and no cookie'
);
ok( $h->handler($apacheRequest),
'run Handler with basic configuration and no cookie' );
ok(
"$ret" eq

View File

@ -2348,7 +2348,7 @@ sub globalTests {
my ( $id, %h );
return 1
if ( $conf->{globalStorage} eq
$Lemonldap::NG::Handler::Main::tsv->{sessionStorageModule}
$Lemonldap::NG::Handler::Main::tsv->{sessionStorageModule}
or $conf->{globalStorage} eq
'Lemonldap::NG::Common::Apache::Session::SOAP' );
eval "use $conf->{globalStorage}";

View File

@ -85,7 +85,7 @@ sub getCookies {
$self->{force} = 1;
}
$self->{error} = PE_OK;
$self->{error} = PE_OK;
# Skip extractFormInfo step, as we already get input data
$self->{skipExtractFormInfo} = 1;