make tidy with perltidy-20181120
This commit is contained in:
Xavier Guimard
parent
26c107cddb
commit
c1137edba8
5
Makefile
5
Makefile
|
|
@ -1115,7 +1115,10 @@ test-diff:
|
|||
done
|
||||
|
||||
tidy: clean
|
||||
find lemon*/ -type f \( -name '*.pm' -or -name '*.pl' -or -name '*.fcgi' -or -name '*.t' \) -print -exec perltidy -se -b {} \;
|
||||
@if perltidy -v|grep v20181120 >/dev/null; then \
|
||||
find lemon*/ -type f \( -name '*.pm' -or -name '*.pl' -or -name '*.fcgi' -or -name '*.t' \) -print -exec perltidy -se -b {} \; ; \
|
||||
else echo "Wrong perltidy version, please install Perl::Tidy@20181120" ; exit 1 ;\
|
||||
fi
|
||||
find lemon*/ -name '*.bak' -delete
|
||||
$(MAKE) json
|
||||
|
||||
|
|
|
|||
|
|
@ -133,7 +133,7 @@
|
|||
.\" ========================================================================
|
||||
.\"
|
||||
.IX Title "llng-fastcgi-server 1"
|
||||
.TH llng-fastcgi-server 1 "2019-06-27" "perl v5.28.1" "User Contributed Perl Documentation"
|
||||
.TH llng-fastcgi-server 1 "2019-07-02" "perl v5.28.1" "User Contributed Perl Documentation"
|
||||
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
|
||||
.\" way too many mistakes in technical documents.
|
||||
.if n .ad l
|
||||
|
|
|
|||
|
|
@ -341,7 +341,7 @@ sub _LDAPGKFAS {
|
|||
$args->{ldapAttributeContent} ||= 'description';
|
||||
|
||||
my $ldap = Apache::Session::Store::LDAP::ldap( { args => $args } );
|
||||
my $msg = $ldap->search(
|
||||
my $msg = $ldap->search(
|
||||
base => $args->{ldapConfBase},
|
||||
filter => '(objectClass=' . $args->{ldapObjectClass} . ')',
|
||||
attrs => [ $args->{ldapAttributeId}, $args->{ldapAttributeContent} ],
|
||||
|
|
|
|||
|
|
@ -104,7 +104,7 @@ sub ua {
|
|||
my $ua = Lemonldap::NG::Common::UserAgent->new(
|
||||
{ lwpOpts => $self->{lwpOpts}, lwpSslOpts => $self->{lwpSslOpts} } );
|
||||
if ( $self->{user} ) {
|
||||
my $url = $self->{baseUrl};
|
||||
my $url = $self->{baseUrl};
|
||||
my $port = ( $url =~ /^https/ ? 443 : 80 );
|
||||
$url =~ s#https?://([^/]*).*$#$1#;
|
||||
$port = $1 if ( $url =~ s/:(\d+)$// );
|
||||
|
|
|
|||
|
|
@ -169,7 +169,7 @@ sub findB {
|
|||
}
|
||||
if ( $c eq $char ) {
|
||||
my $rest = join( '', @chars );
|
||||
$res =~ s/^\s*(.*?)\s*/$1/;
|
||||
$res =~ s/^\s*(.*?)\s*/$1/;
|
||||
$rest =~ s/^\s*(.*?)\s*/$1/;
|
||||
return ( $res, $rest );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ BEGIN {
|
|||
# @return New Lemonldap::NG::Common::Conf object
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = bless {}, $class;
|
||||
my $self = bless {}, $class;
|
||||
if ( ref( $_[0] ) ) {
|
||||
%$self = %{ $_[0] };
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,10 +6,10 @@ use Mouse;
|
|||
|
||||
use Lemonldap::NG::Common::Conf;
|
||||
|
||||
has '_confAcc' => ( is => 'rw', isa => 'Lemonldap::NG::Common::Conf' );
|
||||
has '_confAcc' => ( is => 'rw', isa => 'Lemonldap::NG::Common::Conf' );
|
||||
has 'configStorage' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );
|
||||
has 'currentConf' => ( is => 'rw', required => 1, default => sub { {} } );
|
||||
has 'protection' => ( is => 'rw', isa => 'Str', default => 'manager' );
|
||||
has 'protection' => ( is => 'rw', isa => 'Str', default => 'manager' );
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ sub ua {
|
|||
return $self->{ua} if ( $self->{ua} );
|
||||
my $ua = Lemonldap::NG::Common::UserAgent->new();
|
||||
if ( $self->{user} ) {
|
||||
my $url = $self->{baseUrl};
|
||||
my $url = $self->{baseUrl};
|
||||
my $port = ( $url =~ /^https/ ? 443 : 80 );
|
||||
$url =~ s#https?://([^/]*).*$#$1#;
|
||||
$port = $1 if ( $url =~ s/:(\d+)$// );
|
||||
|
|
@ -79,7 +79,7 @@ sub available {
|
|||
|
||||
sub lastCfg {
|
||||
my $self = shift;
|
||||
my $res = $self->getJson('latest') or return;
|
||||
my $res = $self->getJson('latest') or return;
|
||||
return $res->{cfgNum};
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -662,7 +662,7 @@ sub _scanCatsAndApps {
|
|||
}
|
||||
else {
|
||||
$item->{title} = $apps->{$cat}->{options}->{name};
|
||||
$item->{type} = $apps->{$cat}->{type} = 'menuApp';
|
||||
$item->{type} = $apps->{$cat}->{type} = 'menuApp';
|
||||
foreach my $o (
|
||||
grep { not /^name$/ }
|
||||
keys %{ $apps->{$cat}->{options} }
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ sub serviceToXML {
|
|||
my ( $self, $conf, $type ) = @_;
|
||||
|
||||
seek DATA, $dataStart, 0;
|
||||
my $s = join '', <DATA>;
|
||||
my $s = join '', <DATA>;
|
||||
my $template = HTML::Template->new(
|
||||
scalarref => \$s,
|
||||
die_on_bad_params => 0,
|
||||
|
|
|
|||
|
|
@ -116,7 +116,7 @@ sub decrypt {
|
|||
$data =~ s/%0A/\n/ig;
|
||||
$data = decode_base64($data);
|
||||
my $iv;
|
||||
$iv = bytes::substr( $data, 0, IV_LENGTH );
|
||||
$iv = bytes::substr( $data, 0, IV_LENGTH );
|
||||
$data = bytes::substr( $data, IV_LENGTH );
|
||||
eval { $data = $self->_getCipher->set_iv($iv)->decrypt($data); };
|
||||
|
||||
|
|
@ -191,7 +191,7 @@ sub _cryptHex {
|
|||
}
|
||||
$data = pack "H*", $data;
|
||||
if ( $sub eq 'decrypt' ) {
|
||||
$iv = bytes::substr( $data, 0, IV_LENGTH );
|
||||
$iv = bytes::substr( $data, 0, IV_LENGTH );
|
||||
$data = bytes::substr( $data, IV_LENGTH );
|
||||
}
|
||||
eval { $data = $self->_getCipher($key)->set_iv($iv)->$sub($data); };
|
||||
|
|
@ -202,7 +202,7 @@ sub _cryptHex {
|
|||
if ( $sub eq 'encrypt' ) {
|
||||
$data = $iv . $data;
|
||||
}
|
||||
$msg = "";
|
||||
$msg = "";
|
||||
$data = unpack "H*", $data;
|
||||
return $data;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ our $VERSION = '2.0.5';
|
|||
sub new {
|
||||
no warnings 'redefine';
|
||||
my $level = $_[1]->{logLevel} || 'info';
|
||||
my $show = 1;
|
||||
my $show = 1;
|
||||
foreach (qw(error warn notice info debug)) {
|
||||
if ($show) {
|
||||
eval
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ our $VERSION = '2.0.5';
|
|||
sub new {
|
||||
my ( $class, $conf, %args ) = @_;
|
||||
my $level = $conf->{logLevel} || 'info';
|
||||
my $self = bless {}, $class;
|
||||
my $self = bless {}, $class;
|
||||
if ( $args{user} ) {
|
||||
$self->{facility} = $conf->{userSyslogFacility} || 'auth';
|
||||
}
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ has fileNameSeparator => ( is => 'rw', default => '_' );
|
|||
sub get {
|
||||
my ( $self, $uid, $ref ) = @_;
|
||||
return () unless ($uid);
|
||||
my $fns = $self->{fileNameSeparator};
|
||||
my $fns = $self->{fileNameSeparator};
|
||||
my $identifier = &getIdentifier( $self, $uid, $ref );
|
||||
|
||||
opendir D, $self->{dirName};
|
||||
|
|
|
|||
|
|
@ -208,7 +208,7 @@ sub getDone {
|
|||
$v = decodeLdapValue($v);
|
||||
$f->{$k} = $v;
|
||||
}
|
||||
my @t = split( /\D+/, $f->{done} );
|
||||
my @t = split( /\D+/, $f->{done} );
|
||||
my $done = timelocal( $t[5], $t[4], $t[3], $t[2], $t[1], $t[0] );
|
||||
$result->{"$f->{date}#$f->{uid}#$f->{ref}"} =
|
||||
{ notified => $done, uid => $f->{uid}, ref => $f->{ref}, };
|
||||
|
|
@ -252,7 +252,7 @@ sub _delete {
|
|||
my ( $self, $filter ) = @_;
|
||||
|
||||
my @entries = _search( $self, "$filter" );
|
||||
my $mesg = {};
|
||||
my $mesg = {};
|
||||
foreach my $entry (@entries) {
|
||||
$mesg = $self->{ldap}->delete( $entry->dn() );
|
||||
$mesg->code && return 0;
|
||||
|
|
|
|||
|
|
@ -51,7 +51,7 @@ sub newNotification {
|
|||
}
|
||||
|
||||
my $result = XML::LibXML::Document->new( $version, $encoding );
|
||||
my $root = XML::LibXML::Element->new('root');
|
||||
my $root = XML::LibXML::Element->new('root');
|
||||
$root->appendChild($notif);
|
||||
$result->setDocumentElement($root);
|
||||
$result = $result->serialize;
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@ sub userError {
|
|||
# Responses methods
|
||||
sub sendJSONresponse {
|
||||
my ( $self, $req, $j, %args ) = @_;
|
||||
$args{code} ||= 200;
|
||||
$args{code} ||= 200;
|
||||
$args{headers} ||= $req->respHeaders || [];
|
||||
my $type = 'application/json; charset=utf-8';
|
||||
if ( ref $j ) {
|
||||
|
|
@ -201,7 +201,7 @@ sub _mustBeDefined {
|
|||
my $name = ( caller(1) )[3];
|
||||
$name =~ s/^.*:://;
|
||||
my $call = ( caller(1) )[0];
|
||||
my $ref = ref( $_[0] ) || $call;
|
||||
my $ref = ref( $_[0] ) || $call;
|
||||
die "$name() method must be implemented (probably in $ref)";
|
||||
}
|
||||
|
||||
|
|
@ -238,7 +238,7 @@ sub sendHtml {
|
|||
my $sc = $req->script_name;
|
||||
$sc = '.' unless ($sc);
|
||||
$sc =~ s#/*$#/#;
|
||||
$args{code} ||= 200;
|
||||
$args{code} ||= 200;
|
||||
$args{headers} ||= $req->respHeaders || [];
|
||||
my $htpl;
|
||||
$template = ( $args{templateDir} // $self->templateDir ) . "/$template.tpl";
|
||||
|
|
|
|||
|
|
@ -93,7 +93,7 @@ sub BUILD {
|
|||
|
||||
# Register options for common Apache::Session module
|
||||
my $moduleOptions = $self->storageModuleOptions || {};
|
||||
my %options = (
|
||||
my %options = (
|
||||
%$moduleOptions,
|
||||
backend => $self->storageModule,
|
||||
localStorage => $self->cacheModule,
|
||||
|
|
@ -156,7 +156,7 @@ sub BUILD {
|
|||
}
|
||||
|
||||
sub _tie_session {
|
||||
my $self = $_[0];
|
||||
my $self = $_[0];
|
||||
my $options = $_[1] || {};
|
||||
|
||||
my %h;
|
||||
|
|
|
|||
|
|
@ -225,7 +225,7 @@ sub _session {
|
|||
|
||||
if ($skey) {
|
||||
if ( $skey =~ s/^\[(.*)\]$/$1/ ) {
|
||||
my @sk = split /,/, $skey;
|
||||
my @sk = split /,/, $skey;
|
||||
my $res = {};
|
||||
$res->{$_} = $session{$_} foreach (@sk);
|
||||
return $self->sendJSONresponse( $req, $res );
|
||||
|
|
|
|||
|
|
@ -22,16 +22,16 @@ BEGIN {
|
|||
*HTTP_URI = *Lemonldap::NG::Common::Regexp::HTTP_URI;
|
||||
*reDomainsToHost = *Lemonldap::NG::Common::Regexp::reDomainsToHost;
|
||||
|
||||
ok( 'test.ex.com' =~ HOST() );
|
||||
ok( 'test.ex.com' =~ HOSTNAME() );
|
||||
ok( 'test..ex.com' !~ HOST() );
|
||||
ok( 'test..ex.com' !~ HOSTNAME() );
|
||||
ok( '10.1.1.1' =~ HOST() );
|
||||
ok( '10.1.1.1' !~ HOSTNAME() );
|
||||
ok( 'test.ex.com' !~ HTTP_URI() );
|
||||
ok( 'https://test.ex.com' =~ HTTP_URI() );
|
||||
ok( 'https://test.ex.com/' =~ HTTP_URI() );
|
||||
ok( 'https://test.ex.com/a' =~ HTTP_URI() );
|
||||
ok( 'test.ex.com' =~ HOST() );
|
||||
ok( 'test.ex.com' =~ HOSTNAME() );
|
||||
ok( 'test..ex.com' !~ HOST() );
|
||||
ok( 'test..ex.com' !~ HOSTNAME() );
|
||||
ok( '10.1.1.1' =~ HOST() );
|
||||
ok( '10.1.1.1' !~ HOSTNAME() );
|
||||
ok( 'test.ex.com' !~ HTTP_URI() );
|
||||
ok( 'https://test.ex.com' =~ HTTP_URI() );
|
||||
ok( 'https://test.ex.com/' =~ HTTP_URI() );
|
||||
ok( 'https://test.ex.com/a' =~ HTTP_URI() );
|
||||
ok( 'https://test.ex.com/?<script>' !~ HTTP_URI() );
|
||||
|
||||
my $re;
|
||||
|
|
@ -39,6 +39,6 @@ ok( $re = reDomainsToHost('a.com b.org c.net') );
|
|||
ok( 'test.d.fr' !~ $re );
|
||||
|
||||
foreach (qw(a.com b.org c.net)) {
|
||||
ok( "test.$_" =~ $re );
|
||||
ok( "test.$_" =~ $re );
|
||||
ok( "test..$_" !~ $re );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ sub handler {
|
|||
$r ||= $class;
|
||||
my ( $uri, $args ) = ( $r->uri, $r->args );
|
||||
my $uri_full = $uri . ( $args ? "?$args" : '' );
|
||||
my $env = {
|
||||
my $env = {
|
||||
|
||||
#%ENV,
|
||||
HTTP_HOST => $r->hostname,
|
||||
|
|
|
|||
|
|
@ -186,7 +186,7 @@ sub addToHtmlHead {
|
|||
#unless ($ctx) {
|
||||
# $f->r->headers_out->unset('Content-Length');
|
||||
#}
|
||||
my $done = 0;
|
||||
my $done = 0;
|
||||
my $buffer = $ctx->{data} ? $ctx->{data} : '';
|
||||
my ( $bdata, $seen_eos ) = flatten_bb($bb);
|
||||
unless ($done) {
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ sub new {
|
|||
# here
|
||||
my ( $uri, $args ) = ( $r->uri, $r->args );
|
||||
my $uri_full = $uri . ( $args ? "?$args" : '' );
|
||||
my $env = {
|
||||
my $env = {
|
||||
|
||||
#%ENV,
|
||||
HTTP_HOST => $r->hostname,
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ sub run {
|
|||
return $class->FORBIDDEN;
|
||||
}
|
||||
|
||||
my $redirectUrl = $class->_buildUrl( $req, $uri );
|
||||
my $redirectUrl = $class->_buildUrl( $req, $uri );
|
||||
my $redirectHttps = ( $redirectUrl =~ m/^https/ );
|
||||
$class->set_header_out(
|
||||
$req,
|
||||
|
|
|
|||
|
|
@ -126,7 +126,7 @@ sub run {
|
|||
while ( my $opt = shift @ARGV ) {
|
||||
if ( $opt eq '--udp' ) {
|
||||
my $hp = shift @ARGV;
|
||||
my $s = IO::Socket::INET->new( Proto => 'udp', LocalAddr => $hp );
|
||||
my $s = IO::Socket::INET->new( Proto => 'udp', LocalAddr => $hp );
|
||||
$sel->add($s);
|
||||
}
|
||||
else {
|
||||
|
|
@ -138,7 +138,7 @@ sub run {
|
|||
if ( $fh == \*STDIN and $fh->eof ) {
|
||||
exit;
|
||||
}
|
||||
$_ = $fh->getline or next;
|
||||
$_ = $fh->getline or next;
|
||||
$mn = int( time / 60 ) - $start + 1;
|
||||
|
||||
# Cleaning activity array
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ sub onReload {
|
|||
sub checkConf {
|
||||
my ( $class, $force ) = @_;
|
||||
$class->logger->debug("Check configuration for $class");
|
||||
my $prm = { local => !$force, localPrm => $class->localConfig };
|
||||
my $prm = { local => !$force, localPrm => $class->localConfig };
|
||||
my $conf = $class->confAcc->getConf($prm);
|
||||
chomp $Lemonldap::NG::Common::Conf::msg;
|
||||
|
||||
|
|
@ -302,7 +302,7 @@ sub locationRulesInit {
|
|||
|
||||
# Default policy set to 'accept'
|
||||
unless ( $class->tsv->{defaultCondition}->{$vhost} ) {
|
||||
$class->tsv->{defaultCondition}->{$vhost} = sub { 1 };
|
||||
$class->tsv->{defaultCondition}->{$vhost} = sub { 1 };
|
||||
$class->tsv->{defaultProtection}->{$vhost} = 0;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ sub init {
|
|||
open F, ">$file"
|
||||
or die $!;
|
||||
my $now = time;
|
||||
my $ts = strftime "%Y%m%d%H%M%S", localtime;
|
||||
my $ts = strftime "%Y%m%d%H%M%S", localtime;
|
||||
|
||||
print F '{"_updateTime":"'
|
||||
. $ts
|
||||
|
|
|
|||
|
|
@ -137,7 +137,7 @@ qr/^(?:(?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-
|
|||
eval {
|
||||
do {
|
||||
qr/$_[0]/;
|
||||
}
|
||||
}
|
||||
};
|
||||
return $@ ? ( 0, "__badRegexp__: $@" ) : 1;
|
||||
}
|
||||
|
|
@ -218,8 +218,7 @@ m[^(?:(?:\-+\s*BEGIN\s+(?:PUBLIC\s+KEY|CERTIFICATE)\s*\-+\r?\n)?[a-zA-Z0-9/\+\r\
|
|||
},
|
||||
'select' => {
|
||||
'test' => sub {
|
||||
my $test =
|
||||
grep( { $_ eq $_[0]; }
|
||||
my $test = grep( { $_ eq $_[0]; }
|
||||
map( { $_->{'k'}; } @{ $_[2]{'select'}; } ) );
|
||||
return $test
|
||||
? 1
|
||||
|
|
@ -1582,7 +1581,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
|
|||
eval {
|
||||
do {
|
||||
qr/$_[0]/;
|
||||
}
|
||||
}
|
||||
};
|
||||
return $@ ? 0 : 1;
|
||||
},
|
||||
|
|
|
|||
|
|
@ -441,7 +441,7 @@ sub scanTree {
|
|||
die 'Not an array';
|
||||
}
|
||||
$prefix //= '';
|
||||
my $ord = -1;
|
||||
my $ord = -1;
|
||||
my $nodeName = $path ? '_nodes' : 'data';
|
||||
foreach my $leaf (@$tree) {
|
||||
$ord++;
|
||||
|
|
@ -498,7 +498,7 @@ sub scanTree {
|
|||
}
|
||||
}
|
||||
}
|
||||
$jleaf->{help} = $leaf->{help} if ( $leaf->{help} );
|
||||
$jleaf->{help} = $leaf->{help} if ( $leaf->{help} );
|
||||
$jleaf->{_nodes_filter} = $leaf->{nodes_filter}
|
||||
if ( $leaf->{nodes_filter} );
|
||||
push @$json, $jleaf;
|
||||
|
|
|
|||
|
|
@ -1148,6 +1148,7 @@ sub attributes {
|
|||
type => 'bool',
|
||||
documentation => 'Enabled persistent storage',
|
||||
},
|
||||
|
||||
# SAML issuer
|
||||
issuerDBSAMLActivation => {
|
||||
default => 0,
|
||||
|
|
|
|||
|
|
@ -672,6 +672,7 @@ sub tree {
|
|||
'contextSwitchingRule',
|
||||
'contextSwitchingIdRule',
|
||||
'contextSwitchingStopWithLogout',
|
||||
|
||||
#'contextSwitchingHiddenAttributes',
|
||||
]
|
||||
},
|
||||
|
|
@ -945,7 +946,8 @@ sub tree {
|
|||
help => 'samlservice.html#organization',
|
||||
form => 'simpleInputContainer',
|
||||
nodes => [
|
||||
'samlOrganizationDisplayName', 'samlOrganizationName',
|
||||
'samlOrganizationDisplayName',
|
||||
'samlOrganizationName',
|
||||
'samlOrganizationURL'
|
||||
]
|
||||
},
|
||||
|
|
|
|||
|
|
@ -341,7 +341,7 @@ sub newRawConf {
|
|||
$self->userLogger->notice(
|
||||
'Raw saving attempt rejected, asking for confirmation to '
|
||||
. $self->userId($req) );
|
||||
$res->{result} = 0;
|
||||
$res->{result} = 0;
|
||||
$res->{needConfirm} = 1 if ( $s == CONFIG_WAS_CHANGED );
|
||||
$res->{message} .= '__needConfirmation__';
|
||||
}
|
||||
|
|
|
|||
|
|
@ -160,7 +160,7 @@ sub _scanNodes {
|
|||
hdebug("Looking to $name");
|
||||
|
||||
# subnode
|
||||
my $subNodes = $leaf->{nodes} // $leaf->{_nodes};
|
||||
my $subNodes = $leaf->{nodes} // $leaf->{_nodes};
|
||||
my $subNodesCond = $leaf->{nodes_cond} // $leaf->{_nodes_cond};
|
||||
|
||||
##################################
|
||||
|
|
@ -564,7 +564,7 @@ sub _scanNodes {
|
|||
hdebug('Application list subnode');
|
||||
use feature 'state';
|
||||
my @cats = split /\//, $1;
|
||||
my $app = pop @cats;
|
||||
my $app = pop @cats;
|
||||
$self->newConf->{applicationList} //= {};
|
||||
|
||||
# $cn is a pointer to the parent
|
||||
|
|
@ -872,7 +872,7 @@ sub _scanNodes {
|
|||
}
|
||||
else {
|
||||
@oldHosts = grep { $_ ne $host } @oldHosts;
|
||||
@oldKeys = keys %{ $self->refConf->{$name}->{$host} };
|
||||
@oldKeys = keys %{ $self->refConf->{$name}->{$host} };
|
||||
}
|
||||
foreach my $prm ( @{ $getHost->{h} } ) {
|
||||
$self->newConf->{$name}->{$host}->{ $prm->{k} } =
|
||||
|
|
@ -1101,14 +1101,14 @@ sub _unitTest {
|
|||
or $attr->{type} =~ /Container$/ )
|
||||
{
|
||||
my $keyMsg = $attr->{keyMsgFail} // $type->{keyMsgFail};
|
||||
my $msg = $attr->{msgFail} // $type->{msgFail};
|
||||
my $msg = $attr->{msgFail} // $type->{msgFail};
|
||||
$res = 0
|
||||
unless (
|
||||
$self->_execTest( {
|
||||
keyTest => $attr->{keyTest} // $type->{keyTest},
|
||||
keyMsgFail => $attr->{keyMsgFail}
|
||||
// $type->{keyMsgFail},
|
||||
test => $attr->{test} // $type->{test},
|
||||
test => $attr->{test} // $type->{test},
|
||||
msgFail => $attr->{msgFail} // $type->{msgFail},
|
||||
},
|
||||
$conf->{$key},
|
||||
|
|
|
|||
|
|
@ -646,14 +646,16 @@ sub tests {
|
|||
# Warn if Impersonation and ContextSwitching are simultaneously enabled
|
||||
impersonation => sub {
|
||||
return ( 1,
|
||||
"Impersonation and ContextSwitching are simultaneously enabled" )
|
||||
if ( $conf->{impersonationRule} && $conf->{contextSwitchingRule} );
|
||||
"Impersonation and ContextSwitching are simultaneously enabled"
|
||||
)
|
||||
if ( $conf->{impersonationRule}
|
||||
&& $conf->{contextSwitchingRule} );
|
||||
|
||||
# Return
|
||||
return 1;
|
||||
},
|
||||
|
||||
# Warn if persistent storage is disabled with 2FA, History, OIDCConsents and Notifications
|
||||
# Warn if persistent storage is disabled with 2FA, History, OIDCConsents and Notifications
|
||||
persistentStorage => sub {
|
||||
return 1 unless ( $conf->{disablePersistentStorage} );
|
||||
return ( 1, "2FA enabled WITHOUT persistent session storage" )
|
||||
|
|
|
|||
|
|
@ -345,7 +345,7 @@ qq{Use of an uninitialized attribute "$group" to group sessions},
|
|||
# { uid => 'foo.bar', session => <sessionId> }
|
||||
elsif ( my $f = $req->params('orderBy') ) {
|
||||
my @fields = split /,/, $f;
|
||||
my @r = map {
|
||||
my @r = map {
|
||||
my $tmp = { session => $_ };
|
||||
foreach my $f (@fields) {
|
||||
my $s = $f;
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ my %hdrs = @{ $res->[1] };
|
|||
ok( $res->[0] == 200, 'Return a 200 code' )
|
||||
or print STDERR "Received" . Dumper($res);
|
||||
ok( $hdrs{'Content-Type'} =~ /text\/html$/i, 'Content is declared as HTML' );
|
||||
ok( $res->[2]->[0] =~ /<html/si, 'It contains a html tag' );
|
||||
ok( $res->[2]->[0] =~ /<html/si, 'It contains a html tag' );
|
||||
|
||||
count(4);
|
||||
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@ done_testing($count);
|
|||
|
||||
sub getTypes {
|
||||
my @trees = @_;
|
||||
my $res = { 'text' => 1 };
|
||||
my $res = { 'text' => 1 };
|
||||
foreach my $t (@trees) {
|
||||
if ( ref($t) eq 'HASH' ) {
|
||||
foreach my $a ( values %$t ) {
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ require 't/test-lib.pm';
|
|||
|
||||
my @struct =
|
||||
qw[t/jsonfiles/01-base-tree.json t/jsonfiles/02-base-tree-all-nodes-opened.json];
|
||||
my @desc = ( 'Unopened conf', 'Unchanged conf with all nodes opened' );
|
||||
my @desc = ( 'Unopened conf', 'Unchanged conf with all nodes opened' );
|
||||
my $confFiles = [ 't/conf/lmConf-1.json', 't/conf/lmConf-2.json' ];
|
||||
|
||||
sub body {
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ use strict;
|
|||
use JSON;
|
||||
require 't/test-lib.pm';
|
||||
|
||||
my $struct = 't/jsonfiles/11-modified-with-confirmation.json';
|
||||
my $struct = 't/jsonfiles/11-modified-with-confirmation.json';
|
||||
my $confFiles = [ 't/conf/lmConf-1.json', 't/conf/lmConf-2.json' ];
|
||||
|
||||
sub body {
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ use strict;
|
|||
use JSON;
|
||||
require 't/test-lib.pm';
|
||||
|
||||
my $struct = 't/jsonfiles/12-modified.json';
|
||||
my $struct = 't/jsonfiles/12-modified.json';
|
||||
my $confFiles = [ 't/conf/lmConf-1.json', 't/conf/lmConf-2.json' ];
|
||||
|
||||
sub body {
|
||||
|
|
|
|||
|
|
@ -152,7 +152,7 @@ sub init {
|
|||
sub run {
|
||||
my ( $self, $req ) = @_;
|
||||
my $checkLogins = $req->param('checkLogins');
|
||||
my $spoofId = $req->param('spoofId') || '';
|
||||
my $spoofId = $req->param('spoofId') || '';
|
||||
$self->logger->debug("2F checkLogins set") if ($checkLogins);
|
||||
|
||||
# Skip 2F unless a module has been registered
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ has adPwdMaxAge => (
|
|||
lazy => 1,
|
||||
builder => sub {
|
||||
my $conf = $_[0]->{conf};
|
||||
my $res = $conf->{ADPwdMaxAge} || 0;
|
||||
my $res = $conf->{ADPwdMaxAge} || 0;
|
||||
return $res * 10000000; # padding with '0' to obtain 0.1 micro-seconds
|
||||
}
|
||||
);
|
||||
|
|
@ -29,7 +29,7 @@ has adPwdExpireWarning => (
|
|||
lazy => 1,
|
||||
builder => sub {
|
||||
my $conf = $_[0]->{conf};
|
||||
my $res = $conf->{ADPwdExpireWarning} || 0;
|
||||
my $res = $conf->{ADPwdExpireWarning} || 0;
|
||||
return $res * 10000000; # padding with '0' to obtain 0.1 micro-seconds
|
||||
}
|
||||
);
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ extends 'Lemonldap::NG::Portal::Main::Auth', 'Lemonldap::NG::Portal::Lib::CAS';
|
|||
# PROPERTIES
|
||||
|
||||
has srvNumber => ( is => 'rw', default => 0 );
|
||||
has srvList => ( is => 'rw', default => sub { [] } );
|
||||
has srvList => ( is => 'rw', default => sub { [] } );
|
||||
use constant sessionKind => 'CAS';
|
||||
|
||||
# INITIALIZATION
|
||||
|
|
@ -224,7 +224,7 @@ sub extractFormInfo {
|
|||
# Get a proxy ticket for each proxied service
|
||||
foreach ( keys %$proxied ) {
|
||||
my $service = $proxied->{$_};
|
||||
my $pt = $self->retrievePT( $service, $pgtId, $srvConf );
|
||||
my $pt = $self->retrievePT( $service, $pgtId, $srvConf );
|
||||
|
||||
unless ($pt) {
|
||||
$self->logger->error(
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ our $VERSION = '2.0.3';
|
|||
|
||||
extends 'Lemonldap::NG::Portal::Auth::_WebForm';
|
||||
|
||||
has db => ( is => 'rw' );
|
||||
has db => ( is => 'rw' );
|
||||
has tmp => (
|
||||
is => 'rw',
|
||||
default => sub {
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ sub authenticate {
|
|||
|
||||
sub setAuthSessionInfo {
|
||||
my ( $self, $req ) = @_;
|
||||
$req->{sessionInfo}->{'_user'} = 'anonymous';
|
||||
$req->{sessionInfo}->{'_user'} = 'anonymous';
|
||||
$req->{sessionInfo}->{authenticationLevel} = $self->conf->{nullAuthnLevel};
|
||||
PE_OK;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1526,7 +1526,7 @@ sub getIDP {
|
|||
else {
|
||||
foreach ( keys %{ $self->idpList } ) {
|
||||
my $idpConfKey = $self->idpList->{$_}->{confKey};
|
||||
my $cond = $self->idpRules->{$idpConfKey} or next;
|
||||
my $cond = $self->idpRules->{$idpConfKey} or next;
|
||||
if ( $cond->( $req, $req->sessionInfo ) ) {
|
||||
$self->logger->debug(
|
||||
"IDP $idpConfKey resolution rule match");
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ sub init {
|
|||
return 0;
|
||||
}
|
||||
my $lconf = $tmp->getLocalConf('portal') // {};
|
||||
my $conf = $tmp->getConf();
|
||||
my $conf = $tmp->getConf();
|
||||
unless ( ref($conf) ) {
|
||||
$self->error(
|
||||
"Unable to load configuration: $Lemonldap::NG::Common::Conf::msg");
|
||||
|
|
@ -69,7 +69,7 @@ sub handler {
|
|||
|
||||
# Request parameter
|
||||
my $action = $req->param('action') || ""; # What we do
|
||||
my $idp = $req->param('idp'); # IDP ID in write mode
|
||||
my $idp = $req->param('idp'); # IDP ID in write mode
|
||||
|
||||
# TODO: Control URL
|
||||
#my $control_url = $self->_sub('controlUrlOrigin');
|
||||
|
|
|
|||
|
|
@ -212,7 +212,7 @@ sub run {
|
|||
|
||||
# Check last authentication time to decide if
|
||||
# the authentication is recent or not
|
||||
my $casRenewFlag = 0;
|
||||
my $casRenewFlag = 0;
|
||||
my $last_authn_utime = $req->{sessionInfo}->{_lastAuthnUTime} || 0;
|
||||
if (
|
||||
time() - $last_authn_utime <
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ sub beforeAuth { 'exportRequestParameters' }
|
|||
|
||||
use constant sessionKind => 'OIDCI';
|
||||
|
||||
has rule => ( is => 'rw' );
|
||||
has rule => ( is => 'rw' );
|
||||
has configStorage => (
|
||||
is => 'ro',
|
||||
lazy => 1,
|
||||
|
|
@ -710,7 +710,7 @@ sub run {
|
|||
};
|
||||
|
||||
$id_token_payload_hash->{'at_hash'} = $at_hash if $at_hash;
|
||||
$id_token_payload_hash->{'acr'} = $id_token_acr
|
||||
$id_token_payload_hash->{'acr'} = $id_token_acr
|
||||
if $id_token_acr;
|
||||
|
||||
# Create ID Token
|
||||
|
|
@ -1117,7 +1117,7 @@ sub token {
|
|||
};
|
||||
|
||||
my $nonce = $codeSession->data->{nonce};
|
||||
$id_token_payload_hash->{nonce} = $nonce if defined $nonce;
|
||||
$id_token_payload_hash->{nonce} = $nonce if defined $nonce;
|
||||
$id_token_payload_hash->{'at_hash'} = $at_hash if $at_hash;
|
||||
|
||||
# Create ID Token
|
||||
|
|
|
|||
|
|
@ -1694,7 +1694,7 @@ sub sloServer {
|
|||
|
||||
# Create SLO status session and get ID
|
||||
my $sloStatusSessionInfo = $self->getSamlSession( undef, $sloInfos );
|
||||
my $relayID = $sloStatusSessionInfo->id;
|
||||
my $relayID = $sloStatusSessionInfo->id;
|
||||
|
||||
$self->logger->debug("Create relay session $relayID");
|
||||
|
||||
|
|
|
|||
|
|
@ -255,7 +255,7 @@ sub getNotifBack {
|
|||
}
|
||||
|
||||
has imported => ( is => 'rw', default => 0 );
|
||||
has server => ( is => 'rw' );
|
||||
has server => ( is => 'rw' );
|
||||
|
||||
sub notificationServer {
|
||||
my ( $self, $req ) = @_;
|
||||
|
|
|
|||
|
|
@ -447,7 +447,7 @@ sub checkMessage {
|
|||
$self->logger->debug("HTTP-REDIRECT: SAML Artifact $artifact");
|
||||
|
||||
# Resolve Artifact
|
||||
$method = Lasso::Constants::HTTP_METHOD_ARTIFACT_GET;
|
||||
$method = Lasso::Constants::HTTP_METHOD_ARTIFACT_GET;
|
||||
$message = $self->resolveArtifact( $profile, $artifact, $method );
|
||||
|
||||
# Request or response ?
|
||||
|
|
@ -2351,7 +2351,7 @@ sub getAuthnContext {
|
|||
sub timestamp2samldate {
|
||||
my ( $self, $timestamp ) = @_;
|
||||
|
||||
my @t = gmtime($timestamp);
|
||||
my @t = gmtime($timestamp);
|
||||
my $samldate = strftime( "%Y-%m-%dT%TZ", @t );
|
||||
|
||||
$self->logger->debug(
|
||||
|
|
@ -2872,7 +2872,7 @@ sub createAttribute {
|
|||
|
||||
# Default values
|
||||
$friendly_name ||= $name;
|
||||
$format ||= Lasso::Constants::SAML2_ATTRIBUTE_NAME_FORMAT_BASIC;
|
||||
$format ||= Lasso::Constants::SAML2_ATTRIBUTE_NAME_FORMAT_BASIC;
|
||||
|
||||
# Set attribute properties
|
||||
$attribute->Name($name);
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@ sub translate {
|
|||
|
||||
# Get language using llnglanguage cookie
|
||||
my $lang_code = $req->cookies->{llnglanguage} || 'en';
|
||||
my $json = $self->conf->{templateDir} . "/common/mail/$lang_code.json";
|
||||
my $json = $self->conf->{templateDir} . "/common/mail/$lang_code.json";
|
||||
$json = $self->conf->{templateDir} . '/common/mail/en.json'
|
||||
unless ( -f $json );
|
||||
open F, $json
|
||||
|
|
|
|||
|
|
@ -275,7 +275,7 @@ sub display {
|
|||
else {
|
||||
$skinfile = 'login';
|
||||
my $login = $self->userId($req);
|
||||
$login = '' if ( $login eq 'anonymous' );
|
||||
$login = '' if ( $login eq 'anonymous' );
|
||||
%templateParams = (
|
||||
MAIN_LOGO => $self->conf->{portalMainLogo},
|
||||
LANGS => $self->conf->{showLanguages},
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ has _groups => ( is => 'rw' );
|
|||
has _jsRedirect => ( is => 'rw' );
|
||||
|
||||
# TrustedDomain regexp
|
||||
has trustedDomainsRe => ( is => 'rw' );
|
||||
has trustedDomainsRe => ( is => 'rw' );
|
||||
has additionalTrustedDomains => ( is => 'rw', default => sub { [] } );
|
||||
|
||||
# Lists to store plugins entry-points
|
||||
|
|
@ -201,7 +201,7 @@ sub reloadConf {
|
|||
my $header = $_;
|
||||
my $prm = $self->conf->{ 'cors' . $_ };
|
||||
$header =~ s/_/-/;
|
||||
$prm =~ s/\s+//;
|
||||
$prm =~ s/\s+//;
|
||||
$cors .= "Access-Control-$header;$prm;";
|
||||
}
|
||||
$self->cors($cors);
|
||||
|
|
@ -434,7 +434,7 @@ sub findEP {
|
|||
}
|
||||
else {
|
||||
foreach my $ep ( keys %$h ) {
|
||||
my $callback = $h->{$ep};
|
||||
my $callback = $h->{$ep};
|
||||
my $previousSub = $self->aroundSub->{$ep} ||= sub {
|
||||
$self->logger->debug(
|
||||
"$ep launched inside ${plugin}::$callback");
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@ sub params {
|
|||
$self->{conf}->{imgPath} ||= $self->{staticPrefix};
|
||||
my %res;
|
||||
my @defaultTabs = (qw/appslist password logout loginHistory oidcConsents/);
|
||||
my @customTabs = split( /,\s*/, $self->{conf}->{customMenuTabs} || '' );
|
||||
my @customTabs = split( /,\s*/, $self->{conf}->{customMenuTabs} || '' );
|
||||
|
||||
# Tab to display
|
||||
# Get the tab URL parameter
|
||||
|
|
@ -178,7 +178,7 @@ sub appslist {
|
|||
my $catlevel = 0;
|
||||
|
||||
my $applicationList = clone( $self->conf->{applicationList} );
|
||||
my $filteredList = $self->_filter( $req, $applicationList );
|
||||
my $filteredList = $self->_filter( $req, $applicationList );
|
||||
push @$appslist,
|
||||
$self->_buildCategoryHash( $req, "", $filteredList, $catlevel );
|
||||
|
||||
|
|
|
|||
|
|
@ -48,13 +48,13 @@ sub _addRoute {
|
|||
return sub {
|
||||
shift;
|
||||
return $sub->( $self, @_ );
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
return sub {
|
||||
shift;
|
||||
return $self->$sub(@_);
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
$self->p->$type( $word, $subName, $methods, $transform );
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@ has token => ( is => 'rw' );
|
|||
|
||||
# Error type
|
||||
sub error_type {
|
||||
my $req = shift;
|
||||
my $req = shift;
|
||||
my $code = shift || $req->error;
|
||||
|
||||
# Positive errors
|
||||
|
|
|
|||
|
|
@ -451,7 +451,10 @@ sub updatePersistentSession {
|
|||
my ( $self, $req, $infos, $uid, $id ) = @_;
|
||||
|
||||
# Return if no infos to update
|
||||
return () unless ( ref $infos eq 'HASH' and %$infos and !$self->conf->{disablePersistentStorage} );
|
||||
return ()
|
||||
unless ( ref $infos eq 'HASH'
|
||||
and %$infos
|
||||
and !$self->conf->{disablePersistentStorage} );
|
||||
|
||||
$uid ||= $req->{sessionInfo}->{ $self->conf->{whatToTrace} }
|
||||
|| $req->userData->{ $self->conf->{whatToTrace} };
|
||||
|
|
|
|||
|
|
@ -416,7 +416,7 @@ sub _splitAttributes {
|
|||
if ( $element->{key} eq 'groups' ) {
|
||||
$self->logger->debug('Key "groups" found');
|
||||
my $separator = $self->{conf}->{multiValuesSeparator};
|
||||
my @tmp = split /\Q$separator/, $element->{value};
|
||||
my @tmp = split /\Q$separator/, $element->{value};
|
||||
$grps = [ map { { value => $_ } } sort @tmp ];
|
||||
next;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -108,7 +108,7 @@ sub display {
|
|||
|
||||
sub run {
|
||||
my ( $self, $req ) = @_;
|
||||
my $statut = PE_OK;
|
||||
my $statut = PE_OK;
|
||||
my $spoofId = $req->param('spoofId') || ''; # ContextSwitching required ?
|
||||
|
||||
# Check activation rule
|
||||
|
|
|
|||
|
|
@ -455,7 +455,7 @@ sub display {
|
|||
|
||||
# Display captcha if it's enabled
|
||||
if ( $req->captcha ) {
|
||||
$templateParams{CAPTCHA_SRC} = $req->captcha;
|
||||
$templateParams{CAPTCHA_SRC} = $req->captcha;
|
||||
$templateParams{CAPTCHA_SIZE} = $self->conf->{captcha_size} || 6;
|
||||
}
|
||||
if ( $req->token ) {
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@ SKIP: {
|
|||
# -------------------
|
||||
ok( $res = $client->_get( '/', accept => 'text/html' ), 'Get menu' );
|
||||
my @form = ( $res->[2]->[0] =~ m#<form.*?</form>#sg );
|
||||
ok( @form == 3, 'Display 3 choices' ) or explain(scalar(@form),3);
|
||||
ok( @form == 3, 'Display 3 choices' ) or explain( scalar(@form), 3 );
|
||||
foreach (@form) {
|
||||
expectForm( [ $res->[0], $res->[1], [$_] ], undef, undef, 'test' );
|
||||
}
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ LWP::Protocol::PSGI->register(
|
|||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $res;
|
||||
my $s = $req->content;
|
||||
my $s = $req->content;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ LWP::Protocol::PSGI->register(
|
|||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $res;
|
||||
my $s = $req->content;
|
||||
my $s = $req->content;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
|
|
|
|||
|
|
@ -133,7 +133,7 @@ SKIP: {
|
|||
'Re auth'
|
||||
);
|
||||
$pdata = 'lemonldappdata=' . expectCookie( $res, 'lemonldappdata' );
|
||||
$tmp = expectCookie($res);
|
||||
$tmp = expectCookie($res);
|
||||
ok( $tmp ne $idpId, 'Get a new session' );
|
||||
$idpId = $tmp;
|
||||
( $url, $query ) = expectRedirection( $res,
|
||||
|
|
|
|||
|
|
@ -121,7 +121,7 @@ SKIP: {
|
|||
'Re auth'
|
||||
);
|
||||
$pdata = 'lemonldappdata=' . expectCookie( $res, 'lemonldappdata' );
|
||||
$tmp = expectCookie($res);
|
||||
$tmp = expectCookie($res);
|
||||
ok( $tmp ne $idpId, 'Get a new session' );
|
||||
$idpId = $tmp;
|
||||
( $url, $query ) = expectRedirection( $res,
|
||||
|
|
|
|||
|
|
@ -214,8 +214,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -313,8 +312,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -311,8 +311,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -409,8 +408,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -254,8 +254,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -363,8 +362,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -311,8 +311,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -409,8 +408,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -311,8 +311,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -409,8 +408,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -221,8 +221,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -317,8 +316,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -204,8 +204,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -299,8 +298,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -118,8 +118,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -213,8 +212,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -93,8 +93,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub issuer {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
|
|||
|
|
@ -129,8 +129,7 @@ sub switch {
|
|||
}
|
||||
|
||||
sub op {
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'idp.com',
|
||||
|
|
@ -226,8 +225,7 @@ GQIDAQAB
|
|||
|
||||
sub rp {
|
||||
my ( $jwks, $metadata ) = @_;
|
||||
return LLNG::Manager::Test->new(
|
||||
{
|
||||
return LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => $debug,
|
||||
domain => 'rp.com',
|
||||
|
|
|
|||
|
|
@ -195,11 +195,18 @@ if ( ok( ref($res) eq 'HASH', ' Result is an hash' ) ) {
|
|||
}
|
||||
count(3);
|
||||
|
||||
ok($res=Lemonldap::NG::Common::Apache::Session::REST->get_key_from_all_sessions( {baseUrl => 'http://auth.idp.com/sessions/global/'},sub{return 'a'}),'Search all sessions with a code');
|
||||
ok(
|
||||
$res =
|
||||
Lemonldap::NG::Common::Apache::Session::REST->get_key_from_all_sessions(
|
||||
{ baseUrl => 'http://auth.idp.com/sessions/global/' },
|
||||
sub { return 'a' }
|
||||
),
|
||||
'Search all sessions with a code'
|
||||
);
|
||||
|
||||
if ( ok( ref($res) eq 'HASH', ' Result is an hash' ) ) {
|
||||
my $tmp = 1;
|
||||
my $c = 0;
|
||||
my $c = 0;
|
||||
foreach ( keys %$res ) {
|
||||
$c++;
|
||||
unless ( $res->{$_} eq 'a' ) {
|
||||
|
|
@ -207,7 +214,7 @@ if ( ok( ref($res) eq 'HASH', ' Result is an hash' ) ) {
|
|||
diag "Bad session:\n" . Dumper( $res->{$_} );
|
||||
}
|
||||
}
|
||||
ok( $c == $c1, " Found the same count") or explain($c,$c1);
|
||||
ok( $c == $c1, " Found the same count" ) or explain( $c, $c1 );
|
||||
ok( $tmp, ' All sessions are valid' );
|
||||
count(2);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ LWP::Protocol::PSGI->register(
|
|||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $res;
|
||||
my $s = $req->content;
|
||||
my $s = $req->content;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
switch ( $host eq 'idp' ? 'issuer' : 'sp' );
|
||||
ok(
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ LWP::Protocol::PSGI->register(
|
|||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $res;
|
||||
my $s = $req->content;
|
||||
my $s = $req->content;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ LWP::Protocol::PSGI->register(
|
|||
my $host = $1;
|
||||
my $url = $2;
|
||||
my $res;
|
||||
my $s = $req->content;
|
||||
my $s = $req->content;
|
||||
my $client = ( $host eq 'idp' ? $issuer : $sp );
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
|
|
|
|||
|
|
@ -18,12 +18,12 @@ SKIP: {
|
|||
|
||||
my $client = LLNG::Manager::Test->new( {
|
||||
ini => {
|
||||
logLevel => 'error',
|
||||
totp2fSelfRegistration => 1,
|
||||
totp2fActivation => 1,
|
||||
totp2fDigits => 8,
|
||||
totp2fTTL => -1,
|
||||
loginHistoryEnabled => 1,
|
||||
logLevel => 'error',
|
||||
totp2fSelfRegistration => 1,
|
||||
totp2fActivation => 1,
|
||||
totp2fDigits => 8,
|
||||
totp2fTTL => -1,
|
||||
loginHistoryEnabled => 1,
|
||||
disablePersistentStorage => 1,
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ my $mailSend = 0;
|
|||
|
||||
SKIP: {
|
||||
eval
|
||||
'require Email::Sender::Simple;use GD::SecurityImage;use Image::Magick;use Text::Unidecode';
|
||||
'require Email::Sender::Simple;use GD::SecurityImage;use Image::Magick;use Text::Unidecode';
|
||||
if ($@) {
|
||||
skip 'Missing dependencies', $maintests;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -103,7 +103,7 @@ ok(
|
|||
count(1);
|
||||
|
||||
$pdata = expectCookie( $res, 'lemonldappdata' );
|
||||
$id = expectCookie($res);
|
||||
$id = expectCookie($res);
|
||||
|
||||
expectRedirection( $res, 'http://test1.example.com' );
|
||||
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@ my $client = LLNG::Manager::Test->new( {
|
|||
);
|
||||
|
||||
##
|
||||
## Try to authenticate
|
||||
## Try to authenticate
|
||||
ok(
|
||||
$res = $client->_post(
|
||||
'/',
|
||||
|
|
@ -57,13 +57,16 @@ ok(
|
|||
);
|
||||
count(1);
|
||||
expectOK($res);
|
||||
ok( $res->[2]->[0] =~ m%<span trspan="connectedAs">Connected as</span> rtyler%,
|
||||
'Connected as rtyler' )
|
||||
or print STDERR Dumper( $res->[2]->[0] );
|
||||
ok(
|
||||
$res->[2]->[0] =~ m%<span trspan="connectedAs">Connected as</span> rtyler%,
|
||||
'Connected as rtyler'
|
||||
) or print STDERR Dumper( $res->[2]->[0] );
|
||||
expectAuthenticatedAs( $res, 'rtyler' );
|
||||
ok( $res->[2]->[0] =~ m%<span trspan="contextSwitching_ON">contextSwitching_ON</span>%,
|
||||
'Connected as rtyler' )
|
||||
or print STDERR Dumper( $res->[2]->[0] );
|
||||
ok(
|
||||
$res->[2]->[0] =~
|
||||
m%<span trspan="contextSwitching_ON">contextSwitching_ON</span>%,
|
||||
'Connected as rtyler'
|
||||
) or print STDERR Dumper( $res->[2]->[0] );
|
||||
count(2);
|
||||
|
||||
# ContextSwitching form -> PE_OK
|
||||
|
|
@ -80,7 +83,8 @@ count(1);
|
|||
|
||||
my ( $host, $url, $query ) =
|
||||
expectForm( $res, undef, '/switchcontext', 'spoofId' );
|
||||
ok( $res->[2]->[0] =~ m%<span trspan="contextSwitching_ON">%, 'Found trspan="contextSwitching_ON"' )
|
||||
ok( $res->[2]->[0] =~ m%<span trspan="contextSwitching_ON">%,
|
||||
'Found trspan="contextSwitching_ON"' )
|
||||
or explain( $res->[2]->[0], 'trspan="contextSwitching_ON"' );
|
||||
$query =~ s/spoofId=/spoofId=dwho/;
|
||||
ok(
|
||||
|
|
@ -104,7 +108,8 @@ ok(
|
|||
);
|
||||
count(3);
|
||||
expectAuthenticatedAs( $res, 'dwho' );
|
||||
ok( $res->[2]->[0] =~ m%<span trspan="contextSwitching_OFF">%, 'Found trspan="contextSwitching_OFF"' )
|
||||
ok( $res->[2]->[0] =~ m%<span trspan="contextSwitching_OFF">%,
|
||||
'Found trspan="contextSwitching_OFF"' )
|
||||
or explain( $res->[2]->[0], 'trspan="contextSwitching_OFF"' );
|
||||
ok(
|
||||
$res = $client->_get(
|
||||
|
|
@ -126,7 +131,8 @@ ok( $res->[2]->[0] =~ m%<td scope="row">dwho</td>%, 'Found value dwho' )
|
|||
or explain( $res->[2]->[0], 'Value dwho' );
|
||||
ok( $res->[2]->[0] =~ m%<td scope="row">mail</td>%, 'Found attribute mail' )
|
||||
or explain( $res->[2]->[0], 'Attribute mail' );
|
||||
ok( $res->[2]->[0] =~ m%<td scope="row">testPrefix__session_id</td>%, 'Found spoofed _id_session' )
|
||||
ok( $res->[2]->[0] =~ m%<td scope="row">testPrefix__session_id</td>%,
|
||||
'Found spoofed _id_session' )
|
||||
or explain( $res->[2]->[0], 'Spoofed _id_session' );
|
||||
count(5);
|
||||
|
||||
|
|
|
|||
|
|
@ -138,7 +138,7 @@ ok(
|
|||
);
|
||||
count(1);
|
||||
|
||||
my $id = expectCookie($res);
|
||||
my $id = expectCookie($res);
|
||||
my $id2 = expectCookie( $res, 'lemonldaphttp' );
|
||||
expectRedirection( $res, 'http://auth.example.com/' );
|
||||
|
||||
|
|
|
|||
|
|
@ -136,7 +136,7 @@ ok(
|
|||
count(1);
|
||||
|
||||
$pdata = expectCookie( $res, 'lemonldappdata' );
|
||||
$id = expectCookie($res);
|
||||
$id = expectCookie($res);
|
||||
|
||||
expectRedirection( $res, 'http://test1.example.com' );
|
||||
|
||||
|
|
|
|||
|
|
@ -3,11 +3,12 @@
|
|||
if ( $ENV{LLNGTESTLDAP} ) {
|
||||
my $slapd_bin = $ENV{LLNGTESTLDAP_SLAPD_BIN} || '/usr/sbin/slapd';
|
||||
my $slapadd_bin = $ENV{LLNGTESTLDAP_SLAPADD_BIN} || '/usr/sbin/slapadd';
|
||||
my $slapd_schema_dir =
|
||||
( $ENV{LLNGTESTLDAP_SCHEMA_DIR}
|
||||
my $slapd_schema_dir = (
|
||||
$ENV{LLNGTESTLDAP_SCHEMA_DIR}
|
||||
and -d $ENV{LLNGTESTLDAP_SCHEMA_DIR} ? $ENV{LLNGTESTLDAP_SCHEMA_DIR}
|
||||
: -d '/etc/slapd/schema' ? '/etc/slapd/schema'
|
||||
: '/etc/ldap/schema' );
|
||||
: '/etc/ldap/schema'
|
||||
);
|
||||
eval { mkdir 't/testslapd/slapd.d' };
|
||||
eval { mkdir 't/testslapd/data' };
|
||||
system('cp t/testslapd/slapd.ldif t/testslapd/slapd-test.ldif');
|
||||
|
|
|
|||
Loading…
Reference in New Issue