make tidy

This commit is contained in:
Clément Oudot 2014-06-08 10:04:50 +00:00
parent ea36359463
commit dbfbde2e9f
34 changed files with 223 additions and 188 deletions

View File

@ -33,11 +33,11 @@ sub populate {
$self = $self->$backend(@_);
}
if ( $self->{args}->{generateModule} ) {
my $generate = $self->{args}->{generateModule};
eval "require $generate";
die $@ if ($@);
$self->{generate} = \&{$generate."::generate"};
$self->{validate} = \&{$generate."::validate"};
my $generate = $self->{args}->{generateModule};
eval "require $generate";
die $@ if ($@);
$self->{generate} = \&{ $generate . "::generate" };
$self->{validate} = \&{ $generate . "::validate" };
}
if ( $self->{args}->{setId} ) {
$self->{generate} = \&setId;

View File

@ -1,44 +1,50 @@
#############################################################################
#
# Lemonldap::NG::Common::Apache::Session::Generate::SHA256
# Generates session identifier tokens using SHA-256
# Distribute under the Perl License
#
############################################################################
package Lemonldap::NG::Common::Apache::Session::Generate::SHA256;
use strict;
use vars qw($VERSION);
use Digest::SHA qw(sha256 sha256_hex sha256_base64);
$VERSION = '1.4.0';
sub generate {
my $session = shift;
my $length = 64;
if (exists $session->{args}->{IDLength}) {
$length = $session->{args}->{IDLength};
}
$session->{data}->{_session_id} =
substr(Digest::SHA::sha256_hex(Digest::SHA::sha256_hex(time(). {}. rand(). $$)), 0, $length);
}
sub validate {
#This routine checks to ensure that the session ID is in the form
#we expect. This must be called before we start diddling around
#in the database or the disk.
my $session = shift;
if ($session->{data}->{_session_id} =~ /^([a-fA-F0-9]+)$/) {
$session->{data}->{_session_id} = $1;
} else {
die "Invalid session ID: ".$session->{data}->{_session_id};
}
}
1;
#############################################################################
#
# Lemonldap::NG::Common::Apache::Session::Generate::SHA256
# Generates session identifier tokens using SHA-256
# Distribute under the Perl License
#
############################################################################
package Lemonldap::NG::Common::Apache::Session::Generate::SHA256;
use strict;
use vars qw($VERSION);
use Digest::SHA qw(sha256 sha256_hex sha256_base64);
$VERSION = '1.4.0';
sub generate {
my $session = shift;
my $length = 64;
if ( exists $session->{args}->{IDLength} ) {
$length = $session->{args}->{IDLength};
}
$session->{data}->{_session_id} = substr(
Digest::SHA::sha256_hex(
Digest::SHA::sha256_hex( time() . {} . rand() . $$ )
),
0, $length
);
}
sub validate {
#This routine checks to ensure that the session ID is in the form
#we expect. This must be called before we start diddling around
#in the database or the disk.
my $session = shift;
if ( $session->{data}->{_session_id} =~ /^([a-fA-F0-9]+)$/ ) {
$session->{data}->{_session_id} = $1;
}
else {
die "Invalid session ID: " . $session->{data}->{_session_id};
}
}
1;

View File

@ -63,7 +63,7 @@ sub handle {
: ($1)
: $_
) => $ENV{$_}
} keys %ENV
} keys %ENV
),
$content,
)

View File

@ -17,11 +17,11 @@ sub store {
if ( $lastCfg == $cfgNum ) {
$req = $self->_dbh->prepare(
"UPDATE $self->{dbiTable} SET data=? WHERE cfgNum=?" );
"UPDATE $self->{dbiTable} SET data=? WHERE cfgNum=?");
}
else {
$req = $self->_dbh->prepare(
"INSERT INTO $self->{dbiTable} (data,cfgNum) VALUES (?,?)" );
"INSERT INTO $self->{dbiTable} (data,cfgNum) VALUES (?,?)");
}
unless ($req) {
$self->logError;

View File

@ -117,7 +117,7 @@ sub delete {
$ts[4]++;
return _modify(
$self,
'(&(objectClass=applicationProcess)(description={uid}'
'(&(objectClass=applicationProcess)(description={uid}'
. $u
. ')(description={ref}'
. $r
@ -145,7 +145,7 @@ sub purge {
my $clause;
$clause = '(description={done}*)' unless ($force);
return _delete( $self,
'(&(objectClass=applicationProcess)(description={uid}'
'(&(objectClass=applicationProcess)(description={uid}'
. $u
. ')(description={ref}'
. $r

View File

@ -161,10 +161,10 @@ sub remove {
}
sub cacheUpdate {
my $self = shift;
# Update a data to force update from cache
return $self->update( { '_session_id' => $self->id } );
my $self = shift;
# Update a data to force update from cache
return $self->update( { '_session_id' => $self->id } );
}
no Mouse;

View File

@ -42,5 +42,6 @@ ok(
# Test a long value, and replace carriage return by %0A
my $long = "f5a1f72e7ab2f7712855a068af0066f36bfcf2c87e6feb9cf4200da1868e1dfe";
my $cryptedlong ="Da6sYxp9NCXv8+8TirqHmPWwTQHyEGmkCBGCLCX/81dPSMwIQVQNV7X9KG3RrKZfyRmzJR6DZYdU%0Ab75+VH3+CA==";
ok ( $c->decrypt( $cryptedlong ) eq $long, "Test of long value encrypting" );
my $cryptedlong =
"Da6sYxp9NCXv8+8TirqHmPWwTQHyEGmkCBGCLCX/81dPSMwIQVQNV7X9KG3RrKZfyRmzJR6DZYdU%0Ab75+VH3+CA==";
ok( $c->decrypt($cryptedlong) eq $long, "Test of long value encrypting" );

View File

@ -12,9 +12,6 @@ use Lemonldap::NG::Handler::SharedConf;
__PACKAGE__->init();
1;
__END__

View File

@ -7,10 +7,10 @@ our $VERSION = '1.4.0';
BEGIN {
my $mp = $ENV{MOD_PERL_API_VERSION};
my $mode =
$mp && $mp >= 2 ? "ApacheMP2" :
$mp ? "ApacheMP1" :
$main::{'nginx::'} ? "Nginx" :
"CGI";
$mp && $mp >= 2 ? "ApacheMP2"
: $mp ? "ApacheMP1"
: $main::{'nginx::'} ? "Nginx"
: "CGI";
eval "use base Lemonldap::NG::Handler::API::$mode";
}

View File

@ -3,38 +3,38 @@ package Lemonldap::NG::Handler::API::ApacheMP1;
our $VERSION = '1.4.0';
sub set_user {
my ($class, $r, $user) = @_;
my ( $class, $r, $user ) = @_;
$r->connection->user($user);
}
sub header_in {
my ($class, $r, $header) = @_;
my ( $class, $r, $header ) = @_;
return $r->header_in($header);
}
sub set_header_in {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$r->header_in( $h => $v );
}
}
sub unset_header_in {
my ($class, $r, @headers) = @_;
my ( $class, $r, @headers ) = @_;
foreach my $h (@headers) {
$r->header_in( $h => "" ) if ( $r->header_in($h) );
}
}
sub set_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$r->header_out( $h => $v );
}
}
sub set_err_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$r->err_header_out( $h => $v );
}

View File

@ -3,73 +3,73 @@ package Lemonldap::NG::Handler::API::ApacheMP2;
our $VERSION = '1.4.0';
sub set_user {
my ($class, $r, $user) = @_;
my ( $class, $r, $user ) = @_;
$r->user($user);
}
sub header_in {
my ($class, $r, $header) = @_;
my ( $class, $r, $header ) = @_;
return $r->headers_in->{$header};
}
sub set_header_in {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$r->headers_in->set( $h => $v );
}
}
sub unset_header_in {
my ($class, $r, @headers) = @_;
my ( $class, $r, @headers ) = @_;
foreach my $h (@headers) {
$r->headers_in->unset($h);
}
}
}
sub set_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$r->headers_out->set( $h => $v );
}
}
}
sub set_err_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$r->err_headers_out->set( $h => $v );
}
}
sub hostname {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
}
sub push_handlers {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
}
sub remote_ip {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
}
sub is_initial_req {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
}
sub args { # (setter et getter)
my ($class, $r, $args) = @_;
sub args { # (setter et getter)
my ( $class, $r, $args ) = @_;
}
sub uri {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
}
sub unparsed_uri {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
}
sub get_server_port {
my ($class, $r) = @_;
my ( $class, $r ) = @_;
}
1;

View File

@ -3,39 +3,41 @@ package Lemonldap::NG::Handler::API::CGI;
our $VERSION = '1.4.0';
sub set_user {
my ($class, $r, $user) = @_;
my ( $class, $r, $user ) = @_;
$ENV{REMOTE_USER} = $user;
}
sub header_in {
my ($class, $r, $header) = @_;
my ( $class, $r, $header ) = @_;
return $ENV{ cgiName($header) };
}
sub set_header_in {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
$ENV{ cgiName($h) } = $v;
}
}
sub unset_header_in {
my ($class, $r, @headers) = @_;
my ( $class, $r, @headers ) = @_;
foreach my $h (@headers) {
$ENV{ cgiName($h) } = undef;
}
}
sub set_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
# TODO
}
}
sub set_err_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
# TODO
}
}

View File

@ -3,42 +3,47 @@ package Lemonldap::NG::Handler::API::Nginx;
our $VERSION = '1.4.0';
sub set_user {
my ($class, $r, $user) = @_;
my ( $class, $r, $user ) = @_;
# Nginx perl API does not (yet ?) allow to set $remote_user var
# So one tries to set the variable $user instead
$r->variable("user", $user)
if ( defined $r->variable("user") );
$r->variable( "user", $user )
if ( defined $r->variable("user") );
}
sub header_in {
my ($class, $r, $header) = @_;
my ( $class, $r, $header ) = @_;
return $r->header_in($header);
}
sub set_header_in {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
# TODO
}
}
sub unset_header_in {
my ($class, $r, @headers) = @_;
my ( $class, $r, @headers ) = @_;
foreach my $h (@headers) {
# TODO
}
}
sub set_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
# TODO
}
}
sub set_err_header_out {
my ($class, $r, %headers) = @_;
my ( $class, $r, %headers ) = @_;
while ( my ( $h, $v ) = each %headers ) {
# TODO
}
}

View File

@ -282,7 +282,8 @@ sub grant {
);
for ( my $i = 0 ; $i < $tsv->{locationCount}->{$vhost} ; $i++ ) {
if ( $uri =~ $tsv->{locationRegexp}->{$vhost}->[$i] ) {
return &{ $tsv->{locationCondition}->{$vhost}->[$i] }($apacheRequest);
return &{ $tsv->{locationCondition}->{$vhost}->[$i] }(
$apacheRequest);
}
}
unless ( $tsv->{defaultCondition}->{$vhost} ) {

View File

@ -372,7 +372,7 @@ sub postUrlInit {
Lemonldap::NG::Handler::Main::PostForm->postFilter(
$tmp, @_ );
}
);
);
OK;
};
}
@ -464,7 +464,7 @@ sub conditionSub {
my $apacheRequest = shift->r;
return $mainClass->redirectFilter(
$self->portal() . "?url="
. $mainClass->encodeUrl($apacheRequest, $u)
. $mainClass->encodeUrl( $apacheRequest, $u )
. "&logout=1",
@_
);

View File

@ -15,7 +15,7 @@ package Lemonldap::NG::Handler::Initialization::LocalInit;
use Mouse;
use Lemonldap::NG::Handler::SharedConf; # Needed to get VERSION
use Lemonldap::NG::Handler::SharedConf; # Needed to get VERSION
use Lemonldap::NG::Handler::Main::Logger;
our $VERSION = '1.3.0';
@ -208,8 +208,8 @@ sub childInit {
$s->push_handlers(
PerlPostConfigHandler => sub {
my ( $c, $l, $t, $s ) = splice @_;
$s->add_version_component(
'Lemonldap::NG::Handler/' . $Lemonldap::NG::Handler::VERSION );
$s->add_version_component( 'Lemonldap::NG::Handler/'
. $Lemonldap::NG::Handler::VERSION );
}
) unless ( $args->{hideSignature} );
}

View File

@ -74,7 +74,7 @@ BEGIN {
jailSharedVars => [qw( $datas )],
tsv => [qw( $tsv )],
import => [qw( import @EXPORT_OK @EXPORT %EXPORT_TAGS )],
apache => [
apache => [
qw( MP OK REDIRECT FORBIDDEN DONE DECLINED SERVER_ERROR
)
],
@ -189,14 +189,14 @@ sub updateStatus {
sub forbidden {
my ( $class, $apacheRequest, $uri ) = splice @_;
if ( $datas->{_logout} ) {
$class->updateStatus( $apacheRequest,
$datas->{ $tsv->{whatToTrace} }, $uri, 'LOGOUT' );
$class->updateStatus( $apacheRequest, $datas->{ $tsv->{whatToTrace} },
$uri, 'LOGOUT' );
my $u = $datas->{_logout};
$class->localUnlog;
return $class->goToPortal( $apacheRequest, $u, 'logout=1' );
}
$class->updateStatus( $apacheRequest,
$datas->{ $tsv->{whatToTrace} }, $uri, 'REJECT' );
$class->updateStatus( $apacheRequest, $datas->{ $tsv->{whatToTrace} },
$uri, 'REJECT' );
$apacheRequest->push_handlers(
PerlLogHandler => sub {
$_[0]->status(FORBIDDEN);
@ -253,16 +253,18 @@ sub logGranted {
# Hide Lemonldap::NG cookie to the protected application.
# @param $apacheRequest current request
sub hideCookie {
my ($class, $apacheRequest) = @_;
my ( $class, $apacheRequest ) = @_;
Lemonldap::NG::Handler::Main::Logger->lmLog( "removing cookie", 'debug' );
my $tmp = Lemonldap::NG::Handler::API->header_in( $apacheRequest, 'Cookie' );
my $tmp =
Lemonldap::NG::Handler::API->header_in( $apacheRequest, 'Cookie' );
$tmp =~ s/$tsv->{cookieName}(http)?=[^,;]*[,;\s]*//og;
if ($tmp) {
Lemonldap::NG::Handler::API->set_header_in( $apacheRequest,
'Cookie' => $tmp );
}
else {
Lemonldap::NG::Handler::API->unset_header_in( $apacheRequest, 'Cookie' );
Lemonldap::NG::Handler::API->unset_header_in( $apacheRequest,
'Cookie' );
}
}
@ -271,7 +273,8 @@ sub hideCookie {
# @return Base64 encoded string
sub encodeUrl {
my ( $class, $apacheRequest, $url ) = splice @_;
$url = $class->_buildUrl($apacheRequest, $url) if ( $url !~ m#^https?://# );
$url = $class->_buildUrl( $apacheRequest, $url )
if ( $url !~ m#^https?://# );
return encode_base64( $url, '' );
}
@ -284,8 +287,10 @@ sub encodeUrl {
sub goToPortal {
my ( $class, $apacheRequest, $url, $arg ) = splice @_;
Lemonldap::NG::Handler::Main::Logger->lmLog(
"Redirect " . $class->ip($apacheRequest) . " to portal (url was $url)", 'debug' );
my $urlc_init = $class->encodeUrl($apacheRequest, $url);
"Redirect " . $class->ip($apacheRequest) . " to portal (url was $url)",
'debug'
);
my $urlc_init = $class->encodeUrl( $apacheRequest, $url );
Lemonldap::NG::Handler::API->set_header_out( $apacheRequest,
'Location' => $class->portal()
. "?url=$urlc_init"
@ -298,9 +303,8 @@ sub goToPortal {
# @param $apacheRequest current request
# @return Value of the cookie if found, 0 else
sub fetchId {
my ( $class, $apacheRequest) = @_;
my $t = Lemonldap::NG::Handler::API->header_in( $apacheRequest,
'Cookie' );
my ( $class, $apacheRequest ) = @_;
my $t = Lemonldap::NG::Handler::API->header_in( $apacheRequest, 'Cookie' );
my $vhost = $apacheRequest->hostname;
my $lookForHttpCookie = $tsv->{securedCookie} =~ /^(2|3)$/
&& !(
@ -375,7 +379,7 @@ sub retrieveSession {
# @param $apacheRequest current request
# @return client IP address
sub ip {
my ( $class, $apacheRequest) = @_;
my ( $class, $apacheRequest ) = @_;
my $ip = 'unknownIP';
eval {
$ip =
@ -429,12 +433,14 @@ sub run ($$) {
my $str = $1;
Lemonldap::NG::Handler::Main::Logger->lmLog( 'CDA request', 'debug' );
$apacheRequest->args($args);
my $redirectUrl = $class->_buildUrl( $apacheRequest, $apacheRequest->uri );
my $redirectUrl =
$class->_buildUrl( $apacheRequest, $apacheRequest->uri );
my $redirectHttps = ( $redirectUrl =~ m/^https/ );
Lemonldap::NG::Handler::API->set_err_header_out( $apacheRequest,
'Location' => $redirectUrl . ( $args ? "?" . $args : "" ),
Lemonldap::NG::Handler::API->set_err_header_out(
$apacheRequest,
'Location' => $redirectUrl . ( $args ? "?" . $args : "" ),
'Set-Cookie' => "$str; path=/"
. ( $redirectHttps ? "; secure" : "" )
. ( $redirectHttps ? "; secure" : "" )
. ( $tsv->{httpOnly} ? "; HttpOnly" : "" )
. (
$tsv->{cookieExpiration}
@ -448,7 +454,7 @@ sub run ($$) {
my $uri_orig = $uri;
Apache2::URI::unescape_url($uri);
my $protection = $class->isUnprotected($apacheRequest, $uri);
my $protection = $class->isUnprotected( $apacheRequest, $uri );
if ( $protection == SKIP ) {
Lemonldap::NG::Handler::Main::Logger->lmLog( "Access control skipped",
@ -464,7 +470,9 @@ sub run ($$) {
my $id;
# Try to recover cookie and user session
if ( $id = $class->fetchId($apacheRequest) and $class->retrieveSession($id) ) {
if ( $id = $class->fetchId($apacheRequest)
and $class->retrieveSession($id) )
{
# AUTHENTICATION done
@ -476,8 +484,8 @@ sub run ($$) {
$datas->{ $tsv->{whatToTrace} } );
# AUTHORIZATION
return $class->forbidden($apacheRequest, $uri)
unless ( $class->grant($apacheRequest, $uri) );
return $class->forbidden( $apacheRequest, $uri )
unless ( $class->grant( $apacheRequest, $uri ) );
$class->updateStatus( $apacheRequest, $datas->{ $tsv->{whatToTrace} },
$apacheRequest->uri, 'OK' );
@ -500,7 +508,8 @@ sub run ($$) {
sub { $class->logGranted( $uri, $datas ); DECLINED }, );
# Catch POST rules
Lemonldap::NG::Handler::Main::PostForm->transformUri($apacheRequest, $uri);
Lemonldap::NG::Handler::Main::PostForm->transformUri( $apacheRequest,
$uri );
return OK;
}
@ -526,9 +535,10 @@ sub run ($$) {
unless ($id);
# if the cookie was fetched, a log is sent by retrieveSession()
$class->updateStatus( $apacheRequest, $class->ip($apacheRequest),
$apacheRequest->uri,
$id ? 'EXPIRED' : 'REDIRECT' );
$class->updateStatus(
$apacheRequest, $class->ip($apacheRequest),
$apacheRequest->uri, $id ? 'EXPIRED' : 'REDIRECT'
);
return $class->goToPortal( $apacheRequest, $uri_orig );
}
}
@ -538,7 +548,7 @@ sub run ($$) {
# @param $apacheRequest current request
# @return true if maintenance mode
sub checkMaintenanceMode {
my ( $class, $apacheRequest) = @_;
my ( $class, $apacheRequest ) = @_;
my $vhost = $apacheRequest->hostname;
my $_maintenance =
( defined $tsv->{maintenance}->{$vhost} )
@ -616,7 +626,7 @@ sub localInit($$) {
(
@$tsv{
qw( localStorage refLocalStorage localStorageOptions statusPipe statusOut childInitDone )
}
}
) = $localinit->localInit($args);
}
@ -645,23 +655,23 @@ sub globalInit {
(
@$tsv{
qw( cookieName securedCookie whatToTrace
qw( cookieName securedCookie whatToTrace
https port customFunctions
timeoutActivity useRedirectOnError useRedirectOnForbidden
useSafeJail key maintenance
cda httpOnly cookieExpiration
cipher )
}
}
)
= $globalinit->defaultValuesInit(
@$tsv{
qw( cookieName securedCookie whatToTrace
qw( cookieName securedCookie whatToTrace
https port customFunctions
timeoutActivity useRedirectOnError useRedirectOnForbidden
useSafeJail key maintenance
cda httpOnly cookieExpiration
cipher )
},
},
@_
);
@ -673,7 +683,7 @@ sub globalInit {
defaultProtection locationCondition
locationProtection locationRegexp
locationConditionText safe )
}
}
)
= $globalinit->locationRulesInit(
$class,
@ -682,7 +692,7 @@ sub globalInit {
defaultProtection locationCondition
locationProtection locationRegexp
locationConditionText )
},
},
@_
);
@ -719,7 +729,8 @@ sub grant {
. '" match',
'debug'
);
return &{ $tsv->{locationCondition}->{$vhost}->[$i] }($apacheRequest);
return &{ $tsv->{locationCondition}->{$vhost}->[$i] }(
$apacheRequest);
}
}
unless ( $tsv->{defaultCondition}->{$vhost} ) {
@ -809,7 +820,7 @@ sub status($$) {
my ( $class, $r ) = splice @_;
Lemonldap::NG::Handler::Main::Logger->lmLog( "$class: request for status",
'debug' );
return $class->abort($r, "$class: status page can not be displayed")
return $class->abort( $r, "$class: status page can not be displayed" )
unless ( $tsv->{statusPipe} and $tsv->{statusOut} );
$r->handler("perl-script");
print { $tsv->{statusPipe} } "STATUS"

View File

@ -44,7 +44,8 @@ sub sendHeaders {
my ( $class, $apacheRequest, $forgeHeaders ) = splice @_;
my $vhost = $apacheRequest->hostname;
if ( defined( $forgeHeaders->{$vhost} ) ) {
Lemonldap::NG::Handler::API->set_header_in( $apacheRequest, &{ $forgeHeaders->{$vhost} } );
Lemonldap::NG::Handler::API->set_header_in( $apacheRequest,
&{ $forgeHeaders->{$vhost} } );
}
}
@ -54,7 +55,8 @@ sub cleanHeaders {
my ( $class, $apacheRequest, $forgeHeaders, $headerList ) = splice @_;
my $vhost = $apacheRequest->hostname;
if ( defined( $forgeHeaders->{$vhost} ) ) {
Lemonldap::NG::Handler::API->unset_header_in( $apacheRequest, @{ $headerList->{$vhost} } );
Lemonldap::NG::Handler::API->unset_header_in( $apacheRequest,
@{ $headerList->{$vhost} } );
}
}

View File

@ -120,11 +120,11 @@ sub share_from {
sub jail_reval {
my ( $self, $reval ) = splice @_;
# if nothing is returned by reval, add the return statement to
# if nothing is returned by reval, add the return statement to
# the "no safe wrap" reval
my $nosw_reval = $reval;
if ( $reval !~ /^sub\{return\(.*\}$/ ) {
$nosw_reval =~ s/^sub{(.*)}$/sub{return($1)}/
$nosw_reval =~ s/^sub{(.*)}$/sub{return($1)}/;
}
return (

View File

@ -12,7 +12,7 @@ sub lmLog {
die("Level is required") unless ($level);
my $call;
my @tmp = caller();
(my $module = $tmp[0]) =~ s/.+:://g;
( my $module = $tmp[0] ) =~ s/.+:://g;
$module .= "($tmp[2]): ";
unless ( $level eq 'debug' ) {
$call = "$tmp[1] $tmp[2]:";

View File

@ -35,7 +35,7 @@ sub transformUri {
my $vhost = $apacheRequest->hostname;
if ( defined( $tsv->{transform}->{$vhost}->{$uri} ) ) {
return &{ $tsv->{transform}->{$vhost}->{$uri} } ($apacheRequest);
return &{ $tsv->{transform}->{$vhost}->{$uri} }($apacheRequest);
}
OK;
@ -49,7 +49,7 @@ sub transformUri {
# @param count Fake input size
# @return Apache2::Const::OK
sub buildPostForm {
my ($class, $apacheRequest, $url, $count) = @_;
my ( $class, $apacheRequest, $url, $count ) = @_;
$count ||= 1000;
$apacheRequest->handler("perl-script");
$apacheRequest->add_config( ["SetHandler perl-script"] );

View File

@ -95,7 +95,7 @@ sub defaultValuesInit {
(
@$tsv{
qw( cookieName securedCookie whatToTrace
qw( cookieName securedCookie whatToTrace
https port customFunctions
timeoutActivity useRedirectOnError useRedirectOnForbidden
useSafeJail key maintenance
@ -105,7 +105,7 @@ sub defaultValuesInit {
)
= $globalinit->defaultValuesInit(
@$tsv{
qw( cookieName securedCookie whatToTrace
qw( cookieName securedCookie whatToTrace
https port customFunctions
timeoutActivity useRedirectOnError useRedirectOnForbidden
useSafeJail key maintenance

View File

@ -59,7 +59,11 @@ sub run ($$) {
# AUTHENTICATION
# I - recover the WWW-Authentication header
my ( $id, $user, $pass );
unless ( $user = Lemonldap::NG::Handler::API->header_in( $apacheRequest, 'Authorization' ) )
unless (
$user = Lemonldap::NG::Handler::API->header_in(
$apacheRequest, 'Authorization'
)
)
{
Lemonldap::NG::Handler::API->set_err_header_out( $apacheRequest,
'WWW-Authenticate' => 'Basic realm="LemonLDAP::NG"' );
@ -104,7 +108,8 @@ sub run ($$) {
# Catch SOAP errors
if ( $r->fault ) {
return $class->abort($apacheRequest, "SOAP request to the portal failed: "
return $class->abort( $apacheRequest,
"SOAP request to the portal failed: "
. $r->fault->{faultstring} );
}
else {
@ -143,7 +148,7 @@ sub run ($$) {
"The cookie $session_id isn't yet available", 'info' );
$class->updateStatus( $apacheRequest, $class->ip($apacheRequest),
$apacheRequest->uri, 'EXPIRED' );
return $class->goToPortal($apacheRequest, $uri);
return $class->goToPortal( $apacheRequest, $uri );
}
$datas->{$_} = $apacheSession->data->{$_}
@ -159,11 +164,12 @@ sub run ($$) {
# ACCOUNTING
# 1 - Inform Apache
Lemonldap::NG::Handler::API->set_user( $apacheRequest, $datas->{ $tsv->{whatToTrace} } );
Lemonldap::NG::Handler::API->set_user( $apacheRequest,
$datas->{ $tsv->{whatToTrace} } );
# AUTHORIZATION
return $class->forbidden($apacheRequest, $uri)
unless ( $class->grant($apacheRequest, $uri) );
return $class->forbidden( $apacheRequest, $uri )
unless ( $class->grant( $apacheRequest, $uri ) );
$class->updateStatus( $apacheRequest, $datas->{ $tsv->{whatToTrace} },
$apacheRequest->uri, 'OK' );
$class->logGranted( $uri, $datas );
@ -173,7 +179,8 @@ sub run ($$) {
$class->hideCookie($apacheRequest);
# Hide user password
Lemonldap::NG::Handler::API->unset_header_in( $apacheRequest, "Authorization" );
Lemonldap::NG::Handler::API->unset_header_in( $apacheRequest,
"Authorization" );
# ACCOUNTING
# 2 - Inform remote application

View File

@ -155,7 +155,8 @@ sub run {
return $class->_returnError($r) unless $key;
# Header location
Lemonldap::NG::Handler::API->set_header_in( $r, $secureTokenHeader => $key );
Lemonldap::NG::Handler::API->set_header_in( $r,
$secureTokenHeader => $key );
# Remove token
eval 'use Apache2::Filter' unless ( $INC{"Apache2/Filter.pm"} );
@ -274,7 +275,7 @@ sub _isAlive {
# Give hand back to Apache
# @return Apache2::Const value
sub _returnError {
my ($class, $apacheRequest) = @_;
my ( $class, $apacheRequest ) = @_;
if ($secureTokenAllowOnError) {
Lemonldap::NG::Handler::Main::Logger->lmLog(

View File

@ -78,7 +78,7 @@ sub run {
return $ret unless ( $ret == OK );
# Fail if no sympaSecret
return $class->abort($r, "No Sympa secret configured")
return $class->abort( $r, "No Sympa secret configured" )
unless ($sympaSecret);
# Mail value

View File

@ -85,7 +85,7 @@ sub run {
# @param $apacheRequest current request
# @return Value of the cookie if found, 0 else
sub fetchUTime {
my ( $class, $apacheRequest ) = @_;
my ( $class, $apacheRequest ) = @_;
my $t = Lemonldap::NG::Handler::API->header_in( $apacheRequest, 'Cookie' );
my $c = $tsv->{cookieName} . 'update';
return ( $t =~ /$c=([^,; ]+)/o ) ? $1 : 0;

View File

@ -93,7 +93,7 @@ sub run {
return OK unless ( $uri =~ $zimbraSsoUrl );
# Check mandatory parameters
return $class->abort($r, "No Zimbra preauth key configured")
return $class->abort( $r, "No Zimbra preauth key configured" )
unless ($zimbraPreAuthKey);
# Build URL
@ -103,7 +103,8 @@ sub run {
);
# Header location
Lemonldap::NG::Handler::API->set_header_out( $r, 'Location' => $zimbra_url );
Lemonldap::NG::Handler::API->set_header_out( $r,
'Location' => $zimbra_url );
# Return REDIRECT
return REDIRECT;

View File

@ -45,11 +45,12 @@ ok(
);
my $args = {
'portal' => 'http://auth.example.com/',
'globalStorage' => 'Apache::Session::File',
'post' => {},
'locationRules' => {
'test1.example.com' => {
'portal' => 'http://auth.example.com/',
'globalStorage' => 'Apache::Session::File',
'post' => {},
'locationRules' => {
'test1.example.com' => {
# Basic rules
'default' => 'accept',
'^/no' => 'deny',
@ -62,8 +63,8 @@ my $args = {
# Good ordered rules
'(?#1 first)^/b/a' => 'deny',
'(?#2 second)^/b' => 'accept',
},
},
},
},
};
# includes
@ -78,9 +79,9 @@ ok( $h->globalInit($args), 'globalInit' );
ok( $h->portal() eq 'http://auth.example.com/', 'portal' );
ok( $h->grant($apacheRequest, '/s' ), 'basic rule "accept"' );
ok( !$h->grant($apacheRequest, '/no' ), 'basic rule "deny"' );
ok( $h->grant($apacheRequest, '/a/a'), 'bad ordered rule 1/2' );
ok( $h->grant($apacheRequest, '/a' ), 'bad ordered rule 2/2' );
ok( !$h->grant($apacheRequest, '/b/a'), 'good ordered rule 1/2' );
ok( $h->grant($apacheRequest, '/b' ), 'good ordered rule 2/2' );
ok( $h->grant( $apacheRequest, '/s' ), 'basic rule "accept"' );
ok( !$h->grant( $apacheRequest, '/no' ), 'basic rule "deny"' );
ok( $h->grant( $apacheRequest, '/a/a' ), 'bad ordered rule 1/2' );
ok( $h->grant( $apacheRequest, '/a' ), 'bad ordered rule 2/2' );
ok( !$h->grant( $apacheRequest, '/b/a' ), 'good ordered rule 1/2' );
ok( $h->grant( $apacheRequest, '/b' ), 'good ordered rule 2/2' );

View File

@ -131,7 +131,7 @@ sub menu {
my $self = shift;
require Lemonldap::NG::Manager::Downloader;
return
'<ul class="simpleTree">'
'<ul class="simpleTree">'
. $self->li( 'root', 'root' )
. $self->span(
id => 'root',

View File

@ -71,7 +71,7 @@ sub extractFormInfo {
foreach ( keys %{ $self->{portalHiddenFormValues} } ) {
$local_url .=
( $local_url =~ /\?/ ? '&' : '?' )
( $local_url =~ /\?/ ? '&' : '?' )
. $_ . '='
. uri_escape( $self->{portalHiddenFormValues}->{$_} );
}

View File

@ -178,7 +178,7 @@ sub extractFormInfo {
my $val = $self->param($_);
$val = 'check_authentication' if $_ eq 'openid.mode';
sprintf '%s=%s', uri_escape_utf8($_), uri_escape_utf8($val);
} $self->param()
} $self->param()
);
# Launch request

View File

@ -193,7 +193,7 @@ sub sregHook {
foreach my $k (@opt) {
utf8::decode( $msg{opt}->{$k} );
$self->{_openIdTrustExtMsg} .=
"<tr class=\"optional\">\n"
"<tr class=\"optional\">\n"
. "<td>\n"
. "<input type=\"checkbox\" value=\"OK\""
. ( $ag{$k} ? 'checked="checked"' : '' )

View File

@ -51,7 +51,7 @@ sub setSessionInfo {
}
else {
$self->lmLog(
'Ignoring attribute '
'Ignoring attribute '
. $v
. ' which is not a valid OpenID SREG attribute',
'warn'

View File

@ -31,7 +31,7 @@ sub getCasSession {
}
);
unless ($casSession->data) {
unless ( $casSession->data ) {
if ($id) {
$self->_sub( 'userInfo', "CAS session $id isn't yet available" );
}