Upgrade to CGI.pm-3.21

p4raw-id: //depot/perl@28746

3 files changed, 54 insertions, 19 deletions

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 15f1be56c2..8a64d0e01d 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -19,7 +19,7 @@ use Carp 'croak';
 #   http://stein.cshl.org/WWW/software/CGI/
 
 $CGI::revision = '$Id: CGI.pm,v 1.208 2006/04/23 14:25:14 lstein Exp $';
-$CGI::VERSION='3.20_01';
+$CGI::VERSION='3.21';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -434,7 +434,7 @@ sub param {
 	    }
 	}
 	# If values is provided, then we set it.
-	if (defined $value) {
+	if (@values or defined $value) {
 	    $self->add_parameter($name);
 	    $self->{$name}=[@values];
 	}
@@ -443,7 +443,16 @@ sub param {
     }
 
     return unless defined($name) && $self->{$name};
-    return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
+
+    my $charset = $self->charset || '';
+    my $utf8    = $charset eq 'utf-8';
+    if ($utf8) {
+      eval "require Encode; 1;" if $utf8 && !Encode->can('decode'); # bring in these functions
+      return wantarray ? map {Encode::decode(utf8=>$_) } @{$self->{$name}} 
+                       : Encode::decode(utf8=>$self->{$name}->[0]);
+    } else {
+      return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
+    }
 }
 
 sub self_or_default {
@@ -515,17 +524,10 @@ sub init {
 
       # avoid unreasonably large postings
       if (($POST_MAX > 0) && ($content_length > $POST_MAX)) {
-	# quietly read and discard the post
-	  my $buffer;
-          my $tmplength = $content_length;
-          while($tmplength > 0) {
-                 my $maxbuffer = ($tmplength < 10000)?$tmplength:10000;
-                 my $bytesread = $MOD_PERL ? $self->r->read($buffer,$maxbuffer) : read(STDIN,$buffer,$maxbuffer);
-                 $tmplength -= $bytesread;
-          }
-          $self->cgi_error("413 Request entity too large");
-          last METHOD;
-       }
+	#discard the post, unread
+	$self->cgi_error("413 Request entity too large");
+	last METHOD;
+      }
 
       # Process multipart postings, but only if the initializer is
       # not defined.
@@ -2690,8 +2692,8 @@ END_OF_FUNC
 'cookie' => <<'END_OF_FUNC',
 sub cookie {
     my($self,@p) = self_or_default(@_);
-    my($name,$value,$path,$domain,$secure,$expires) =
-	rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
+    my($name,$value,$path,$domain,$secure,$expires,$httponly) =
+	rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@p);
 
     require CGI::Cookie;
 
@@ -2719,6 +2721,7 @@ sub cookie {
     push(@param,'-path'=>$path) if $path;
     push(@param,'-expires'=>$expires) if $expires;
     push(@param,'-secure'=>$secure) if $secure;
+    push(@param,'-httponly'=>$httponly) if $httponly;
 
     return new CGI::Cookie(@param);
 }
diff --git a/lib/CGI/Changes b/lib/CGI/Changes
index cc2d1a30b1..4b934ee23e 100644
--- a/lib/CGI/Changes
+++ b/lib/CGI/Changes
@@ -1,3 +1,9 @@
+  Version 3.21
+  1. Don't try to read data at all when POST > $POST_MAX.
+  2. Fixed bug that caused $cgi->param('name',undef,'value') to unset param('name') entirely.
+  3. Fixed bug in which upload() sometimes returns empty. (CPAN bug #12694).
+  4. Incorporated patch from BURAK@cpan.org to support HTTPcookies (CPAN bug 21019).
+
   Version 3.20
   1. Patch from David Wheeler for CGI::Cookie->bake(). Uses mod_perl headers_out->add()
 	rather than headers_out->set().
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index f4ba148946..926109ce3c 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -116,8 +116,8 @@ sub new {
   # Ignore mod_perl request object--compatability with Apache::Cookie.
   shift if ref $_[0]
         && eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
-  my($name,$value,$path,$domain,$secure,$expires) =
-    rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+  my($name,$value,$path,$domain,$secure,$expires,$httponly) =
+    rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@_);
   
   # Pull out our parameters.
   my @values;
@@ -146,6 +146,7 @@ sub new {
   $self->domain($domain) if defined $domain;
   $self->secure($secure) if defined $secure;
   $self->expires($expires) if defined $expires;
+  $self->httponly($httponly) if defined $httponly;
 #  $self->max_age($expires) if defined $expires;
   return $self;
 }
@@ -154,13 +155,14 @@ sub as_string {
     my $self = shift;
     return "" unless $self->name;
 
-    my(@constant_values,$domain,$path,$expires,$max_age,$secure);
+    my(@constant_values,$domain,$path,$expires,$max_age,$secure,$httponly);
 
     push(@constant_values,"domain=$domain")   if $domain = $self->domain;
     push(@constant_values,"path=$path")       if $path = $self->path;
     push(@constant_values,"expires=$expires") if $expires = $self->expires;
     push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age;
     push(@constant_values,"secure") if $secure = $self->secure;
+    push(@constant_values,"HttpOnly") if $httponly = $self->httponly;
 
     my($key) = escape($self->name);
     my($cookie) = join("=",(defined $key ? $key : ''),join("&",map escape(defined $_ ? $_ : ''),$self->value));
@@ -251,6 +253,14 @@ sub path {
     return $self->{'path'};
 }
 
+
+sub httponly { # HttpOnly
+    my $self     = shift;
+    my $httponly = shift;
+    $self->{'httponly'} = $httponly if defined $httponly;
+    return $self->{'httponly'};
+}
+
 1;
 
 =head1 NAME
@@ -337,6 +347,19 @@ that all scripts at your site will receive the cookie.
 If the "secure" attribute is set, the cookie will only be sent to your
 script if the CGI request is occurring on a secure channel, such as SSL.
 
+=item B<4. httponly flag>
+
+If the "httponly" attribute is set, the cookie will only be accessible
+through HTTP Requests. This cookie will be inaccessible via JavaScript
+(to prevent XSS attacks).
+
+But, currently this feature only used and recognised by 
+MS Internet Explorer 6 Service Pack 1 and later.
+
+See this URL for more information:
+
+L<http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp>
+
 =back
 
 =head2 Creating New Cookies
@@ -371,6 +394,9 @@ pages at your site.
 B<-secure> if set to a true value instructs the browser to return the
 cookie only when a cryptographic protocol is in use.
 
+B<-httponly> if set to a true value, the cookie will not be accessible
+via JavaScript.
+
 For compatibility with Apache::Cookie, you may optionally pass in
 a mod_perl request object as the first argument to C<new()>. It will
 simply be ignored: