| Subject: | [PATCH] CGI.pm original pathinfo not striped if new pathinfo set |
The following was reported in the Perl 5 bug queue.
This is a bug report for perl from kevin.bitcard@stewart.gen.nz,
generated with the help of perlbug 1.35 running under perl v5.8.8.
-----------------------------------------------------------------
[Please enter your report here]
I have found a bug in CGI.pm affecting crickets pathinfo UrlStyle
the problem is if you set path_info on a url that was called with path info
CGI.pm will fail to strip the original called path_info from the url before
adding the new path_info.
Below is a test script that prints its url and then sets path_info and
a quick hack patch to remove the original path_info from the url instead
of trying to remove the new path info.
below is a test with path_info set to /test/test the final result should
be http://127.0.0.1/cgi-bin/cricket/cgi.cgi/customers/BOB/WasHere if the
original path info was striped.
requested url
http://127.0.0.1/cgi-bin/cricket/cgi.cgi/test/test
output
http://127.0.0.1/cgi-bin/cricket/cgi.cgi/test/test
http://127.0.0.1/cgi-bin/cricket/cgi.cgi/test/test/customers/BOB/WasHere
Kevin Stewart
test cgi
#!/usr/bin/perl -w
use CGI qw(fatalsToBrowser);
my $cgi = new CGI;
print "Content-type: text/plain\n\n";
print $cgi->url(-relative=>0, -query=>1, -path_info=>1)."\n";
$cgi->path_info("/customers/BOB/WasHere");
print $cgi->url(-relative=>0, -query=>1, -path_info=>1)."\n";
example patch
--- /usr/share/perl/5.8.8/CGI.pm 2006-12-06 00:52:37.000000000 +1300
+++ CGI.pm 2007-06-19 14:32:53.000000000 +1200
@@ -2623,6 +2623,7 @@
$rewrite++ unless defined $rewrite;
my $path = $self->path_info;
+ my $realpath = $ENV{PATH_INFO};
my $script_name = $self->script_name;
my $request_uri = $self->request_uri || '';
my $query_str = $self->query_string;
@@ -2632,7 +2633,7 @@
my $uri = $rewrite && $request_uri ? $request_uri : $script_name;
$uri =~ s/\?.*$//; # remove query string
- $uri =~ s/$path$// if defined $path; # remove path
+ $uri =~ s/$realpath$// if defined $realpath; # remove path
if ($full) {
my $protocol = $self->protocol();