* "SKIP" in SAML tests
* "= splice @_" instead of "= @_" avoid memory duplication
This commit is contained in:
Xavier Guimard
parent
c0ab13447c
commit
01785de792
|
|
@ -1,4 +1,3 @@
|
|||
debian/tmp/etc/lemonldap-ng/apps-list*
|
||||
debian/tmp/usr/share/lemonldap-ng/bin/purgeCentralCache
|
||||
debian/tmp/usr/share/lemonldap-ng/portal-skins
|
||||
debian/tmp/usr/share/man/man3/Lemonldap::NG::Portal*
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ BEGIN {
|
|||
# @return Apache constant
|
||||
sub run ($$) {
|
||||
my $class;
|
||||
( $class, $apacheRequest ) = @_;
|
||||
( $class, $apacheRequest ) = splice @_;
|
||||
if ( time() - $lastReload > $reloadTime ) {
|
||||
unless ( my $tmp = $class->testConf(1) == OK ) {
|
||||
$class->lmLog( "$class: No configuration found", 'error' );
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@ use base qw(Lemonldap::NG::Handler::SharedConf);
|
|||
# @return Apache constant
|
||||
sub run ($$) {
|
||||
my $class;
|
||||
( $class, $apacheRequest ) = splice @_;
|
||||
$cda = 1;
|
||||
return $class->SUPER::run($apacheRequest);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ sub new {
|
|||
unless Lemonldap::NG::Handler::_CGI->testConf() == OK;
|
||||
|
||||
# Arguments
|
||||
my @args = @_;
|
||||
my @args = splice @_;
|
||||
if ( ref( $args[0] ) ) {
|
||||
%$self = ( %$self, %{ $args[0] } );
|
||||
}
|
||||
|
|
@ -143,7 +143,7 @@ sub user {
|
|||
# @param $group name of the Lemonldap::NG group to test
|
||||
# @return boolean : true if user is in this group
|
||||
sub group {
|
||||
my ( $self, $group ) = @_;
|
||||
my ( $self, $group ) = splice @_;
|
||||
return ( $datas->{groups} =~ /\b$group\b/ );
|
||||
}
|
||||
|
||||
|
|
@ -203,7 +203,7 @@ sub lmLog {
|
|||
# @param $vhost Virtual Host to test
|
||||
# @return boolean : true if $vhost is available
|
||||
sub vhostAvailable {
|
||||
my ( $self, $vhost ) = @_;
|
||||
my ( $self, $vhost ) = splice @_;
|
||||
return defined( $defaultCondition->{$vhost} );
|
||||
}
|
||||
|
||||
|
|
@ -212,7 +212,7 @@ sub vhostAvailable {
|
|||
# @param $uri URI string
|
||||
# @param $vhost Optional virtual host (default current virtual host)
|
||||
sub grant {
|
||||
my ( $self, $uri, $vhost ) = @_;
|
||||
my ( $self, $uri, $vhost ) = splice @_;
|
||||
$vhost ||= $ENV{SERVER_NAME};
|
||||
$apacheRequest = Lemonldap::NG::Apache::Request->new(
|
||||
{
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ $UA->requests_redirectable( [] );
|
|||
# Called for Apache response (PerlResponseHandler).
|
||||
# @return Apache constant
|
||||
sub run($$) {
|
||||
( $class, $r ) = @_;
|
||||
( $class, $r ) = splice @_;
|
||||
my $url = $r->uri;
|
||||
$url .= "?" . $r->args if ( $r->args );
|
||||
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@ BEGIN {
|
|||
# init is overloaded to call only localInit. globalInit is called later.
|
||||
# @param $args hash containing parameters
|
||||
sub init($$) {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
# TODO reloadTime in defaultValuesInit ?
|
||||
$reloadTime = $args->{reloadTime} || 600;
|
||||
$class->localInit($args);
|
||||
|
|
@ -72,7 +72,7 @@ sub init($$) {
|
|||
# @param $args hash containing parameters
|
||||
# @return boolean
|
||||
sub defaultValuesInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
|
||||
# Local configuration overrides global configuration
|
||||
my %h = ( %$args, %$localConfig );
|
||||
|
|
@ -83,7 +83,7 @@ sub defaultValuesInit {
|
|||
# Load parameters and build the Lemonldap::NG::Common::Conf object.
|
||||
# @return boolean
|
||||
sub localInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
die(
|
||||
"$class : unable to build configuration : $Lemonldap::NG::Common::Conf::msg"
|
||||
)
|
||||
|
|
@ -118,7 +118,7 @@ sub localInit {
|
|||
# @param $r Apache2::RequestRec object
|
||||
# @return Apache constant
|
||||
sub run($$) {
|
||||
my ( $class, $r ) = @_;
|
||||
my ( $class, $r ) = splice @_;
|
||||
if ( time() - $lastReload > $reloadTime ) {
|
||||
unless ( my $tmp = $class->testConf(1) == OK ) {
|
||||
$class->lmLog( "$class: No configuration found", 'error' );
|
||||
|
|
@ -138,7 +138,7 @@ sub run($$) {
|
|||
# @param $local boolean
|
||||
# @return Apache constant
|
||||
sub testConf {
|
||||
my ( $class, $local ) = @_;
|
||||
my ( $class, $local ) = splice @_;
|
||||
my $conf = $lmConf->getConf( { local => $local } );
|
||||
unless ( ref($conf) ) {
|
||||
$class->lmLog(
|
||||
|
|
@ -163,7 +163,7 @@ sub testConf {
|
|||
# Local parameters have best precedence on configuration parameters.
|
||||
# @return Apache constant
|
||||
sub setConf {
|
||||
my ( $class, $conf ) = @_;
|
||||
my ( $class, $conf ) = splice @_;
|
||||
|
||||
# Local configuration overrides global configuration
|
||||
$cfgNum = $conf->{cfgNum};
|
||||
|
|
@ -183,7 +183,7 @@ sub setConf {
|
|||
# @param $r current request
|
||||
# @return Apache constant (OK or SERVER_ERROR)
|
||||
sub refresh($$) {
|
||||
my ( $class, $r ) = @_;
|
||||
my ( $class, $r ) = splice @_;
|
||||
$class->lmLog( "$class: request for configuration reload", 'notice' );
|
||||
$r->handler("perl-script");
|
||||
if ( $class->testConf(0) == OK ) {
|
||||
|
|
|
|||
|
|
@ -183,7 +183,7 @@ sub logout_mp2 : method {
|
|||
# @param $mess message to log
|
||||
# @param $level string (debug, info, warning or error)
|
||||
sub lmLog {
|
||||
my ( $class, $mess, $level ) = @_;
|
||||
my ( $class, $mess, $level ) = splice @_;
|
||||
die "Level is required" unless ($level);
|
||||
if ( MP() == 2 ) {
|
||||
Apache2::ServerRec->log->$level($mess);
|
||||
|
|
@ -201,7 +201,7 @@ sub lmLog {
|
|||
# @param $r current request
|
||||
# @param $s string to use
|
||||
sub lmSetApacheUser {
|
||||
my ( $class, $r, $s ) = @_;
|
||||
my ( $class, $r, $s ) = splice @_;
|
||||
return unless ($s);
|
||||
if ( MP() == 2 ) {
|
||||
$r->user($s);
|
||||
|
|
@ -216,7 +216,7 @@ sub lmSetApacheUser {
|
|||
# @param $str string
|
||||
# @return string
|
||||
sub regRemoteIp {
|
||||
my ( $class, $str ) = @_;
|
||||
my ( $class, $str ) = splice @_;
|
||||
if ( MP() == 2 ) {
|
||||
$str =~ s/\$datas->\{ip\}/\$apacheRequest->connection->remote_ip/g;
|
||||
}
|
||||
|
|
@ -232,7 +232,7 @@ sub regRemoteIp {
|
|||
# @param $h Name of the header
|
||||
# @param $v Value of the header
|
||||
sub lmSetHeaderIn {
|
||||
my ( $r, $h, $v ) = @_;
|
||||
my ( $r, $h, $v ) = splice @_;
|
||||
if ( MP() == 2 ) {
|
||||
return $r->headers_in->set( $h => $v );
|
||||
}
|
||||
|
|
@ -247,7 +247,7 @@ sub lmSetHeaderIn {
|
|||
# @param $h Name of the header
|
||||
# @return Value of the header
|
||||
sub lmHeaderIn {
|
||||
my ( $r, $h ) = @_;
|
||||
my ( $r, $h ) = splice @_;
|
||||
if ( MP() == 2 ) {
|
||||
return $r->headers_in->{$h};
|
||||
}
|
||||
|
|
@ -262,7 +262,7 @@ sub lmHeaderIn {
|
|||
# @param $h Name of the header
|
||||
# @param $v Value of the header
|
||||
sub lmSetErrHeaderOut {
|
||||
my ( $r, $h, $v ) = @_;
|
||||
my ( $r, $h, $v ) = splice @_;
|
||||
if ( MP() == 2 ) {
|
||||
return $r->err_headers_out->set( $h => $v );
|
||||
}
|
||||
|
|
@ -277,7 +277,7 @@ sub lmSetErrHeaderOut {
|
|||
# @param $h Name of the header
|
||||
# @param $v Value of the header
|
||||
sub lmSetHeaderOut {
|
||||
my ( $r, $h, $v ) = @_;
|
||||
my ( $r, $h, $v ) = splice @_;
|
||||
if ( MP() == 2 ) {
|
||||
return $r->headers_out->set( $h => $v );
|
||||
}
|
||||
|
|
@ -292,7 +292,7 @@ sub lmSetHeaderOut {
|
|||
# @param $h Name of the header
|
||||
# @return Value of the header
|
||||
sub lmHeaderOut {
|
||||
my ( $r, $h, $v ) = @_;
|
||||
my ( $r, $h, $v ) = splice @_;
|
||||
if ( MP() == 2 ) {
|
||||
return $r->headers_out->{$h};
|
||||
}
|
||||
|
|
@ -391,7 +391,7 @@ sub init($$) {
|
|||
# (statusProcess()) in wanted and launch childInit().
|
||||
# @param $args reference to the initialization hash
|
||||
sub localInit($$) {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
if ( $localStorage = $args->{localStorage} ) {
|
||||
$localStorageOptions = $args->{localStorageOptions};
|
||||
$localStorageOptions->{namespace} ||= "lemonldap";
|
||||
|
|
@ -420,7 +420,7 @@ sub localInit($$) {
|
|||
# - cleanLocalStorage() after each requests
|
||||
# @return True
|
||||
sub childInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
return 1 if ($childInitDone);
|
||||
|
||||
# We don't initialise local storage in the "init" subroutine because it can
|
||||
|
|
@ -436,7 +436,7 @@ sub childInit {
|
|||
sub { return $class->initLocalStorage( $_[1], $_[0] ); } );
|
||||
$s->push_handlers(
|
||||
PerlPostConfigHandler => sub {
|
||||
my ( $c, $l, $t, $s ) = @_;
|
||||
my ( $c, $l, $t, $s ) = splice @_;
|
||||
$s->add_version_component('Lemonldap::NG::Handler');
|
||||
}
|
||||
) unless ( $args->{hideSignature} );
|
||||
|
|
@ -499,7 +499,7 @@ sub globalInit {
|
|||
# - the list of the compiled functions (compiled with conditionSub())
|
||||
# @param $args reference to the configuration hash
|
||||
sub locationRulesInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
$locationCount = 0;
|
||||
|
||||
# Pre compilation : both regexp and conditions
|
||||
|
|
@ -527,7 +527,7 @@ sub locationRulesInit {
|
|||
# locationRulesInit().
|
||||
# @param $cond The boolean expression to use
|
||||
sub conditionSub {
|
||||
my ( $class, $cond ) = @_;
|
||||
my ( $class, $cond ) = splice @_;
|
||||
return sub { 1 }
|
||||
if ( $cond =~ /^accept$/i );
|
||||
return sub { 0 }
|
||||
|
|
@ -581,7 +581,7 @@ sub conditionSub {
|
|||
# Set default values for non-customized variables
|
||||
# @param $args reference to the configuration hash
|
||||
sub defaultValuesInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
|
||||
# Other values
|
||||
$cookieName = $args->{cookieName} || $cookieName || 'lemonldap';
|
||||
|
|
@ -603,7 +603,7 @@ sub defaultValuesInit {
|
|||
# Verify that portal variable exists. Die unless
|
||||
# @param $args reference to the configuration hash
|
||||
sub portalInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
die("portal parameter required") unless ( $args->{portal} );
|
||||
if ( $args->{portal} =~ /[\$\(&\|"']/ ) {
|
||||
my $portal = $class->conditionSub( $args->{portal} );
|
||||
|
|
@ -620,7 +620,7 @@ sub portalInit {
|
|||
# Initialize the Apache::Session::* module choosed to share user's variables.
|
||||
# @param $args reference to the configuration hash
|
||||
sub globalStorageInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
$globalStorage = $args->{globalStorage} or die "globalStorage required";
|
||||
eval "use $globalStorage;";
|
||||
die($@) if ($@);
|
||||
|
|
@ -632,7 +632,7 @@ sub globalStorageInit {
|
|||
# headers into the HTTP request.
|
||||
# @param $args reference to the configuration hash
|
||||
sub forgeHeadersInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
|
||||
# Creation of the subroutine who will generate headers
|
||||
my %tmp;
|
||||
|
|
@ -663,7 +663,7 @@ sub forgeHeadersInit {
|
|||
# Prepare local cache (if not done before by Lemonldap::NG::Common::Conf)
|
||||
# @return Apache2::Const::DECLINED
|
||||
sub initLocalStorage {
|
||||
my ( $class, $r ) = @_;
|
||||
my ( $class, $r ) = splice @_;
|
||||
if ( $localStorage and not $refLocalStorage ) {
|
||||
eval
|
||||
"use $localStorage;\$refLocalStorage = new $localStorage(\$localStorageOptions);";
|
||||
|
|
@ -676,7 +676,7 @@ sub initLocalStorage {
|
|||
## @imethod protected void postUrlInit()
|
||||
# Prepare methods to post form attributes
|
||||
sub postUrlInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
return unless ( $args->{post} );
|
||||
eval 'use Apache2::Filter;use URI';
|
||||
$transform = {};
|
||||
|
|
@ -750,7 +750,7 @@ qq{<html><body onload="document.getElementById('f').submit()"><form id="f" metho
|
|||
## @rmethod protected void updateStatus(string user,string url,string action)
|
||||
# Inform the status process of the result of the request if it is available.
|
||||
sub updateStatus {
|
||||
my ( $class, $user, $url, $action ) = @_;
|
||||
my ( $class, $user, $url, $action ) = splice @_;
|
||||
eval {
|
||||
print $statusPipe "$user => "
|
||||
. $apacheRequest->hostname
|
||||
|
|
@ -763,7 +763,7 @@ sub updateStatus {
|
|||
# Grant or refuse client using compiled regexp and functions
|
||||
# @return True if the user is granted to access to the current URL
|
||||
sub grant {
|
||||
my ( $class, $uri ) = @_;
|
||||
my ( $class, $uri ) = splice @_;
|
||||
for ( my $i = 0 ; $i < $locationCount ; $i++ ) {
|
||||
return &{ $locationCondition->[$i] }($datas)
|
||||
if ( $uri =~ $locationRegexp->[$i] );
|
||||
|
|
@ -776,7 +776,7 @@ sub grant {
|
|||
# Inform the status processus and call logForbidden().
|
||||
# @return Apache2::Const::FORBIDDEN
|
||||
sub forbidden {
|
||||
my ( $class, $uri ) = @_;
|
||||
my ( $class, $uri ) = splice @_;
|
||||
if ( $datas->{_logout} ) {
|
||||
$class->updateStatus( $datas->{$whatToTrace}, $_[0], 'LOGOUT' );
|
||||
my $u = $datas->{_logout};
|
||||
|
|
@ -796,7 +796,7 @@ sub forbidden {
|
|||
# @param $uri uri asked
|
||||
# @param $datas hash re to user's datas
|
||||
sub logForbidden {
|
||||
my ( $class, $uri, $datas ) = @_;
|
||||
my ( $class, $uri, $datas ) = splice @_;
|
||||
$class->lmLog(
|
||||
'User "'
|
||||
. $datas->{$whatToTrace}
|
||||
|
|
@ -811,7 +811,7 @@ sub logForbidden {
|
|||
# authorizated. This method has to be overloaded to use different logs systems
|
||||
# @param $uri uri asked
|
||||
sub logGranted {
|
||||
my ( $class, $uri, $datas ) = @_;
|
||||
my ( $class, $uri, $datas ) = splice @_;
|
||||
$class->lmLog(
|
||||
'User "'
|
||||
. $datas->{$whatToTrace}
|
||||
|
|
@ -834,7 +834,7 @@ sub hideCookie {
|
|||
## @rmethod protected string encodeUrl(string url)
|
||||
# Encode URl in the format used by Lemonldap::NG::Portal for redirections.
|
||||
sub encodeUrl {
|
||||
my ( $class, $url ) = @_;
|
||||
my ( $class, $url ) = splice @_;
|
||||
my $u = $url;
|
||||
if ( $url !~ m#^https?://# ) {
|
||||
my $portString = $port || $apacheRequest->get_server_port();
|
||||
|
|
@ -857,7 +857,7 @@ sub encodeUrl {
|
|||
# @param $arg optionnal GET parameters
|
||||
# @return Apache2::Const::REDIRECT
|
||||
sub goToPortal {
|
||||
my ( $class, $url, $arg ) = @_;
|
||||
my ( $class, $url, $arg ) = splice @_;
|
||||
$class->lmLog(
|
||||
"Redirect "
|
||||
. $apacheRequest->connection->remote_ip
|
||||
|
|
@ -896,7 +896,7 @@ sub fetchId {
|
|||
# @return Apache2::Const value (OK, FORBIDDEN, REDIRECT or SERVER_ERROR)
|
||||
sub run ($$) {
|
||||
my $class;
|
||||
( $class, $apacheRequest ) = @_;
|
||||
( $class, $apacheRequest ) = splice @_;
|
||||
return DECLINED unless ( $apacheRequest->is_initial_req );
|
||||
my $args = $apacheRequest->args;
|
||||
|
||||
|
|
@ -1038,7 +1038,7 @@ sub localUnlog {
|
|||
# @return Apache2::Const value returned by goToPortal()
|
||||
sub unlog ($$) {
|
||||
my $class;
|
||||
( $class, $apacheRequest ) = @_;
|
||||
( $class, $apacheRequest ) = splice @_;
|
||||
$class->localUnlog;
|
||||
$class->updateStatus( $apacheRequest->connection->remote_ip,
|
||||
$apacheRequest->uri, 'LOGOUT' );
|
||||
|
|
@ -1085,7 +1085,7 @@ sub redirectFilter {
|
|||
# @param $r Current request
|
||||
# @return Apache2::Const::OK
|
||||
sub status($$) {
|
||||
my ( $class, $r ) = @_;
|
||||
my ( $class, $r ) = splice @_;
|
||||
$class->lmLog( "$class: request for status", 'debug' );
|
||||
unless ( $statusPipe and $statusOut ) {
|
||||
$class->lmLog( "$class: status page can not be displayed", 'error' );
|
||||
|
|
|
|||
|
|
@ -242,7 +242,7 @@ sub timeUp {
|
|||
# @param $cat Category to display
|
||||
# @param $max Number of lines to display
|
||||
sub topByCat {
|
||||
my ( $cat, $max ) = @_;
|
||||
my ( $cat, $max ) = splice @_;
|
||||
my $i = 0;
|
||||
print "<pre>\n";
|
||||
foreach (
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ our $VERSION = '0.55';
|
|||
# virtual host
|
||||
# @param $args reference to the configuration hash
|
||||
sub locationRulesInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
foreach my $vhost ( keys %{ $args->{locationRules} } ) {
|
||||
$locationCount->{$vhost} = 0;
|
||||
foreach ( sort keys %{ $args->{locationRules}->{$vhost} } ) {
|
||||
|
|
@ -53,7 +53,7 @@ sub locationRulesInit {
|
|||
# headers into the HTTP request.
|
||||
# @param $args reference to the configuration hash
|
||||
sub forgeHeadersInit {
|
||||
my ( $class, $args ) = @_;
|
||||
my ( $class, $args ) = splice @_;
|
||||
|
||||
# Creation of the subroutine who will generate headers
|
||||
foreach my $vhost ( keys %{ $args->{exportedHeaders} } ) {
|
||||
|
|
@ -98,7 +98,7 @@ sub sendHeaders {
|
|||
# Grant or refuse client using compiled regexp and functions
|
||||
# @return True if the user is granted to access to the current URL
|
||||
sub grant {
|
||||
my ( $class, $uri ) = @_;
|
||||
my ( $class, $uri ) = splice @_;
|
||||
my $vhost = $apacheRequest->hostname;
|
||||
for ( my $i = 0 ; $i < $locationCount->{$vhost} ; $i++ ) {
|
||||
if ( $uri =~ $locationRegexp->{$vhost}->[$i] ) {
|
||||
|
|
|
|||
|
|
@ -142,8 +142,7 @@ sub new {
|
|||
# @param $modulename string
|
||||
# @return boolean
|
||||
sub displayModule {
|
||||
my $self = shift;
|
||||
my ($modulename) = @_;
|
||||
my ( $self, $modulename ) = splice @_;
|
||||
|
||||
# Manage "0" and "1" rules
|
||||
return 1 if ( $self->{modules}->{$modulename} eq "1" );
|
||||
|
|
@ -237,8 +236,7 @@ sub appslistDescription {
|
|||
# @param catlevel Category level
|
||||
# @return HTML string
|
||||
sub _displayConfCategory {
|
||||
my $self = shift;
|
||||
my ( $catname, $cathash, $catlevel ) = @_;
|
||||
my ( $self, $catname, $cathash, $catlevel ) = splice @_;
|
||||
my $html;
|
||||
my $key;
|
||||
|
||||
|
|
@ -289,7 +287,7 @@ sub _displayConfCategory {
|
|||
# @param $arg string to modify
|
||||
# @return string modified
|
||||
sub _userParam {
|
||||
my ( $self, $arg ) = @_;
|
||||
my ( $self, $arg ) = splice @_;
|
||||
$arg =~ s/\$([\w]+)/$self->{portalObject}->{sessionInfo}->{$1}/g;
|
||||
return $arg;
|
||||
}
|
||||
|
|
@ -385,8 +383,7 @@ sub _displayConfDescription {
|
|||
# @param $apphash Menu elements
|
||||
# @return filtered hash
|
||||
sub _filter {
|
||||
my $self = shift;
|
||||
my ($apphash) = @_;
|
||||
my ( $self, $apphash ) = splice @_;
|
||||
my $filteredHash;
|
||||
my $key;
|
||||
|
||||
|
|
@ -501,8 +498,7 @@ sub _isCategoryEmpty {
|
|||
# @param $uri URL string
|
||||
# @return True if granted
|
||||
sub _grant {
|
||||
my $self = shift;
|
||||
my ($uri) = @_;
|
||||
my ( $self, $uri ) = splice @_;
|
||||
$uri =~ m{(\w+)://([^/:]+)(:\d+)?(/.*)?$} or return 0;
|
||||
my ( $protocol, $vhost, $port );
|
||||
( $protocol, $vhost, $port, $path ) = ( $1, $2, $3, $4 );
|
||||
|
|
@ -562,8 +558,7 @@ sub _compileRules {
|
|||
# @param $cond boolean expression
|
||||
# @return Compiled routine
|
||||
sub _conditionSub {
|
||||
my $self = shift;
|
||||
my ($cond) = @_;
|
||||
my ( $self, $cond ) = splice @_;
|
||||
return sub { 1 }
|
||||
if ( $cond =~ /^accept$/i );
|
||||
return sub { 0 }
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@ BEGIN {
|
|||
# @param $storage same syntax as Lemonldap::NG::Common::Conf object
|
||||
# @return Lemonldap::NG::Portal::Notification object
|
||||
sub new {
|
||||
my ( $class, $storage ) = @_;
|
||||
my ( $class, $storage ) = splice @_;
|
||||
my $self = bless {}, $class;
|
||||
(%$self) = (%$storage);
|
||||
unless ( $self->{p} ) {
|
||||
|
|
@ -87,7 +87,7 @@ sub new {
|
|||
# @param $mess Text to log
|
||||
# @param $level Level (debug|info|notice|error)
|
||||
sub lmLog {
|
||||
my ( $self, $mess, $level ) = @_;
|
||||
my ( $self, $mess, $level ) = splice @_;
|
||||
$self->{p}->lmLog( "[Notification] $mess", $level );
|
||||
}
|
||||
|
||||
|
|
@ -97,7 +97,7 @@ sub lmLog {
|
|||
# @param $portal Lemonldap::NG::Portal object that call
|
||||
# @return HTML fragment containing form content
|
||||
sub getNotification {
|
||||
my ( $self, $portal ) = @_;
|
||||
my ( $self, $portal ) = splice @_;
|
||||
my ( @notifs, $form );
|
||||
|
||||
# Get user datas,
|
||||
|
|
@ -157,7 +157,7 @@ sub getNotification {
|
|||
# @param $portal Lemonldap::NG::Portal object that call
|
||||
# @return true if all checkboxes have been checked
|
||||
sub checkNotification {
|
||||
my ( $self, $portal ) = @_;
|
||||
my ( $self, $portal ) = splice @_, 0, 2;
|
||||
my ( $refs, $checks );
|
||||
|
||||
# First, rebuild environment (cookies,...)
|
||||
|
|
@ -260,7 +260,7 @@ sub checkNotification {
|
|||
# @param $xml XML string containing notification
|
||||
# @return number of notifications done
|
||||
sub newNotification {
|
||||
my ( $self, $xml ) = @_;
|
||||
my ( $self, $xml ) = splice @_;
|
||||
eval { $xml = $parser->parse_string($xml); };
|
||||
if ($@) {
|
||||
$self->lmLog( "Unable to read XML file : $@", 'error' );
|
||||
|
|
|
|||
|
|
@ -90,7 +90,7 @@ sub search {
|
|||
# '; ' separator
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setSessionInfo {
|
||||
my ($self) = @_;
|
||||
my $self = shift;
|
||||
$self->{sessionInfo}->{dn} = $self->{dn};
|
||||
unless ( $self->{exportedVars} ) {
|
||||
foreach (qw(uid cn mail)) {
|
||||
|
|
@ -121,7 +121,7 @@ sub setSessionInfo {
|
|||
# Load all groups in $groups.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setGroups {
|
||||
my ($self) = @_;
|
||||
my $self = shift;
|
||||
my $groups = $self->{sessionInfo}->{groups};
|
||||
|
||||
$self->{ldapGroupObjectClass} ||= "groupOfNames";
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ sub new {
|
|||
sub bind {
|
||||
my $self = shift;
|
||||
my $mesg;
|
||||
my ( $dn, %args ) = @_;
|
||||
my ( $dn, %args ) = splice @_;
|
||||
unless ($dn) {
|
||||
$dn = $self->{portal}->{managerDn};
|
||||
$args{password} = $self->{portal}->{managerPassword};
|
||||
|
|
@ -186,9 +186,7 @@ sub userBind {
|
|||
# @param $oldpassword Current password
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub userModifyPassword {
|
||||
|
||||
my $self = shift;
|
||||
my ( $dn, $newpassword, $confirmpassword, $oldpassword ) = @_;
|
||||
my ( $self, $dn, $newpassword, $confirmpassword, $oldpassword ) = splice @_;
|
||||
my $err;
|
||||
my $mesg;
|
||||
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ our $VERSION = '0.11';
|
|||
# @param $portal Lemonldap::NG::Portal::Simple object
|
||||
# @return new Lemonldap::NG::Portal::_Multi object
|
||||
sub new {
|
||||
my ( $class, $portal ) = @_;
|
||||
my ( $class, $portal ) = splice @_;
|
||||
my $self = bless { p => $portal, res => PE_NOSCHEME }, $class;
|
||||
my @stack = ( $portal->{authentication}, $portal->{userDB} );
|
||||
for ( my $i = 0 ; $i < 2 ; $i++ ) {
|
||||
|
|
@ -50,7 +50,7 @@ sub new {
|
|||
# @param type 0 for authentication, 1 for userDB
|
||||
# @return Lemonldap::NG::Portal error code returned by method $sub
|
||||
sub try {
|
||||
my ( $self, $sub, $type ) = @_;
|
||||
my ( $self, $sub, $type ) = splice @_;
|
||||
my $res;
|
||||
my $s = $self->{stack}->[$type]->[0]->{m} . "::$sub";
|
||||
my $old = $self->{stack}->[$type]->[0]->{n};
|
||||
|
|
@ -91,7 +91,7 @@ sub try {
|
|||
# @param type 0 for authentication, 1 for userDB
|
||||
# return true if an other module is available
|
||||
sub next {
|
||||
my ( $self, $type ) = @_;
|
||||
my ( $self, $type ) = splice @_;
|
||||
if ( $self->{stack}->[$type]->[0]->{n} eq
|
||||
$self->{stack}->[ 1 - $type ]->[0]->{n}
|
||||
and $self->{stack}->[ 1 - $type ]->[1] )
|
||||
|
|
@ -112,7 +112,7 @@ sub next {
|
|||
# @param $sub name of the method who has failed
|
||||
# @return Lemonldap::NG::Portal error code
|
||||
sub replay {
|
||||
my ( $self, $sub ) = @_;
|
||||
my ( $self, $sub ) = splice @_;
|
||||
my @subs = ();
|
||||
foreach (
|
||||
qw(authInit extractFormInfo setAuthSessionInfo userDBInit getUser
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@ _RETURN $getAttributesResponse Response
|
|||
# @param $id Cookie value
|
||||
# @return SOAP::Data sequence
|
||||
sub getAttributes {
|
||||
my ( $self, $id ) = @_;
|
||||
my ( $self, $id ) = splice @_;
|
||||
die 'id is required' unless ($id);
|
||||
my $h = $self->getApacheSession( $id, 1 );
|
||||
my @tmp = ();
|
||||
|
|
@ -140,7 +140,7 @@ sub getAttributes {
|
|||
# @param $args datas to store
|
||||
# @return true if succeed
|
||||
sub setAttributes {
|
||||
my ( $self, $id, $args ) = @_;
|
||||
my ( $self, $id, $args ) = splice @_;
|
||||
die 'id is required' unless ($id);
|
||||
my $h = $self->getApacheSession($id);
|
||||
unless ($h) {
|
||||
|
|
@ -178,7 +178,7 @@ sub lastCfg {
|
|||
# Store a new session.
|
||||
# @return Session datas
|
||||
sub newSession {
|
||||
my ( $self, $args ) = @_;
|
||||
my ( $self, $args ) = splice @_;
|
||||
my $h = $self->getApacheSession();
|
||||
if ($@) {
|
||||
$self->lmLog( "Unable to create session", 'error' );
|
||||
|
|
@ -196,7 +196,7 @@ sub newSession {
|
|||
## @method SOAP::Data deleteSession()
|
||||
# Deletes an existing session
|
||||
sub deleteSession {
|
||||
my ( $self, $id ) = @_;
|
||||
my ( $self, $id ) = splice @_;
|
||||
die('id parameter is required') unless ($id);
|
||||
my $h = $self->getApacheSession($id);
|
||||
return 0 if ($@);
|
||||
|
|
@ -353,9 +353,7 @@ sub _buildSoapHash {
|
|||
# @param $cond boolean expression
|
||||
# @return Compiled routine
|
||||
sub _conditionSub {
|
||||
my $self = shift;
|
||||
my $id = shift;
|
||||
my ($cond) = @_;
|
||||
my ( $self, $id, $cond ) = splice @_;
|
||||
my $h = $self->getApacheSession( $id, 1 );
|
||||
return sub { 1 }
|
||||
if ( $cond =~ /^accept$/i );
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ our $VERSION = '0.5';
|
|||
# @param $lang Language or Accepted-Language HTTP header string
|
||||
# @return Error string for the $code in the $lang language
|
||||
sub error {
|
||||
my ( $error, $lang ) = @_;
|
||||
my ( $error, $lang ) = splice @_;
|
||||
$lang = lc($lang);
|
||||
$lang =~ s/-/_/g;
|
||||
$error = 0 if ( $error < 0 );
|
||||
|
|
@ -37,7 +37,7 @@ sub error {
|
|||
# @param $lang Language or Accepted-Language HTTP header string
|
||||
# @return Error string for the $code in the $lang language
|
||||
sub msg {
|
||||
my ( $msg, $lang ) = @_;
|
||||
my ( $msg, $lang ) = splice @_;
|
||||
$lang = lc($lang);
|
||||
$lang =~ s/-/_/g;
|
||||
$msg = 0 if ( $msg < 0 );
|
||||
|
|
|
|||
|
|
@ -1,15 +1,7 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl Lemonldap-NG-Portal-SAMLIssuer.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test::More tests => 1;
|
||||
BEGIN { use_ok('Lemonldap::NG::Portal::IssuerDBSAML') };
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso;";
|
||||
skip "Lasso is not installed, can't test SAML features", 1 if ($@);
|
||||
use_ok('Lemonldap::NG::Portal::IssuerDBSAML');
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,15 +1,7 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl Lemonldap-NG-Portal-AuthSAML.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test::More tests => 1;
|
||||
BEGIN { use_ok('Lemonldap::NG::Portal::AuthSAML') };
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso;";
|
||||
skip "Lasso is not installed, can't test SAML features", 1 if ($@);
|
||||
use_ok('Lemonldap::NG::Portal::AuthSAML');
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,15 +1,7 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl Lemonldap-NG-Portal-UserDBSAML.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test::More tests => 1;
|
||||
BEGIN { use_ok('Lemonldap::NG::Portal::UserDBSAML') };
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
SKIP: {
|
||||
eval "use Lasso;";
|
||||
skip "Lasso is not installed, can't test SAML features", 1 if ($@);
|
||||
use_ok('Lemonldap::NG::Portal::UserDBSAML');
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user