validator/httpd/cgi-bin check,1.473,1.474

Update of /sources/public/validator/httpd/cgi-bin
In directory hutz:/tmp/cvs-serv13389

Modified Files:
	check 
Log Message:
Workaround for CGI.pm's _name_and_path_from_env query string issues, #4365

Index: check
===================================================================
RCS file: /sources/public/validator/httpd/cgi-bin/check,v
retrieving revision 1.473
retrieving revision 1.474
diff -u -d -r1.473 -r1.474
--- check	7 Mar 2007 08:07:11 -0000	1.473
+++ check	12 Mar 2007 20:25:39 -0000	1.474
@@ -237,14 +237,6 @@
 # after abort_if_error_flagged under mod_perl.
 our $File = {};
 
-##############################################
-# Populate $File->{Env} -- Session Metadata. #
-##############################################
-
-#
-# The URL to this CGI Script.
-$File->{Env}->{'Self URI'} = $q->url(-query => 0);
-
 #################################
 # Initialize the datastructure. #
 #################################
@@ -1573,6 +1565,23 @@
   my $File = shift;
   my $q    = shift;
 
+  my $path_info;
+  {
+    # @@@HACK:
+    # CGI.pm's _name_and_path_from_env has query string related issues;
+    # just trump the query string for the duration of calling methods we
+    # know we don't need it for and which have been affected in the past.
+    # More info: http://www.w3.org/Bugs/Public/show_bug.cgi?id=4365
+
+    local $ENV{REQUEST_URI} = URI->new($ENV{REQUEST_URI})->path()
+      if $ENV{REQUEST_URI};
+
+    # The URL to this CGI script.
+    $File->{Env}->{'Self URI'} = $q->url();
+
+    $path_info                 = $q->path_info();
+  }
+
   # Avoid CGI.pm's "exists but undef" behaviour.
   if (scalar $q->param) {
     foreach my $param ($q->param) {
@@ -1592,14 +1601,14 @@
   }
 
   # Futz the URL so "/referer" works.
-  if ($q->path_info) {
-    if ($q->path_info eq '/referer' or $q->path_info eq '/referrer') {
+  if ($path_info) {
+    if ($path_info eq '/referer' or $path_info eq '/referrer') {
       if ($q->referer) {
         $q->param('uri', $q->referer);
         print redirect &self_url_q($q, $File);
         exit;
       } else {
-        print redirect $q->url() . '?uri=' . 'referer';
+        print redirect $File->{Env}->{'Self URI'} . '?uri=referer';
         exit;
       }
     } else {

Received on Monday, 12 March 2007 20:25:52 UTC