From 7dc108d184319beaec63e84f17c3ede08e5e7abc Mon Sep 17 00:00:00 2001
From: Steve Peters <steve@fisharerojo.org>
Date: Wed, 28 Sep 2005 00:06:29 +0000
Subject: Upgrade to CGI-3.11, with some modifications for Pod differences in
 bleadperl.

p4raw-id: //depot/perl@25626
---
 lib/CGI.pm        | 84 ++++++++++++++++++++++++++++++++++++++-----------------
 lib/CGI/Changes   | 10 +++++++
 lib/CGI/Cookie.pm |  4 +--
 3 files changed, 70 insertions(+), 28 deletions(-)

(limited to 'lib')

diff --git a/lib/CGI.pm b/lib/CGI.pm
index ff9db9b740..f5ecc2d3b2 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -18,8 +18,8 @@ use Carp 'croak';
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.181 2005/05/13 21:45:26 lstein Exp $';
-$CGI::VERSION='3.10_01';
+$CGI::revision = '$Id: CGI.pm,v 1.185 2005/08/03 21:14:55 lstein Exp $';
+$CGI::VERSION='3.11_01';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -231,7 +231,8 @@ if ($needs_binmode) {
 			  submit reset defaults radio_group popup_menu button autoEscape
 			  scrolling_list image_button start_form end_form startform endform
 			  start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
-		':cgi'=>[qw/param upload path_info path_translated url self_url script_name cookie Dump
+		':cgi'=>[qw/param upload path_info path_translated request_uri url self_url script_name 
+			 cookie Dump
 			 raw_cookie request_method query_string Accept user_agent remote_host content_type
 			 remote_addr referer server_name server_software server_port server_protocol virtual_port
 			 virtual_host remote_ident auth_type http append
@@ -1134,7 +1135,7 @@ END_OF_FUNC
 ####
 'append' => <<'EOF',
 sub append {
-    my($self,@p) = @_;
+    my($self,@p) = self_or_default(@_);
     my($name,$value) = rearrange([NAME,[VALUE,VALUES]],@p);
     my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
     if (@values) {
@@ -2609,18 +2610,6 @@ sub url {
     my $path = $self->path_info;
     my $script_name = $self->script_name;
 
-    # for compatibility with Apache's MultiViews
-    if (exists($ENV{REQUEST_URI})) {
-        my $index;
-	$script_name = unescape($ENV{REQUEST_URI});
-        $script_name =~ s/\?.+$//s;   # strip query string
-        # and path
-        if (exists($ENV{PATH_INFO})) {
-           my $encoded_path = unescape($ENV{PATH_INFO});
-           $script_name      =~ s/\Q$encoded_path\E$//i;
-         }
-    }
-
     if ($full) {
 	my $protocol = $self->protocol();
 	$url = "$protocol://";
@@ -2738,9 +2727,8 @@ sub path_info {
 	$info = "/$info" if $info ne '' &&  substr($info,0,1) ne '/';
 	$self->{'.path_info'} = $info;
     } elsif (! defined($self->{'.path_info'}) ) {
-	$self->{'.path_info'} = defined($ENV{'PATH_INFO'}) ? 
-	    $ENV{'PATH_INFO'} : '';
-
+        my (undef,$path_info) = $self->_name_and_path_from_env;
+	$self->{'.path_info'} = $path_info || '';
 	# hack to fix broken path info in IIS
 	$self->{'.path_info'} =~ s/^\Q$ENV{'SCRIPT_NAME'}\E// if $IIS;
 
@@ -2749,6 +2737,33 @@ sub path_info {
 }
 END_OF_FUNC
 
+# WE USE THIS TO COMPENSATE FOR A BUG IN APACHE 2 PRESENT AT LEAST UP THROUGH 2.0.54
+'_name_and_path_from_env' => <<'END_OF_FUNC',
+sub _name_and_path_from_env {
+   my $self = shift;
+   my $raw_script_name = $ENV{SCRIPT_NAME} || '';
+   my $raw_path_info   = $ENV{PATH_INFO}   || '';
+   my $uri             = $ENV{REQUEST_URI} || '';
+
+   my @uri_double_slashes  = $uri =~ m^(/{2,}?)^g;
+   my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
+
+   my $apache_bug      = @uri_double_slashes != @path_double_slashes;
+   return ($raw_script_name,$raw_path_info) unless $apache_bug;
+
+   my $path_info_search = $raw_path_info;
+   # these characters will not (necessarily) be escaped
+   $path_info_search    =~ s/([^a-zA-Z0-9$()':_.,+*\/;?=&-])/uc sprintf("%%%02x",ord($1))/eg;
+   $path_info_search    = quotemeta($path_info_search);
+   $path_info_search    =~ s!/!/+!g;
+   if ($uri =~ m/^(.+)($path_info_search)/) {
+       return ($1,$2);
+   } else {
+       return ($raw_script_name,$raw_path_info);
+   }
+}
+END_OF_FUNC
+
 
 #### Method: request_method
 # Returns 'POST', 'GET', 'PUT' or 'HEAD'
@@ -2779,6 +2794,16 @@ sub path_translated {
 END_OF_FUNC
 
 
+#### Method: request_uri
+# Return the literal request URI
+####
+'request_uri' => <<'END_OF_FUNC',
+sub request_uri {
+    return $ENV{'REQUEST_URI'};
+}
+END_OF_FUNC
+
+
 #### Method: query_string
 # Synthesize a query string from our current
 # parameters
@@ -2934,10 +2959,14 @@ END_OF_FUNC
 ####
 'script_name' => <<'END_OF_FUNC',
 sub script_name {
-    return $ENV{'SCRIPT_NAME'} if defined($ENV{'SCRIPT_NAME'});
-    # These are for debugging
-    return "/$0" unless $0=~/^\//;
-    return $0;
+    my ($self,@p) = self_or_default(@_);
+    if (@p) {
+        $self->{'.script_name'} = shift;
+    } elsif (!exists $self->{'.script_name'}) {
+        my ($script_name,$path_info) = $self->_name_and_path_from_env();
+        $self->{'.script_name'} = $script_name;
+    }
+    return $self->{'.script_name'};
 }
 END_OF_FUNC
 
@@ -3876,9 +3905,12 @@ CGI - Simple Common Gateway Interface Class
         hr;
 
    if (param()) {
-       print "Your name is",em(param('name')),p,
-	     "The keywords are: ",em(join(", ",param('words'))),p,
-	     "Your favorite color is ",em(param('color')),
+       my $name      = param('name');
+       my $keywords  = join ', ',param('words');
+       my $color     = param('color');
+       print "Your name is",em(escapeHTML($name)),p,
+	     "The keywords are: ",em(escapeHTML($keywords)),p,
+	     "Your favorite color is ",em(escapeHTML($color)),
 	     hr;
    }
 
diff --git a/lib/CGI/Changes b/lib/CGI/Changes
index 467ee641ff..e4699338c0 100644
--- a/lib/CGI/Changes
+++ b/lib/CGI/Changes
@@ -1,3 +1,13 @@
+  Version 3.11
+    1. Killed warning in CGI::Cookie about MOD_PERL_API_VERSION
+    2. Fixed append() so that it works in function mode.
+    3. Workaround for a bug that appears in Apache2 versions through 2.0.54 
+       in which SCRIPT_NAME and PATH_INFO are incorrect if the additional path_info
+       contains a double slash. This workaround will handle the common case of
+       http://mysite.com/cgi-bin/log.cgi/http://www.some.other.site/args, but will
+       not handle the uncommon case of a ScriptAlias directive that adds additional
+       path information to the end of the translated URI.
+
   Version 3.10
     1. Added Apache2::RequestIO, which is necessary for mp2 interoperability.
 
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 164b5ecbad..0b915f0aad 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -13,7 +13,7 @@ package CGI::Cookie;
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-$CGI::Cookie::VERSION='1.25';
+$CGI::Cookie::VERSION='1.26';
 
 use CGI::Util qw(rearrange unescape escape);
 use overload '""' => \&as_string,
@@ -23,7 +23,7 @@ use overload '""' => \&as_string,
 # Turn on special checking for Doug MacEachern's modperl
 my $MOD_PERL = 0;
 if (exists $ENV{MOD_PERL}) {
-  if ($ENV{MOD_PERL_API_VERSION} == 2) {
+  if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
       $MOD_PERL = 2;
       require Apache2::RequestUtil;
       require APR::Table;
-- 
cgit v1.2.1