Escape values in URI (#1025)
This commit is contained in:
parent
a8ecd8f76a
commit
7be4088df1
|
@ -9,9 +9,10 @@ package Lemonldap::NG::Portal::IssuerDBGet;
|
||||||
use strict;
|
use strict;
|
||||||
use Lemonldap::NG::Portal::Simple;
|
use Lemonldap::NG::Portal::Simple;
|
||||||
use MIME::Base64;
|
use MIME::Base64;
|
||||||
|
use URI::Escape;
|
||||||
use base qw(Lemonldap::NG::Portal::_LibAccess);
|
use base qw(Lemonldap::NG::Portal::_LibAccess);
|
||||||
|
|
||||||
our $VERSION = '1.9.3';
|
our $VERSION = '2.0.0';
|
||||||
|
|
||||||
## @method void issuerDBInit()
|
## @method void issuerDBInit()
|
||||||
# Nothing to do
|
# Nothing to do
|
||||||
|
@ -29,9 +30,9 @@ sub issuerForUnAuthUser {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
# Get URLs
|
# Get URLs
|
||||||
my $issuerDBGetPath = $self->{issuerDBGetPath};
|
my $issuerDBGetPath = $self->{issuerDBGetPath};
|
||||||
my $get_login = 'login';
|
my $get_login = 'login';
|
||||||
my $get_logout = 'logout';
|
my $get_logout = 'logout';
|
||||||
|
|
||||||
# Called URL
|
# Called URL
|
||||||
my $url = $self->url();
|
my $url = $self->url();
|
||||||
|
@ -60,7 +61,7 @@ sub issuerForUnAuthUser {
|
||||||
# Display a link to the provided URL
|
# Display a link to the provided URL
|
||||||
$self->lmLog( "Logout URL $logout_url will be displayed", 'debug' );
|
$self->lmLog( "Logout URL $logout_url will be displayed", 'debug' );
|
||||||
|
|
||||||
$self->info( "<h3>Back to logout url</h3>" );
|
$self->info("<h3>Back to logout url</h3>");
|
||||||
$self->info("<p><a href=\"$logout_url\">$logout_url</a></p>");
|
$self->info("<p><a href=\"$logout_url\">$logout_url</a></p>");
|
||||||
$self->{activeTimer} = 0;
|
$self->{activeTimer} = 0;
|
||||||
|
|
||||||
|
@ -74,7 +75,6 @@ sub issuerForUnAuthUser {
|
||||||
return PE_OK;
|
return PE_OK;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
## @apmethod int issuerForAuthUser()
|
## @apmethod int issuerForAuthUser()
|
||||||
# Manage Get request for authenticated user
|
# Manage Get request for authenticated user
|
||||||
# @return Lemonldap::NG::Portal error code
|
# @return Lemonldap::NG::Portal error code
|
||||||
|
@ -82,9 +82,9 @@ sub issuerForAuthUser {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
# Get URLs
|
# Get URLs
|
||||||
my $issuerDBGetPath = $self->{issuerDBGetPath};
|
my $issuerDBGetPath = $self->{issuerDBGetPath};
|
||||||
my $get_login = 'login';
|
my $get_login = 'login';
|
||||||
my $get_logout = 'logout';
|
my $get_logout = 'logout';
|
||||||
|
|
||||||
# Called URL
|
# Called URL
|
||||||
my $url = $self->url();
|
my $url = $self->url();
|
||||||
|
@ -105,7 +105,7 @@ sub issuerForAuthUser {
|
||||||
# Compute GET parameters to send and build urldc accordingly
|
# Compute GET parameters to send and build urldc accordingly
|
||||||
&computeGetParams($self);
|
&computeGetParams($self);
|
||||||
|
|
||||||
$self->lmLog( "Redirect user to ".$self->{urldc}, 'debug' );
|
$self->lmLog( "Redirect user to " . $self->{urldc}, 'debug' );
|
||||||
|
|
||||||
return $self->_subProcess(qw(autoRedirect));
|
return $self->_subProcess(qw(autoRedirect));
|
||||||
}
|
}
|
||||||
|
@ -130,7 +130,7 @@ sub issuerForAuthUser {
|
||||||
# Display a link to the provided URL
|
# Display a link to the provided URL
|
||||||
$self->lmLog( "Logout URL $logout_url will be displayed", 'debug' );
|
$self->lmLog( "Logout URL $logout_url will be displayed", 'debug' );
|
||||||
|
|
||||||
$self->info( "<h3>back to logout url</h3>" );
|
$self->info("<h3>back to logout url</h3>");
|
||||||
$self->info("<p><a href=\"$logout_url\">$logout_url</a></p>");
|
$self->info("<p><a href=\"$logout_url\">$logout_url</a></p>");
|
||||||
$self->{activeTimer} = 0;
|
$self->{activeTimer} = 0;
|
||||||
|
|
||||||
|
@ -166,50 +166,55 @@ sub computeGetParams {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
# Additional GET variables
|
# Additional GET variables
|
||||||
my $getVars="";
|
my $getVars = "";
|
||||||
if( exists $self->{issuerDBGetParameters} ) {
|
if ( exists $self->{issuerDBGetParameters} ) {
|
||||||
my $issuerDBGetParameters = $self->{issuerDBGetParameters};
|
my $issuerDBGetParameters = $self->{issuerDBGetParameters};
|
||||||
foreach my $vhost ( keys %$issuerDBGetParameters ) {
|
foreach my $vhost ( keys %$issuerDBGetParameters ) {
|
||||||
# if vhost is matching
|
|
||||||
if( index( $self->{urldc}, $vhost ) != -1 ) {
|
# if vhost is matching
|
||||||
my $params = $issuerDBGetParameters->{$vhost};
|
if ( index( $self->{urldc}, $vhost ) != -1 ) {
|
||||||
foreach my $param ( keys %$params ) {
|
my $params = $issuerDBGetParameters->{$vhost};
|
||||||
my $val = $params->{$param};
|
foreach my $param ( keys %$params ) {
|
||||||
my $value;
|
my $val = $params->{$param};
|
||||||
|
my $value;
|
||||||
# substitute session variables
|
|
||||||
$val = &substitute($val);
|
# substitute session variables
|
||||||
my $datas = $self->{sessionInfo};
|
$val = &substitute($val);
|
||||||
|
my $datas = $self->{sessionInfo};
|
||||||
$value = eval($val);
|
|
||||||
$self->lmLog( "Error while evaluating $val: $@", 'warn' )
|
$value = eval($val);
|
||||||
if $@;
|
$self->lmLog( "Error while evaluating $val: $@", 'warn' )
|
||||||
# Chain GET parameters unless there are evaluation errors
|
if $@;
|
||||||
$getVars .= "&".$param."=".$value unless $@;
|
|
||||||
}
|
# Chain GET parameters unless there are evaluation errors
|
||||||
|
$getVars .= "&" . $param . "=" . uri_escape($value)
|
||||||
|
unless $@;
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
|
||||||
}
|
}
|
||||||
$getVars =~ s/^\&//; # remove first &
|
$getVars =~ s/^\&//; # remove first &
|
||||||
$getVars =~ s/[\r\n\t]//; # remove invalid characters
|
$getVars =~ s/[\r\n\t]//; # remove invalid characters
|
||||||
|
|
||||||
# If there are some GET variables to send
|
# If there are some GET variables to send
|
||||||
# Add them to URL string
|
# Add them to URL string
|
||||||
if( $getVars ne "" ) {
|
if ( $getVars ne "" ) {
|
||||||
my $urldc = $self->{urldc};
|
my $urldc = $self->{urldc};
|
||||||
|
|
||||||
$urldc .= ( $urldc =~ /\?\w/ ) ?
|
$urldc .= ( $urldc =~ /\?\w/ )
|
||||||
# there are already get variables
|
?
|
||||||
"&".$getVars
|
|
||||||
:
|
# there are already get variables
|
||||||
# there are no get variables
|
"&" . $getVars
|
||||||
"?".$getVars;
|
:
|
||||||
$self->{urldc}=$urldc;
|
|
||||||
|
# there are no get variables
|
||||||
|
"?" . $getVars;
|
||||||
|
$self->{urldc} = $urldc;
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
sub substitute {
|
sub substitute {
|
||||||
my $expr = shift;
|
my $expr = shift;
|
||||||
|
|
||||||
|
@ -224,10 +229,6 @@ sub substitute {
|
||||||
return $expr;
|
return $expr;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
__END__
|
__END__
|
||||||
|
|
Loading…
Reference in New Issue
Block a user