make tidy
This commit is contained in:
parent
e011600113
commit
f97f5c72e0
|
@ -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};
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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";
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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 );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -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 {
|
||||
|
|
|
@ -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 );
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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";
|
||||
}
|
||||
|
|
|
@ -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' );
|
||||
|
|
|
@ -85,8 +85,7 @@ ok(
|
|||
|
||||
ok(
|
||||
Lemonldap::NG::Handler::Reload->headersInit(
|
||||
{ exportedHeaders => { www1 => { Auth => '$uid', } } },
|
||||
$tsv
|
||||
{ exportedHeaders => { www1 => { Auth => '$uid', } } }, $tsv
|
||||
),
|
||||
'forgeHeadersInit'
|
||||
);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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}";
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue
Block a user