Change 30131 by [EMAIL PROTECTED] on 2007/02/05 17:13:40
Integrate:
[ 27202]
Upgrade to CGI-3.16, with version bump on CGI.pm for documentation
fixes not yet integrated.
[ 27255]
Subject: Patches: B, CGI, ExtUtils::MM_Unix
From: "Joshua ben Jore" <[EMAIL PROTECTED]>
Date: Sun, 19 Feb 2006 02:58:10 -0600
Message-ID: <[EMAIL PROTECTED]>
[ 27354]
Upgrade to CGI.pm-3.17, but continuing the version bump for
unintegrated changes.
[ 27873]
Upgrade to CGI.pm-3.19.
[ 28082]
Upgrade to CGI-3.20
[ 28732]
Fix to problem where CGI can lose the filehandle during an upload.
Patch posted to the Debian bug list by Eric Wong
<[EMAIL PROTECTED]>.
[ 28746]
Upgrade to CGI.pm-3.21
[ 28752]
Upgrade to CGI.pm-3.22.
[ 28930]
Upgrade to CGI.pm-3.25
Affected files ...
... //depot/maint-5.8/perl/AUTHORS#41 integrate
... //depot/maint-5.8/perl/lib/CGI.pm#17 integrate
... //depot/maint-5.8/perl/lib/CGI/Carp.pm#11 integrate
... //depot/maint-5.8/perl/lib/CGI/Changes#5 integrate
... //depot/maint-5.8/perl/lib/CGI/Cookie.pm#10 integrate
... //depot/maint-5.8/perl/lib/CGI/Fast.pm#6 integrate
... //depot/maint-5.8/perl/lib/CGI/Util.pm#9 integrate
... //depot/maint-5.8/perl/lib/CGI/t/cookie.t#3 integrate
... //depot/maint-5.8/perl/lib/CGI/t/function.t#3 integrate
... //depot/maint-5.8/perl/lib/CGI/t/html.t#6 integrate
Differences ...
==== //depot/maint-5.8/perl/AUTHORS#41 (text) ====
Index: perl/AUTHORS
--- perl/AUTHORS#40~29759~ 2007-01-11 08:45:05.000000000 -0800
+++ perl/AUTHORS 2007-02-05 09:13:40.000000000 -0800
@@ -438,6 +438,7 @@
Jose Auguste-Etienne <[EMAIL PROTECTED]>
Joseph N. Hall <[EMAIL PROTECTED]>
Joseph S. Myers <[EMAIL PROTECTED]>
+Joshua ben Jore <[EMAIL PROTECTED]>
Joshua E. Rodd <[EMAIL PROTECTED]>
Joshua Pritikin <[EMAIL PROTECTED]>
Joost van Baal <[EMAIL PROTECTED]>
==== //depot/maint-5.8/perl/lib/CGI.pm#17 (text) ====
Index: perl/lib/CGI.pm
--- perl/lib/CGI.pm#16~26720~ 2006-01-08 08:53:41.000000000 -0800
+++ perl/lib/CGI.pm 2007-02-05 09:13:40.000000000 -0800
@@ -18,8 +18,8 @@
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.194 2005/12/06 22:12:56 lstein Exp $';
-$CGI::VERSION='3.15';
+$CGI::revision = '$Id: CGI.pm,v 1.221 2006/09/28 17:04:10 lstein Exp $';
+$CGI::VERSION='3.25';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -40,6 +40,7 @@
$MOD_PERL = 0; # no mod_perl by default
@SAVED_SYMBOLS = ();
+
# >>>>> Here are some globals that you might want to adjust <<<<<<
sub initialize_globals {
# Set this to 1 to enable copious autoloader debugging messages
@@ -329,6 +330,10 @@
my $self = {};
bless $self,ref $class || $class || $DefaultClass;
+
+ # always use a tempfile
+ $self->{'use_tempfile'} = 1;
+
if (ref($initializer[0])
&& (UNIVERSAL::isa($initializer[0],'Apache')
||
@@ -339,6 +344,7 @@
if (ref($initializer[0])
&& (UNIVERSAL::isa($initializer[0],'CODE'))) {
$self->upload_hook(shift @initializer, shift @initializer);
+ $self->{'use_tempfile'} = shift @initializer if (@initializer > 0);
}
if ($MOD_PERL) {
if ($MOD_PERL == 1) {
@@ -392,9 +398,10 @@
} else {
$self = shift;
}
- my ($hook,$data) = @_;
+ my ($hook,$data,$use_tempfile) = @_;
$self->{'.upload_hook'} = $hook;
$self->{'.upload_data'} = $data;
+ $self->{'use_tempfile'} = $use_tempfile if defined $use_tempfile;
}
#### Method: param
@@ -427,7 +434,7 @@
}
}
# If values is provided, then we set it.
- if (@values) {
+ if (@values or defined $value) {
$self->add_parameter($name);
$self->[EMAIL PROTECTED];
}
@@ -436,7 +443,16 @@
}
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 {
@@ -508,17 +524,10 @@
# 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.
@@ -1418,11 +1427,15 @@
'ATTACHMENT','P3P'],@p);
$nph ||= $NPH;
+
+ $type ||= 'text/html' unless defined($type);
+
if (defined $charset) {
$self->charset($charset);
} else {
- $charset = $self->charset;
+ $charset = $self->charset if $type =~ /^text\//;
}
+ $charset ||= '';
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
@@ -1432,8 +1445,11 @@
($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ':
'.$self->unescapeHTML($value)/e;
}
- $type ||= 'text/html' unless defined($type);
- $type .= "; charset=$charset" if $type ne '' and $type =~ m!^text/! and
$type !~ /\bcharset\b/ and $charset ne '';
+ $type .= "; charset=$charset"
+ if $type ne ''
+ and $type !~ /\bcharset\b/
+ and defined $charset
+ and $charset ne '';
# Maybe future compatibility. Maybe not.
my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
@@ -1499,7 +1515,7 @@
my($self,@p) = self_or_default(@_);
my($url,$target,$status,$cookie,$nph,@other) =
rearrange([[LOCATION,URI,URL],TARGET,STATUS,['COOKIE','COOKIES'],NPH],@p);
- $status = '302 Moved' unless defined $status;
+ $status = '302 Found' unless defined $status;
$url ||= $self->self_url;
my(@o);
foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
@@ -1546,7 +1562,7 @@
$self->element_id(0);
$self->element_tab(0);
- $encoding = 'iso-8859-1' unless defined $encoding;
+ $encoding = lc($self->charset) unless defined $encoding;
# Need to sort out the DTD before it's okay to call escapeHTML().
my(@result,$xml_dtd);
@@ -1637,6 +1653,7 @@
my ($self,$style) = @_;
my (@result);
my $type = 'text/css';
+ my $rel = 'stylesheet';
my $cdata_start = $XHTML ? "\n<!--/* <![CDATA[ */" : "\n<!-- ";
my $cdata_end = $XHTML ? "\n/* ]]> */-->\n" : " -->\n";
@@ -1645,25 +1662,26 @@
for my $s (@s) {
if (ref($s)) {
- my($src,$code,$verbatim,$stype,$foo,@other) =
- rearrange([qw(SRC CODE VERBATIM TYPE FOO)],
+ my($src,$code,$verbatim,$stype,$alternate,$foo,@other) =
+ rearrange([qw(SRC CODE VERBATIM TYPE ALTERNATE FOO)],
('-foo'=>'bar',
ref($s) eq 'ARRAY' ? @$s : %$s));
$type = $stype if $stype;
+ $rel = 'alternate stylesheet' if $alternate;
my $other = @other ? join ' ',@other : '';
if (ref($src) eq "ARRAY") # Check to see if the $src variable is an
array reference
{ # If it is, push a LINK tag for each one
foreach $src (@$src)
{
- push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type"
href="$src" $other/>)
- : qq(<link rel="stylesheet" type="$type"
href="$src"$other>)) if $src;
+ push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src"
$other/>)
+ : qq(<link rel="$rel" type="$type"
href="$src"$other>)) if $src;
}
}
else
{ # Otherwise, push the single -src, if it exists.
- push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type"
href="$src" $other/>)
- : qq(<link rel="stylesheet" type="$type"
href="$src"$other>)
+ push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src"
$other/>)
+ : qq(<link rel="$rel" type="$type"
href="$src"$other>)
) if $src;
}
if ($verbatim) {
@@ -1675,8 +1693,8 @@
} else {
my $src = $s;
- push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type"
href="$src" $other/>)
- : qq(<link rel="stylesheet" type="$type"
href="$src"$other>));
+ push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src"
$other/>)
+ : qq(<link rel="$rel" type="$type"
href="$src"$other>));
}
}
@result;
@@ -1782,7 +1800,7 @@
$action = $self->escapeHTML($action);
}
else {
- $action = $self->escapeHTML($self->request_uri);
+ $action = $self->escapeHTML($self->request_uri || $self->self_url);
}
$action = qq(action="$action");
my($other) = @other ? " @other" : '';
@@ -1812,9 +1830,7 @@
sub start_multipart_form {
my($self,@p) = self_or_default(@_);
if (defined($p[0]) && substr($p[0],0,1) eq '-') {
- my(%p) = @p;
- $p{'-enctype'}=&MULTIPART;
- return $self->startform(%p);
+ return $self->startform(-enctype=>&MULTIPART,@p);
} else {
my($method,$action,@other) =
rearrange([METHOD,ACTION],@p);
@@ -2386,13 +2402,13 @@
}
}
else {
- my $attribs = $self->_set_attributes($_, $attributes);
- my($selectit) = defined($selected) ? $self->_selected($selected eq $_)
: '';
- my($label) = $_;
- $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
- my($value) = $self->escapeHTML($_);
- $label=$self->escapeHTML($label,1);
- $result .= "<option
$selectit${attribs}value=\"$value\">$label</option>\n";
+ my $attribs = $self->_set_attributes($_, $attributes);
+ my($selectit) = defined($selected) ? $self->_selected($selected eq
$_) : '';
+ my($label) = $_;
+ $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
+ my($value) = $self->escapeHTML($_);
+ $label=$self->escapeHTML($label,1);
+ $result .= "<option${attribs}
${selectit}value=\"$value\">$label</option>\n";
}
}
@@ -2577,7 +2593,7 @@
my($name,$src,$alignment,@other) =
rearrange([NAME,SRC,ALIGN],@p);
- my($align) = $alignment ? " align=\U\"$alignment\"" : '';
+ my($align) = $alignment ? " align=\L\"$alignment\"" : '';
my($other) = @other ? " @other" : '';
$name=$self->escapeHTML($name);
return $XHTML ? qq(<input type="image" name="$name" src="$src"$align$other
/>)
@@ -2624,7 +2640,7 @@
my $path = $self->path_info;
my $script_name = $self->script_name;
- my $request_uri = $self->request_uri || '';
+ my $request_uri = unescape($self->request_uri) || '';
my $query_str = $self->query_string;
my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/;
@@ -2632,7 +2648,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/\Q$path\E$// if defined $path; # remove path
if ($full) {
my $protocol = $self->protocol();
@@ -2650,7 +2666,7 @@
return $url if $base;
$url .= $uri;
} elsif ($relative) {
- ($url) = $script_name =~ m!([^/]+)$!;
+ ($url) = $uri =~ m!([^/]+)$!;
} elsif ($absolute) {
$url = $uri;
}
@@ -2678,8 +2694,8 @@
'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;
@@ -2707,6 +2723,7 @@
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);
}
@@ -2752,9 +2769,6 @@
} elsif (! defined($self->{'.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;
-
}
return $self->{'.path_info'};
}
@@ -2766,11 +2780,10 @@
my $self = shift;
my $raw_script_name = $ENV{SCRIPT_NAME} || '';
my $raw_path_info = $ENV{PATH_INFO} || '';
- my $uri = $ENV{REQUEST_URI} || '';
+ my $uri = unescape($self->request_uri) || '';
- if ($raw_script_name =~ m/$raw_path_info$/) {
- $raw_script_name =~ s/$raw_path_info$//;
- }
+ my $protected = quotemeta($raw_path_info);
+ $raw_script_name =~ s/$protected$//;
my @uri_double_slashes = $uri =~ m^(/{2,}?)^g;
my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
@@ -2778,10 +2791,7 @@
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);
+ my $path_info_search = quotemeta($raw_path_info);
$path_info_search =~ s!/!/+!g;
if ($uri =~ m/^(.+)($path_info_search)/) {
return ($1,$2);
@@ -3308,11 +3318,11 @@
return;
}
- my($param)= $header{'Content-Disposition'}=~/ name="([^;]*)"/;
+ my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
$param .= $TAINTED;
# Bug: Netscape doesn't escape quotation marks in file names!!!
- my($filename) = $header{'Content-Disposition'}=~/ filename="([^;]*)"/;
+ my($filename) = $header{'Content-Disposition'}=~/ filename="([^"]*)"/;
# Test for Opera's multiple upload feature
my($multipart) = ( defined( $header{'Content-Type'} ) &&
$header{'Content-Type'} =~ /multipart\/mixed/ ) ?
@@ -3378,7 +3388,7 @@
$totalbytes += length($data);
&{$self->{'.upload_hook'}}($filename ,$data, $totalbytes,
$self->{'.upload_data'});
}
- print $filehandle $data;
+ print $filehandle $data if ($self->{'use_tempfile'});
}
# back up to beginning of file
@@ -3411,7 +3421,7 @@
'upload' =><<'END_OF_FUNC',
sub upload {
my($self,$param_name) = self_or_default(@_);
- my @param = grep(ref && fileno($_), $self->param($param_name));
+ my @param = grep {ref($_) && defined(fileno($_))}
$self->param($param_name);
return unless @param;
return wantarray ? @param : $param[0];
}
@@ -5879,7 +5889,7 @@
that the first argument to the callback is an Apache::Upload object,
here it's the remote filename.
- $q = CGI->new(\&hook,$data);
+ $q = CGI->new(\&hook [,$data [,$use_tempfile]]);
sub hook
{
@@ -5887,10 +5897,19 @@
print "Read $bytes_read bytes of $filename\n";
}
+The $data field is optional; it lets you pass configuration
+information (e.g. a database handle) to your hook callback.
+
+The $use_tempfile field is a flag that lets you turn on and off
+CGI.pm's use of a temporary disk-based file during file upload. If you
+set this to a FALSE value (default true) then param('uploaded_file')
+will no longer work, and the only way to get at the uploaded data is
+via the hook you provide.
+
If using the function-oriented interface, call the CGI::upload_hook()
method before calling param() or any other CGI functions:
- CGI::upload_hook(\&hook,$data);
+ CGI::upload_hook(\&hook [,$data [,$use_tempfile]]);
This method is not exported by default. You will have to import it
explicitly if you wish to use it without the CGI:: prefix.
@@ -6032,7 +6051,7 @@
=item 5.
An optional fifth parameter (-novals) can be set to a true value and
-indicates to suppress the val attribut in each option element within
+indicates to suppress the val attribute in each option element within
the optgroup.
See the discussion on optgroup at W3C
@@ -6647,6 +6666,7 @@
The cookie created by cookie() must be incorporated into the HTTP
header within the string returned by the header() method:
+ use CGI ':standard';
print header(-cookie=>$my_cookie);
To create multiple cookies, give header() an array reference:
@@ -6658,12 +6678,13 @@
print header(-cookie=>[$cookie1,$cookie2]);
To retrieve a cookie, request it by name by calling cookie() method
-without the B<-value> parameter:
+without the B<-value> parameter. This example uses the object-oriented
+form:
use CGI;
$query = new CGI;
- $riddle = cookie('riddle_name');
- %answers = cookie('answers');
+ $riddle = $query->cookie('riddle_name');
+ %answers = $query->cookie('answers');
Cookies created with a single scalar value, such as the "riddle_name"
cookie, will be returned in that form. Cookies with array and hash
@@ -6679,6 +6700,11 @@
# vice-versa
param(-name=>'answers',-value=>[cookie('answers')]);
+If you call cookie() without any parameters, it will return a list of
+the names of all cookies passed to your script:
+
+ @cookies = cookie();
+
See the B<cookie.cgi> example script for some ideas on how to use
cookies effectively.
@@ -6701,7 +6727,7 @@
in CGI.pm, but the HTML is very simple to write. See the frame
documentation in Netscape's home pages for details
- http://home.netscape.com/assist/net_sites/frames.html
+ http://wp.netscape.com/assist/net_sites/frames.html
=item 2. Specify the destination for the document in the HTTP header
@@ -6739,7 +6765,7 @@
called JavaScript. Internet Explorer, 3.0 and higher, supports a
closely-related dialect called JScript. JavaScript isn't the same as
Java, and certainly isn't at all the same as Perl, which is a great
-pity. JavaScript allows you to programatically change the contents of
+pity. JavaScript allows you to programmatically change the contents of
fill-out forms, create new windows, and pop up dialog box from within
Netscape itself. From the point of view of CGI scripting, JavaScript
is quite useful for validating fill-out forms prior to submitting
@@ -6993,6 +7019,14 @@
Link({-rel=>'stylesheet',-type=>'text/css',-src=>'/ss/fred.css',-media=>'paper'}));
print start_html({-head=>[EMAIL PROTECTED])
+To create primary and "alternate" stylesheet, use the B<-alternate> option:
+
+ start_html(-style=>{-src=>[
+ {-src=>'/styles/print.css'},
+ {-src=>'/styles/alt.css',-alternate=>1}
+ ]
+ });
+
=head1 DEBUGGING
If you are running the script from the command line or in the perl
==== //depot/maint-5.8/perl/lib/CGI/Carp.pm#11 (text) ====
Index: perl/lib/CGI/Carp.pm
--- perl/lib/CGI/Carp.pm#10~26720~ 2006-01-08 08:53:41.000000000 -0800
+++ perl/lib/CGI/Carp.pm 2007-02-05 09:13:40.000000000 -0800
@@ -102,7 +102,7 @@
=head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
-If you want to send fatal (die, confess) errors to the browser, ask to
+If you want to send fatal (die, confess) errors to the browser, ask to
import the special "fatalsToBrowser" subroutine:
use CGI::Carp qw(fatalsToBrowser);
@@ -114,6 +114,9 @@
Nonfatal errors will still be directed to the log file only (unless redirected
with carpout).
+Note that fatalsToBrowser does B<not> work with mod_perl version 2.0
+and higher.
+
=head2 Changing the default message
By default, the software error message is followed by a note to
@@ -204,6 +207,9 @@
=head1 CHANGE LOG
+1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp
+ not behaving correctly in an eval() context.
+
1.05 carpout() added and minor corrections by Marc Hedlund
<[EMAIL PROTECTED]> on 11/26/95.
@@ -290,7 +296,6 @@
my $pkg = shift;
my(%routines);
my(@name);
-
if (@name=grep(/^name=/,@_))
{
my($n) = (split(/=/,$name[0]))[1];
@@ -382,7 +387,18 @@
sub die {
my ($arg,@rest) = @_;
- realdie ($arg,@rest) if ineval();
+
+ if ( ineval() ) {
+ if (!ref($arg)) {
+ $arg = join("",($arg,@rest)) || "Died";
+ my($file,$line,$id) = id(1);
+ $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
+ realdie($arg);
+ }
+ else {
+ realdie($arg,@rest);
+ }
+ }
if (!ref($arg)) {
$arg = join("", ($arg,@rest));
==== //depot/maint-5.8/perl/lib/CGI/Changes#5 (text) ====
Index: perl/lib/CGI/Changes
--- perl/lib/CGI/Changes#4~26720~ 2006-01-08 08:53:41.000000000 -0800
+++ perl/lib/CGI/Changes 2007-02-05 09:13:40.000000000 -0800
@@ -1,3 +1,59 @@
+ Version 3.25
+ 1. Fixed the link to the Netscape frames page.
+ 2. Added ability to specify an alternate stylesheet.
+
+ Version 3.24
+ 1. In startform(), if request_uri() returns undef, then falls back
+ to self_url(). This should rarely happen except when run outside of
+ the CGI environment.
+ 2. image button alignment options were mistakenly being capitalized, causing
xhtml validation to fail.
+
+ Version 3.23
+ 1. Typo in upload() persisted, now fixed for real. Thanks to
+ Emanuele Zeppieri for correct patch and regression test.
+
+ Version 3.22
+ 1. Typo in upload() function broke uploads. Now fixed (CPAN bug 21126).
+
+ 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 [EMAIL PROTECTED] 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().
+ 2. Fixed problem identified by Andrei Voronkov in which start_form() output
was screwed
+ up when initial argument begins with a dash and subsequent arguments do
not.
+ 3. Quashed uninitialized variable warnings coming from script_name(), url()
and other
+ functions that require access to the PATH_INFO environment variable.
+
+ Version 3.19
+ 1. Added patch from Stephen Frost that allows one to suppress use of the
temp file that is
+ created during uploads.
+ 2. Fixed problem noted by Martin Foster in which regular expression
meta-character terms
+ in the path information were not quoted, causing URL parsing
+ to fail on URLs that contained metacharacters (such as +).
+ 3. More fixes to the url() method.
+ 4. Removed "hack to fix broken PATH_INFO in MSII".
+
+ Version 3.18
+ 1. Doc typo fixes.
+ 2. Patch from Steve Peters to default the document type to match the
charset.
+ 3. Fixed param() so that param(-name=>'foo',-values=>[]) sets the parameter
to empty list.
+
+ Version 3.16 Wed Feb 8 13:29:11 EST 2006
+ 1. header() -charset option now works even when the MIME type is not "text".
+ 2. Fixed documentation for cookie() function and fastCGI.
+ 3. Upload filehandles now only closed automatically on Windows systems.
+ 4. Apache::Cookie compatibility fix from David Wheeler
+ 5. CGI::Carp->fatalsToBrowser() does not work correctly with
+ mod_perl 2. No workaround is known.
+ 6. Fixed text status code associated with 302 redirects. Should be "Found"
+ but was "Moved".
+ 7. Fixed charset in start_html() and header() to be in synch.
+
Version 3.15 Wed Dec 7 15:13:22 EST 2005
1. Remove extraneous "?" from self_url() when URI contains a ? but no query
string.
==== //depot/maint-5.8/perl/lib/CGI/Cookie.pm#10 (text) ====
Index: perl/lib/CGI/Cookie.pm
--- perl/lib/CGI/Cookie.pm#9~26720~ 2006-01-08 08:53:41.000000000 -0800
+++ perl/lib/CGI/Cookie.pm 2007-02-05 09:13:40.000000000 -0800
@@ -13,9 +13,10 @@
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
-$CGI::Cookie::VERSION='1.26';
+$CGI::Cookie::VERSION='1.27';
use CGI::Util qw(rearrange unescape escape);
+use CGI;
use overload '""' => \&as_string,
'cmp' => \&compare,
'fallback'=>1;
@@ -112,8 +113,11 @@
sub new {
my $class = shift;
$class = ref($class) if ref($class);
- my($name,$value,$path,$domain,$secure,$expires) =
- rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+ # 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,$httponly) =
+ rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@_);
# Pull out our parameters.
my @values;
@@ -142,6 +146,7 @@
$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;
}
@@ -150,16 +155,17 @@
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("=",($key||''),join("&",map
escape($_||''),$self->value));
+ my($cookie) = join("=",(defined $key ? $key : ''),join("&",map
escape(defined $_ ? $_ : ''),$self->value));
return join("; ",$cookie,@constant_values);
}
@@ -169,6 +175,22 @@
return "$self" cmp $value;
}
+sub bake {
+ my ($self, $r) = @_;
+
+ $r ||= eval {
+ $MOD_PERL == 2
+ ? Apache2::RequestUtil->request()
+ : Apache->request
+ } if $MOD_PERL;
+ if ($r) {
+ $r->headers_out->add('Set-Cookie' => $self->as_string);
+ } else {
+ print CGI::header(-cookie => $self);
+ }
+
+}
+
# accessors
sub name {
my $self = shift;
@@ -231,6 +253,14 @@
return $self->{'path'};
}
+
+sub httponly { # HttpOnly
+ my $self = shift;
+ my $httponly = shift;
+ $self->{'httponly'} = $httponly if defined $httponly;
+ return $self->{'httponly'};
+}
+
1;
=head1 NAME
@@ -317,11 +347,24 @@
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
- $c = new CGI::Cookie(-name => 'foo',
+ my $c = new CGI::Cookie(-name => 'foo',
-value => 'bar',
-expires => '+3M',
-domain => '.capricorn.com',
@@ -351,11 +394,31 @@
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:
+
+ my $c = new CGI::Cookie($r,
+ -name => 'foo',
+ -value => ['bar','baz']);
+
=head2 Sending the Cookie to the Browser
-Within a CGI script you can send a cookie to the browser by creating
-one or more Set-Cookie: fields in the HTTP header. Here is a typical
-sequence:
+The simplest way to send a cookie to the browser is by calling the bake()
+method:
+
+ $c->bake;
+
+Under mod_perl, pass in an Apache request object:
+
+ $c->bake($r);
+
+If you want to set the cookie yourself, Within a CGI script you can send
+a cookie to the browser by creating one or more Set-Cookie: fields in the
+HTTP header. Here is a typical sequence:
my $c = new CGI::Cookie(-name => 'foo',
-value => ['bar','baz'],
@@ -407,7 +470,7 @@
You may also retrieve cookies that were stored in some external
form using the parse() class method:
- $COOKIES = `cat /usr/tmp/Cookie_stash`;
+ $COOKIES = `cat /some/path/Cookie_stash`;
%cookies = parse CGI::Cookie($COOKIES);
If you are in a mod_perl environment, you can save some overhead by
==== //depot/maint-5.8/perl/lib/CGI/Fast.pm#6 (text) ====
Index: perl/lib/CGI/Fast.pm
--- perl/lib/CGI/Fast.pm#5~22137~ 2004-01-14 05:20:47.000000000 -0800
+++ perl/lib/CGI/Fast.pm 2007-02-05 09:13:40.000000000 -0800
@@ -13,10 +13,7 @@
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
-# The most recent version and complete docs are available at:
-# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
-# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
-$CGI::Fast::VERSION='1.05';
+$CGI::Fast::VERSION='1.07';
use CGI;
use FCGI;
@@ -57,6 +54,7 @@
return undef unless FCGI::accept() >= 0;
}
}
+ CGI->_reset_globals;
return $CGI::Q = $self->SUPER::new($initializer, @param);
}
@@ -94,22 +92,7 @@
=head1 OTHER PIECES OF THE PUZZLE
In order to use CGI::Fast you'll need a FastCGI-enabled Web
-server. Open Market's server is FastCGI-savvy. There are also
-freely redistributable FastCGI modules for NCSA httpd 1.5 and Apache.
-FastCGI-enabling modules for Microsoft Internet Information Server and
-Netscape Communications Server have been announced.
-
-In addition, you'll need a version of the Perl interpreter that has
-been linked with the FastCGI I/O library. Precompiled binaries are
-available for several platforms, including DEC Alpha, HP-UX and
-SPARC/Solaris, or you can rebuild Perl from source with patches
-provided in the FastCGI developer's kit. The FastCGI Perl interpreter
-can be used in place of your normal Perl without ill consequences.
-
-You can find FastCGI modules for Apache and NCSA httpd, precompiled
-Perl interpreters, and the FastCGI developer's kit all at URL:
-
- http://www.fastcgi.com/
+server. See http://www.fastcgi.com/ for details.
=head1 WRITING FASTCGI PERL SCRIPTS
==== //depot/maint-5.8/perl/lib/CGI/Util.pm#9 (text) ====
Index: perl/lib/CGI/Util.pm
--- perl/lib/CGI/Util.pm#8~24144~ 2005-04-03 08:18:11.000000000 -0700
+++ perl/lib/CGI/Util.pm 2007-02-05 09:13:40.000000000 -0800
@@ -261,7 +261,7 @@
$offset = 0;
} elsif ($time=~/^\d+/) {
return $time;
- } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
+ } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy])/) {
$offset = ($mult{$2} || 1)*$1;
} else {
return $time;
==== //depot/maint-5.8/perl/lib/CGI/t/cookie.t#3 (text) ====
Index: perl/lib/CGI/t/cookie.t
--- perl/lib/CGI/t/cookie.t#2~19682~ 2003-06-03 22:22:46.000000000 -0700
+++ perl/lib/CGI/t/cookie.t 2007-02-05 09:13:40.000000000 -0800
@@ -7,7 +7,7 @@
# ensure the blib's are in @INC, else we might use the core CGI.pm
use lib qw(blib/lib blib/arch);
-use Test::More tests => 86;
+use Test::More tests => 96;
use CGI::Util qw(escape unescape);
use POSIX qw(strftime);
@@ -325,3 +325,51 @@
ok(!$c->secure(0), 'secure attribute is cleared');
ok(!$c->secure, 'secure attribute is cleared');
}
+
+#-----------------------------------------------------------------------------
+# Apache2?::Cookie compatibility.
+#-----------------------------------------------------------------------------
+APACHEREQ: {
+ my $r = Apache::Faker->new;
+ isa_ok $r, 'Apache';
+ ok my $c = CGI::Cookie->new(
+ $r,
+ -name => 'Foo',
+ -value => 'Bar',
+ ), 'Pass an Apache object to the CGI::Cookie constructor';
+ isa_ok $c, 'CGI::Cookie';
+ ok $c->bake($r), 'Bake the cookie';
+ ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
+ 'bake() should call headers_out->set()';
+
+ $r = Apache2::Faker->new;
+ isa_ok $r, 'Apache2::RequestReq';
+ ok $c = CGI::Cookie->new(
+ $r,
+ -name => 'Foo',
+ -value => 'Bar',
+ ), 'Pass an Apache::RequestReq object to the CGI::Cookie constructor';
+ isa_ok $c, 'CGI::Cookie';
+ ok $c->bake($r), 'Bake the cookie';
+ ok eq_array( $r->{check}, [ 'Set-Cookie', $c->as_string ]),
+ 'bake() should call headers_out->set()';
+}
+
+
+package Apache::Faker;
+sub new { bless {}, shift }
+sub isa {
+ my ($self, $pkg) = @_;
+ return $pkg eq 'Apache';
+}
+sub headers_out { shift }
+sub add { shift->{check} = [EMAIL PROTECTED]; }
+
+package Apache2::Faker;
+sub new { bless {}, shift }
+sub isa {
+ my ($self, $pkg) = @_;
+ return $pkg eq 'Apache2::RequestReq';
+}
+sub headers_out { shift }
+sub add { shift->{check} = [EMAIL PROTECTED]; }
==== //depot/maint-5.8/perl/lib/CGI/t/function.t#3 (xtext) ====
Index: perl/lib/CGI/t/function.t
--- perl/lib/CGI/t/function.t#2~19682~ 2003-06-03 22:22:46.000000000 -0700
+++ perl/lib/CGI/t/function.t 2007-02-05 09:13:40.000000000 -0800
@@ -4,9 +4,9 @@
# Test ability to retrieve HTTP request info
######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
+use lib '.','..','../blib/lib','../blib/arch';
-BEGIN {$| = 1; print "1..31\n"; }
+BEGIN {$| = 1; print "1..32\n"; }
END {print "not ok 1\n" unless $loaded;}
use Config;
use CGI (':standard','keywords');
@@ -102,10 +102,10 @@
print "ok 23 # Skip\n";
print "ok 24 # Skip\n";
}
-test(25,redirect('http://somewhere.else') eq "Status: 302
Moved${CRLF}Location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
+test(25,redirect('http://somewhere.else') eq "Status: 302
Found${CRLF}Location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
-test(26,$h eq "Status: 302 Moved${CRLF}Location:
http://somewhere.else${CRLF}Content-Type: text/html;
charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
-test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html')
eq "Status: 302 Moved${CRLF}Location:
http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html;
charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(26,$h eq "Status: 302 Found${CRLF}Location:
http://somewhere.else${CRLF}Content-Type: text/html;
charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html')
eq "Status: 302 Found${CRLF}Location:
http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html;
charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
test(28,escapeHTML('CGI') eq 'CGI','escapeHTML(CGI) failing again');
@@ -113,3 +113,5 @@
test(30, !charset("") && header() eq "Content-Type: text/html${CRLF}${CRLF}",
"Empty charset");
test(31, header(-foo=>'bar') eq "Foo: bar${CRLF}Content-Type:
text/html${CRLF}${CRLF}", "Custom header");
+
+test(32, start_form(-action=>'one',name=>'two',onsubmit=>'three') eq qq(<form
method="post" action="one" enctype="multipart/form-data" onsubmit="three"
name="two">\n), "initial dash followed by undashed arguments");
==== //depot/maint-5.8/perl/lib/CGI/t/html.t#6 (xtext) ====
Index: perl/lib/CGI/t/html.t
--- perl/lib/CGI/t/html.t#5~24144~ 2005-04-03 08:18:11.000000000 -0700
+++ perl/lib/CGI/t/html.t 2007-02-05 09:13:40.000000000 -0800
@@ -10,7 +10,7 @@
print "ok 1\n";
BEGIN {
- $| = 1; print "1..27\n";
+ $| = 1; print "1..28\n";
if( $] > 5.006 ) {
# no utf8
require utf8; # we contain Latin-1
@@ -110,3 +110,4 @@
$q->autoEscape(0);
test(26,$q->p({title=>"hello worldè"},'hello á') eq '<p
title="hello worldè">hello á</p>');
test(27,p({title=>"hello worldè"},'hello á') eq '<p title="hello
world&egrave;">hello á</p>');
+test(28,header(-type=>'image/gif',-charset=>'UTF-8') eq "Content-Type:
image/gif; charset=UTF-8${CRLF}${CRLF}","header()");
End of Patch.
