Escape values in URI (#1025)

This commit is contained in:
Clément Oudot 2016-06-06 09:51:12 +00:00
parent a8ecd8f76a
commit 7be4088df1

View File

@ -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__