Commit dbfbde2e authored by Clément OUDOT's avatar Clément OUDOT
Browse files

make tidy

parent ea363594
......@@ -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;
......
#############################################################################
#
# 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;
......@@ -63,7 +63,7 @@ sub handle {
: ($1)
: $_
) => $ENV{$_}
} keys %ENV
} keys %ENV
),
$content,
)
......
......@@ -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;
......
......@@ -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
......
......@@ -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;
......
......@@ -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" );
......@@ -12,9 +12,6 @@ use Lemonldap::NG::Handler::SharedConf;
__PACKAGE__->init();
1;
__END__
......
......@@ -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";
}
......
......@@ -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 );
}
......
......@@ -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;
......@@ -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
}
}
......
......@@ -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
}
}
......
......@@ -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} ) {
......
......@@ -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",
@_
);
......
......@@ -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} );
}
......
......@@ -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' );