...
 
Commits (3)
# -*- conf -*-
# FIXME: the list of checks should probably be moved to
# t/scripts/critic.pl. Line continuations are not supported here
verbose = 1
# Severity is actually ignored for our main purposes, see below
severity = 1
# Work based on a whitelist
only = 1
# Our whitelist (ignores severity):
include = ExplicitReturnUndef GlobFunction NegativeIndices PrivateVars UselessInitialization MatchVars NumberSeparators NullStatements LongChainsOfMethodCalls UseStrict EndWithOne ConditionalUseStatements PackageMatchesPodName JoinedReadline UnreachableCode TrailingWhitespace InterpolationOfLiterals ImplicitNewlines CommaSeparatedStatements UnusedVariables UnusedCapture TwoArgOpen ProhibitHardTabs MismatchedOperators IndirectSyntax Modules:: BuiltinFunctions:: ClassHierarchies:: CommaSeparatedStatements QuotesAsQuotelikeOperatorDelimiters MixedBooleanOperators ProhibitBarewordFileHandles ConditionalUseStatements Modules::ProhibitAutomaticExportation ProhibitBarewordFileHandles ConditionalDeclarations
#include = MixedBooleanOperators InteractiveTest UpperCaseHeredoc ReusedNames PackageVars ConditionalDeclarations SingleCharAlternation FixedStringMatches ConditionalUseStatements QuotedWordLists
exclude = RequireFilenameMatchesPackage RequireVersionVar ProhibitExcessMainComplexity ProhibitStringySplit ComplexMappings StringyEval Documentation::PodSpell BuiltinFunctions::ProhibitUselessTopic
# If you want to try some other stuff, uncomment the following
# (exclude is an incomplete list of things we probably won't change)
# theme = security || bugs || complexity || maintenance
# exclude = ExtendedFormat LineBoundaryMatch DotMatchAnything BuiltinHomonyms InitializationForLocalVars UnusualDelimiters
# even more stuff if theme is empty
# Would be nice to fix at some point:
# include = ProhibitBarewordFileHandles
criticism-fatal = 1
color = 1
allow-unsafe = 1
[BuiltinFunctions::ProhibitBooleanGrep]
[InputOutput::RequireCheckedSyscalls]
functions = open opendir chdir read readdir readline closedir sysopen sysread sysclose mkdir link pipe readlink unlink rename symlink fork
# possible TODO close
# Checks and collections blow up
[-Modules::RequireFilenameMatchesPackage]
# We don't use package versions atm and even if we did, it probably
# won't have full coverage anyway.
[-Modules::RequireVersionVar]
# Maybe some day...
[-Modules::ProhibitExcessMainComplexity]
[Subroutines::RequireFinalReturn]
terminal_funcs = CORE::exec fatal_error internal_error Lintian::Util::internal_error Die error
[ValuesAndExpressions::ProhibitInterpolationOfLiterals]
[ValuesAndExpressions::ProhibitCommaSeparatedStatements]
allow_last_statement_to_be_comma_separated_in_map_and_grep = 1
[-ValuesAndExpressions::ProhibitConstantPragma]
# Requires "use English" and our style is against that.
[-Variables::ProhibitPunctuationVars]
[Variables::RequireLocalizedPunctuationVars]
allow = %ENV %SIG $! $? $0
......@@ -83,6 +83,7 @@ t/35-Common-Crypto.t
t/36-Common-Regexp.t
t/40-Common-Session.t
t/50-Combination-Parser.t
t/99-critic.t
t/99-pod.t
tools/apache-session-mysql.sql
tools/lmConfig.CDBI.mysql
......
......@@ -30,14 +30,14 @@ sub populate {
my $self = shift;
my $backend = $self->{args}->{backend};
_load($backend);
$backend .= "::populate";
$backend .= '::populate';
{
no strict 'refs';
$self = $self->$backend(@_);
}
if ( $backend =~
/^Apache::Session::(?:(?:Postgre|Redi)s|S(?:QLite3|ybase)|(?:My|No)SQL|F(?:ile|lex)|Cassandra|Oracle|LDAP)/
and !$self->{args}->{useStorable} )
and not $self->{args}->{useStorable} )
{
$self->{serialize} =
\&Lemonldap::NG::Common::Apache::Session::Serialize::JSON::serialize;
......@@ -52,8 +52,8 @@ sub populate {
my $generate = $self->{args}->{generateModule};
eval "require $generate";
die $@ if ($@);
$self->{generate} = \&{ $generate . "::generate" };
$self->{validate} = \&{ $generate . "::validate" };
$self->{generate} = \&{ $generate . '::generate' };
$self->{validate} = \&{ $generate . '::validate' };
}
if ( $self->{args}->{setId} ) {
$self->{generate} = \&setId;
......@@ -72,6 +72,8 @@ sub populate {
return $self;
}
1;
__END__
sub setId {
......
......@@ -30,7 +30,7 @@ sub generate {
),
0, $length
);
return;
}
sub validate {
......@@ -42,10 +42,10 @@ sub validate {
my $session = shift;
if ( $session->{data}->{_session_id} =~ /^([a-fA-F0-9]+)$/ ) {
$session->{data}->{_session_id} = $1;
return $session->{data}->{_session_id} = $1;
}
else {
die "Invalid session ID: " . $session->{data}->{_session_id};
die 'Invalid session ID: ' . $session->{data}->{_session_id};
}
}
......
......@@ -41,9 +41,10 @@ sub acquire_read_lock {
if ( $self->cache->get($id) ) {
# got session from cache, no need to ask for locks
return
}
else {
$self->module->acquire_read_lock($session);
return $self->module->acquire_read_lock($session);
}
}
......@@ -51,21 +52,21 @@ sub acquire_write_lock {
my $self = shift;
my $session = shift;
$self->module->acquire_write_lock($session);
return $self->module->acquire_write_lock($session);
}
sub release_write_lock {
my $self = shift;
my $session = shift;
$self->module->release_write_lock($session);
return $self->module->release_write_lock($session);
}
sub release_all_locks {
my $self = shift;
my $session = shift;
$self->module->release_all_locks($session);
return $self->module->release_all_locks($session);
}
1;
......
......@@ -7,14 +7,14 @@ use JSON qw(from_json to_json);
our $VERSION = '2.1.0';
our @ISA = qw(Lemonldap::NG::Common::Apache::Session::Generate::SHA256);
use base 'Lemonldap::NG::Common::Apache::Session::Generate::SHA256';
# PUBLIC INTERFACE
# Constructor for Perl TIE mechanism. See perltie(3) for more.
sub TIEHASH {
my ( $class, $session_id, $args ) = @_;
die "baseUrl argument is required"
die 'baseUrl argument is required'
unless ( $args and $args->{baseUrl} );
my $self = {
data => { _session_id => $session_id },
......@@ -37,7 +37,7 @@ sub TIEHASH {
$self->newSession;
}
else {
die "unable to create session"
die 'unable to create session'
unless ( $self->newSession() );
}
return $self;
......@@ -65,7 +65,7 @@ sub DELETE {
$self->{modified} = 1;
delete $self->{data}->{$key};
return delete $self->{data}->{$key};
}
sub CLEAR {
......@@ -73,7 +73,7 @@ sub CLEAR {
$self->{modified} = 1;
$self->{data} = {};
return $self->{data} = {};
}
sub EXISTS {
......@@ -95,7 +95,7 @@ sub NEXTKEY {
sub DESTROY {
my $self = shift;
$self->save;
return $self->save;
}
sub ua {
......@@ -207,7 +207,7 @@ sub save {
# Update session in cache
if ( $self->{localStorage} ) {
my $id = "rest" . $self->{data}->{_session_id};
my $id = 'rest' . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
......@@ -236,7 +236,7 @@ sub save {
return $res;
}
else {
print STDERR "REST server returns " . $resp->status_line;
print STDERR 'REST server returns ' . $resp->status_line;
return;
}
}
......@@ -248,7 +248,7 @@ sub delete {
# Remove session from cache
if ( $self->{localStorage} ) {
my $id = "rest" . $self->{data}->{_session_id};
my $id = 'rest' . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
......@@ -265,7 +265,7 @@ sub delete {
## @method get_key_from_all_sessions()
# Not documented.
sub get_key_from_all_sessions() {
die "Not implemented";
die 'Not implemented';
my ( $class, $args, $data ) = @_;
my $self = bless {}, $class;
foreach (qw(baseUrl user password realm)) {
......@@ -303,10 +303,10 @@ sub cache {
1;
__END__
=head1 NAME
=encoding utf8
=head1 NAME
Lemonldap::NG::Common::Apache::Session::REST - Perl extension written to
access to Lemonldap::NG Web-SSO sessions via REST.
......
......@@ -38,8 +38,7 @@ sub TIEHASH {
my $session_id = shift;
my $args = shift;
my ( $proxy, $proxyOptions );
die "proxy argument is required"
die 'proxy argument is required'
unless ( $args and $args->{proxy} );
my $self = {
data => { _session_id => $session_id },
......@@ -56,7 +55,7 @@ sub TIEHASH {
unless ( $self->get($session_id) );
}
else {
die "unable to create session"
die 'unable to create session'
unless ( $self->newSession() );
}
return $self;
......@@ -84,7 +83,7 @@ sub DELETE {
$self->{modified} = 1;
delete $self->{data}->{$key};
return delete $self->{data}->{$key};
}
sub CLEAR {
......@@ -92,7 +91,7 @@ sub CLEAR {
$self->{modified} = 1;
$self->{data} = {};
return $self->{data} = {};
}
sub EXISTS {
......@@ -114,7 +113,7 @@ sub NEXTKEY {
sub DESTROY {
my $self = shift;
$self->save;
return $self->save;
}
## @method private SOAP::Lite _connect()
......@@ -139,7 +138,7 @@ sub _soapCall {
my $func = shift;
my $r = $self->_connect->$func(@_);
if ( $r->fault ) {
print STDERR "SOAP Error: " . $r->fault->{faultstring};
print STDERR 'SOAP Error: ' . $r->fault->{faultstring};
return ();
}
return $r->result;
......@@ -158,7 +157,7 @@ sub get {
}
# No cache, use SOAP and set cache
my $r = $self->_soapCall( "getAttributes", $id );
my $r = $self->_soapCall( 'getAttributes', $id );
return 0 unless ( $r or $r->{error} );
$self->{data} = $r->{attributes};
......@@ -172,11 +171,11 @@ sub get {
# @return User data (just the session ID)
sub newSession {
my $self = shift;
$self->{data} = $self->_soapCall("newSession");
$self->{data} = $self->_soapCall('newSession');
# Set cache
if ( $self->{localStorage} ) {
my $id = "soap" . $self->{data}->{_session_id};
my $id = 'soap' . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
......@@ -194,7 +193,7 @@ sub save {
# Update session in cache
if ( $self->{localStorage} ) {
my $id = "soap" . $self->{data}->{_session_id};
my $id = 'soap' . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
......@@ -202,7 +201,7 @@ sub save {
}
# SOAP
return $self->_soapCall( "setAttributes", $self->{data}->{_session_id},
return $self->_soapCall( 'setAttributes', $self->{data}->{_session_id},
$self->{data} );
}
......@@ -213,14 +212,14 @@ sub delete {
# Remove session from cache
if ( $self->{localStorage} ) {
my $id = "soap" . $self->{data}->{_session_id};
my $id = 'soap' . $self->{data}->{_session_id};
if ( $self->cache->get($id) ) {
$self->cache->remove($id);
}
}
# SOAP
return $self->_soapCall( "deleteSession", $self->{data}->{_session_id} );
return $self->_soapCall( 'deleteSession', $self->{data}->{_session_id} );
}
## @method get_key_from_all_sessions()
......@@ -240,7 +239,7 @@ sub get_key_from_all_sessions() {
my $token = Lemonldap::NG::Handler::Main->tsv->{cipher}
->decrypt( $self->_soapCall('getCipheredToken') );
if ( ref($data) eq 'CODE' ) {
my $r = $self->_soapCall( "get_key_from_all_sessions", $token );
my $r = $self->_soapCall( 'get_key_from_all_sessions', $token );
my $res;
if ($r) {
foreach my $k ( keys %$r ) {
......@@ -248,9 +247,10 @@ sub get_key_from_all_sessions() {
$res->{$k} = $tmp if ( defined($tmp) );
}
}
return;
}
else {
return $self->_soapCall( "get_key_from_all_sessions", $token, $data );
return $self->_soapCall( 'get_key_from_all_sessions', $token, $data );
}
}
......@@ -269,10 +269,10 @@ sub cache {
1;
__END__
=head1 NAME
=encoding utf8
=head1 NAME
Lemonldap::NG::Common::Apache::Session::SOAP - Perl extension written to
access to Lemonldap::NG Web-SSO sessions via SOAP.
......
......@@ -8,23 +8,24 @@ our $VERSION = '2.1.0';
sub serialize {
my $session = shift;
$session->{serialized} = to_json( $session->{data}, { allow_nonref => 1 } );
return $session->{serialized} =
to_json( $session->{data}, { allow_nonref => 1 } );
}
sub unserialize {
my $session = shift;
my $data = _unserialize( $session->{serialized} );
die "Session could not be unserialized" unless defined $data;
$session->{data} = $data;
die 'Session could not be unserialized' unless defined $data;
return $session->{data} = $data;
}
sub unserializeBase64 {
my $session = shift;
my $data = _unserialize( $session->{serialized}, \&decodeThaw64 );
die "Session could not be unserialized" unless defined $data;
$session->{data} = $data;
die 'Session could not be unserialized' unless defined $data;
return $session->{data} = $data;
}
sub decodeThaw64 {
......@@ -49,10 +50,10 @@ sub _unserialize {
=pod
=head1 NAME
=encoding utf8
=head1 NAME
Lemonldap::NG::Common::Apache::Session::Serialize::JSON - Use JSON to zip up data
=head1 SYNOPSIS
......
package Lemonldap::NG::Common::Apache::Session::Store;
use strict;
our $VERSION = '2.1.0';
sub new {
......
......@@ -163,7 +163,7 @@ sub findB {
my @chars = split //, $expr;
while (@chars) {
my $c = shift @chars;
if ( $c eq "\\" ) {
if ( $c eq '\\' ) {
$res .= $c . shift(@chars);
next;
}
......@@ -175,11 +175,11 @@ sub findB {
}
if ( $c =~ /^(?:\(|\{|\[|'|")$/ ) {
my $wanted = {
'(' => ')',
'{' => '}',
'[' => ']',
"'" => "'",
'"' => '"'
'(' => ')',
'{' => '}',
'[' => ']',
'\'' => '\'',
'"' => '"'
}->{$c};
my ( $m, $rest ) =
$self->findB( join( '', @chars ), $wanted );
......@@ -192,7 +192,7 @@ sub findB {
}
$res .= $c;
}
return undef;
return;
}
# Compiles condition into sub
......
......@@ -24,13 +24,10 @@ sub new {
$bck{$last} = $last->new(@_);
}
my $obj = $bck{$last};
eval "sub $l {
shift;
return \$obj->$l(\@_);
}";
eval "sub $l { shift; return \$obj->$l(\@_); }";
}
else {
eval qq'sub $l {1}';
eval "sub $l {1}";
}
$show = 0 if ( $conf->{logLevel} eq $l );
......
package Lemonldap::NG::Common::Logger::Null;
use strict;
our $VERSION = '2.1.0';
sub new {
......
......@@ -23,11 +23,11 @@ sub new {
$rl = 'info' if ( $rl = 'notice' );
if ($show) {
eval
qq'sub $_ {\$_[0]->{raven}->capture_message(\$_[1],level => "$rl")}';
qq@sub $_ {\$_[0]->{raven}->capture_message(\$_[1],level => "$rl")}@;
die $@ if ($@);
}
else {
eval qq'sub $_ {1}';
eval "sub $_ {1}";
}
$show = 0 if ( $conf->{logLevel} eq $_ );
}
......
......@@ -10,10 +10,10 @@ sub new {
my $show = 1;
foreach (qw(error warn notice info debug)) {
if ($show) {
eval qq'sub $_ {print STDERR "[$_] \$_[1]\n"}';
eval qq@sub $_ {print STDERR "[$_] \$_[1]\n"}@;
}
else {
eval qq'sub $_ {1}';
eval qq@sub $_ {1}@;
}
$show = 0 if ( $level eq $_ );
}
......
......@@ -23,11 +23,11 @@ sub new {
my $name = $_;
$name = 'warning' if ( $_ eq 'warn' );
$name = 'err' if ( $_ eq 'error' );
eval qq'sub $_ {syslog("$name|".\$_[0]->{facility},\$_[1])}';
eval qq@sub $_ {syslog("$name|".\$_[0]->{facility},\$_[1])}@;
die $@ if ($@);
}
else {
eval qq'sub $_ {1}';
eval "sub $_ {1}";
}
$show = 0 if ( $level eq $_ );
}
......
......@@ -118,12 +118,12 @@ sub _del {
sub jsonResponse {
my ( $self, $path, $query ) = @_;
my $res = $self->_get( $path, $query )
or die "PSGI lib has refused my get, aborting";
or die 'PSGI lib has refused my get, aborting';
unless ( $res->[0] == 200 ) {
require Data::Dumper;
$Data::Dumper::Useperl = 1;
print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
die "Manager lib does not return a 200 code, aborting";
die 'Manager lib does not return a 200 code, aborting';
}
my $href = from_json( $res->[2]->[0], { allow_nonref => 1 } )
or die 'Response is not JSON';
......@@ -133,12 +133,12 @@ sub jsonResponse {
sub jsonPostResponse {
my ( $self, $path, $query, $body, $type, $len ) = @_;
my $res = $self->_post( $path, $query, $body, $type, $len )
or die "PSGI lib has refused my post, aborting";
or die 'PSGI lib has refused my post, aborting';
unless ( $res->[0] == 200 ) {
require Data::Dumper;
$Data::Dumper::Useperl = 1;
print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
die "Manager lib does not return a 200 code, aborting";
die 'Manager lib does not return a 200 code, aborting';
}
my $href = from_json( $res->[2]->[0], { allow_nonref => 1 } )
or die 'Response is not JSON';
......@@ -148,12 +148,12 @@ sub jsonPostResponse {
sub jsonPutResponse {
my ( $self, $path, $query, $body, $type, $len ) = @_;
my $res = $self->_put( $path, $query, $body, $type, $len )
or die "PSGI lib has refused my put, aborting";
or die 'PSGI lib has refused my put, aborting';
unless ( $res->[0] == 200 ) {
require Data::Dumper;
$Data::Dumper::Useperl = 1;
print STDERR "Result dump :\n" . Data::Dumper::Dumper($res);
die "Manager lib does not return a 200 code, aborting";
die 'Manager lib does not return a 200 code, aborting';
}
my $href = from_json( $res->[2]->[0], { allow_nonref => 1 } )
or die 'Response is not JSON';
......
......@@ -9,7 +9,7 @@ use URI::Escape;
our $VERSION = '2.1.0';
our @ISA = ('Plack::Request');
use base 'Plack::Request';
# http :// server / path ? query # fragment
# m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
......@@ -19,6 +19,7 @@ sub BUILD {
foreach ( keys %$env ) {
$self->{$_} ||= $env->{$_} if (/^(?:HTTP|SSL)_/);
}
return $self;
}
sub new {
......@@ -39,9 +40,9 @@ sub new {
return bless( $self, $_[0] );
}
sub data { $_[0]->{data} }
sub data { return $_[0]->{data} }
sub uri { $_[0]->{uri} }
sub uri { return $_[0]->{uri} }
sub userData {
my ( $self, $v ) = @_;
......@@ -55,13 +56,13 @@ sub respHeaders {
return $self->{respHeaders};
}
sub accept { $_[0]->env->{HTTP_ACCEPT} }
sub encodings { $_[0]->env->{HTTP_ACCEPT_ENCODING} }
sub languages { $_[0]->env->{HTTP_ACCEPT_LANGUAGE} }
sub authorization { $_[0]->env->{HTTP_AUTHORIZATION} }
sub hostname { $_[0]->env->{HTTP_HOST} }
sub referer { $_[0]->env->{REFERER} }
sub query_string { $_[0]->env->{QUERY_STRING} }
sub accept { return $_[0]->env->{HTTP_ACCEPT} }
sub encodings { return $_[0]->env->{HTTP_ACCEPT_ENCODING} }
sub languages { return $_[0]->env->{HTTP_ACCEPT_LANGUAGE} }
sub authorization { return $_[0]->env->{HTTP_AUTHORIZATION} }
sub hostname { return $_[0]->env->{HTTP_HOST} }
sub referer { return $_[0]->env->{REFERER} }
sub query_string { return $_[0]->env->{QUERY_STRING} }
sub error {
my ( $self, $err ) = @_;
......@@ -74,7 +75,7 @@ sub error {
sub set_param {
my ( $self, $k, $v ) = @_;
$self->param;
$self->env->{'plack.request.merged'}->{$k} =
return $self->env->{'plack.request.merged'}->{$k} =
$self->env->{'plack.request.query'}->{$k} = $v;
}
......@@ -91,16 +92,16 @@ sub jsonBodyToObj {
return $self->{json_body} if ( $self->{json_body} );
unless ( $self->content_type =~ /application\/json/ ) {
$self->error('Data is not JSON');
return undef;
return;
}
unless ( $self->body ) {
$self->error('No data');
return undef;
return;
}
my $j = eval { from_json( $self->content, { allow_nonref => 1 } ) };
if ($@) {
$self->error("$@$!");
return undef;
return;
}
return $self->{json_body} = $j;
}
......@@ -108,10 +109,10 @@ sub jsonBodyToObj {
1;
__END__
=head1 NAME
=encoding utf8
=head1 NAME
Lemonldap::NG::Common::PSGI::Request - HTTP request object for Lemonldap::NG
PSGIs
......
......@@ -81,7 +81,7 @@ sub genRoute {
}
}
if ( $routes->{$word} ) {
eval { $self->logger->warn(qq'Route "$word" redefined'); };
eval { $self->logger->warn(qq@Route "$word" redefined@); };
}
if ( my $t = ref $dest ) {
if ( $t eq 'CODE' ) {
......@@ -99,6 +99,7 @@ sub genRoute {
}
$self->logger->debug("route $word added");
}
return;
}
sub handlerAbort {
......@@ -110,6 +111,7 @@ sub handlerAbort {
return $self->sendError( $req, $msg, 500 );
}
);
return;
}
# Methods that dispatch requests
......@@ -131,9 +133,9 @@ sub handler {
$last = 1 if ( $_ =~ /[^\.\w]/ );
( $last or /^$/ ? 0 : 1 );
} split /\//, $req->path();
$self->logger->debug( "Start routing " . ( $path[0] // 'default route' ) );
$self->logger->debug( 'Start routing ' . ( $path[0] // 'default route' ) );
if ( !@path and $self->defaultRoute ) {
if ( not @path and $self->defaultRoute ) {
@path = ( $self->defaultRoute );
}
my $res =
......@@ -164,17 +166,17 @@ sub followPath {
return $self->$sub( $req, @$path );
}
else {
return undef;
return;
}
}
1;
__END__
=head1 NAME
=encoding utf8
=head1 NAME
Lemonldap::NG::Common::PSGI::Router - Base library for REST APIs of Lemonldap::NG.
=head1 SYNOPSIS
......
......@@ -6,7 +6,7 @@ use bytes;
use strict;
use SOAP::Transport::HTTP;
our @ISA = ('SOAP::Transport::HTTP::Server');
use base 'SOAP::Transport::HTTP::Server';
our $VERSION = '2.1.0';
......
use strict;
use warnings;
use File::Spec;
use Test::More;
use English qw(-no_match_vars);
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Perl::Critic; };
if ($EVAL_ERROR) {
my $msg = 'Test::Perl::Critic required to criticise code';
plan( skip_all => $msg );
}
my $rcfile = File::Spec->catfile( '..', '.perlcriticrc' );
Test::Perl::Critic->import( -profile => $rcfile );
all_critic_ok();
......@@ -67,6 +67,7 @@ t/64-Lemonldap-NG-Handler-PSGI-DevOps.t
t/65-Lemonldap-NG-Handler-PSGI-ServiceToken.t
t/66-Lemonldap-NG-Handler-PSGI-wildcard.t
t/67-Lemonldap-NG-Handler-PSGI-vhostoptions.t
t/99-critic.t
t/99-pod.t
t/lmConf-1.json
t/sessions/lock/Apache-Session-f5eec18ebb9bc96352595e2d8ce962e8ecf7af7c9a98cb9a43f9cd181cf4b545.lock
......
use strict;
use warnings;
use File::Spec;
use Test::More;
use English qw(-no_match_vars);
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Perl::Critic; };
if ($EVAL_ERROR) {
my $msg = 'Test::Perl::Critic required to criticise code';
plan( skip_all => $msg );
}
my $rcfile = File::Spec->catfile( '..', '.perlcriticrc' );
Test::Perl::Critic->import( -profile => $rcfile );
all_critic_ok();
......@@ -216,6 +216,7 @@ t/70-viewer.t
t/71-viewer-with-no-diff.t
t/80-attributes.t
t/90-translations.t
t/99-critic.t
t/99-pod.t
t/conf/lmConf-1.json
t/jsonfiles/01-base-tree.json
......
use strict;
use warnings;
use File::Spec;
use Test::More;
use English qw(-no_match_vars);
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Perl::Critic; };
if ($EVAL_ERROR) {
my $msg = 'Test::Perl::Critic required to criticise code';
plan( skip_all => $msg );
}
my $rcfile = File::Spec->catfile( '..', '.perlcriticrc' );
Test::Perl::Critic->import( -profile => $rcfile );
all_critic_ok();
......@@ -428,6 +428,8 @@ t/30-Auth-and-issuer-SAML-POST-IdP-initiated.t
t/30-Auth-and-issuer-SAML-POST-Missing-SLO.t
t/30-Auth-and-issuer-SAML-POST.t
t/30-Auth-and-issuer-SAML-Redirect-IdP-initiated.t
t/30-Auth-and-issuer-SAML-Redirect-MultipleSP-Missing-SLO.t
t/30-Auth-and-issuer-SAML-Redirect-MultipleSP.t
t/30-Auth-and-issuer-SAML-Redirect.t
t/30-Auth-SAML-with-choice.t
t/30-CDC.t
......@@ -525,6 +527,7 @@ t/76-2F-Ext-with-GrantSession.t
t/76-2F-Ext-with-History.t
t/77-2F-Mail.t
t/90-Translations.t
t/99-critic.t
t/99-pod.t
t/gpghome/key.asc
t/gpghome/openpgp-revocs.d/9482CEFB055809CBAFE6D71AAB2D5542891D1677.rev
......
......@@ -84,7 +84,7 @@ sub resetPwd {
sub _reset {
my ( $self, $req ) = @_;
my ( $mailToken, $newPwd, $confirmPwd, %tplPrms );
my ( $mailToken, %tplPrms );
# PASSWORD CHANGE FORM => changePwd()
if (
......@@ -109,7 +109,7 @@ sub _reset {
# OTHER FORMS
if ($mailToken) {
$self->logger->debug( "Token given for password reset: " . $mailToken );
$self->logger->debug( "Token given for password reset: $mailToken" );
# Check if token is valid
my $mailSession = $self->p->getApacheSession($mailToken);
......@@ -166,7 +166,7 @@ sub _reset {
$self->setSecurity($req);
return PE_CAPTCHAERROR;
}
$self->logger->debug("Captcha code verified");
$self->logger->debug('Captcha code verified');
}
elsif ( $self->conf->{requireToken} ) {
unless ( $self->ott->getToken($token) ) {
......@@ -190,9 +190,9 @@ sub _reset {
);
if ( my $error = $self->p->process( $req, useMail => $searchByMail ) ) {
if ( $error == PE_USERNOTFOUND or $error == PE_BADCREDENTIALS ) {
$self->userLogger->warn( "Reset asked for an unvalid user ("
$self->userLogger->warn( 'Reset asked for an unvalid user ('
. $req->param('mail')
. ")" );
. ')' );
# To avoid mail enumeration, return OK
# unless portalErrorOnMailNotFound is set
......@@ -206,9 +206,9 @@ sub _reset {
$self->conf->{mailTimeout} || $self->conf->{timeout};
my $expTimestamp = time() + $mailTimeout;
$req->data->{expMailDate} =
strftime( "%d/%m/%Y", localtime $expTimestamp );
strftime( '%d/%m/%Y', localtime $expTimestamp );
$req->data->{expMailTime} =
strftime( "%H:%M", localtime $expTimestamp );
strftime( '%H:%M', localtime $expTimestamp );
return PE_MAILCONFIRMOK;
}
return $error;
......@@ -245,7 +245,7 @@ sub _reset {
$infos->{user} = $req->{user};
# Store type
$infos->{_type} = "mail";
$infos->{_type} = 'mail';
# Store pdata
$infos->{_pdata} = $req->pdata;
......@@ -270,22 +270,22 @@ sub _reset {
$self->logger->debug("Mail expiration timestamp: $expTimestamp");
$req->data->{expMailDate} =
strftime( "%d/%m/%Y", localtime $expTimestamp );
strftime( '%d/%m/%Y', localtime $expTimestamp );
$req->data->{expMailTime} =
strftime( "%H:%M", localtime $expTimestamp );
strftime( '%H:%M', localtime $expTimestamp );
# Mail session start date
my $startTimestamp = $mailSession->data->{mailSessionStartTimestamp};
$self->logger->debug("Mail start timestamp: $startTimestamp");
$req->data->{startMailDate} =
strftime( "%d/%m/%Y", localtime $startTimestamp );
strftime( '%d/%m/%Y', localtime $startTimestamp );
$req->data->{startMailTime} =
strftime( "%H:%M", localtime $startTimestamp );
strftime( '%H:%M', localtime $startTimestamp );
# Ask if user wants an another confirmation email
if ( $req->data->{mailAlreadySent}
and !$req->param('resendconfirmation') )
and not $req->param('resendconfirmation') )
{
$self->userLogger->notice(
'Reset mail already sent to ' . $req->{user} );
......@@ -405,13 +405,13 @@ sub changePwd {
# Check if user wants to generate the new password
if ( $req->param('reset') ) {
$self->logger->debug(
"Reset password request for " . $req->{sessionInfo}->{_user} );
"Reset password request for $req->{sessionInfo}->{_user}" );
# Generate a complex password
my $password =
$self->gen_password( $self->conf->{randomPasswordRegexp} );
$self->logger->debug( "Generated password: " . $password );
$self->logger->debug( "Generated password: $password" );
$req->data->{newpassword} = $password;
$req->data->{confirmpassword} = $password;
......@@ -490,7 +490,7 @@ sub changePwd {
unless $self->send_mail( $req->data->{mailAddress}, $subject, $body,
$html );
PE_MAILOK;
return PE_MAILOK;
}
sub setSecurity {
......@@ -501,6 +501,7 @@ sub setSecurity {
elsif ( $self->conf->{requireToken} ) {
$self->ott->setToken($req);
}
return 1;
}
sub display {
......@@ -522,7 +523,7 @@ sub display {
MAILALREADYSENT => $req->data->{mailAlreadySent},
MAIL => (
$self->p->checkXSSAttack( 'mail', $req->{user} )
? ""
? ''
: $req->{user}
),
DISPLAY_FORM => 0,
......@@ -532,7 +533,7 @@ sub display {
DISPLAY_PASSWORD_FORM => 0,
);
if ( $req->data->{mailToken}
and !$self->p->checkXSSAttack( 'mail_token', $req->data->{mailToken} ) )
and not $self->p->checkXSSAttack( 'mail_token', $req->data->{mailToken} ) )
{
$tplPrm{MAIL_TOKEN} = $req->data->{mailToken};
}
......@@ -554,7 +555,7 @@ sub display {
or $req->error == PE_CAPTCHAERROR
or $req->error == PE_CAPTCHAEMPTY
)
and !$req->data->{mailToken}
and not $req->data->{mailToken}
)
{
$self->logger->debug('Display form');
......
use strict;
use warnings;
use File::Spec;
use Test::More;
use English qw(-no_match_vars);
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Perl::Critic; };
if ($EVAL_ERROR) {
my $msg = 'Test::Perl::Critic required to criticise code';
plan( skip_all => $msg );
}
my $rcfile = File::Spec->catfile( '..', '.perlcriticrc' );
Test::Perl::Critic->import( -profile => $rcfile );
all_critic_ok();