Change 33582 by [EMAIL PROTECTED] on 2008/03/27 11:35:31
Integrate:
[ 32683]
Subject: [perl #37607] CGI file upload file name parsing errors
From: [EMAIL PROTECTED] (Marko Asplund)
Date: Fri, 4 Nov 2005 13:40:05 +0200 (EET)
Message-ID: <[EMAIL PROTECTED]>
[ 32883]
Silence new warning grep in void context warning in various modules and
test files, also silence a warning that came from a previous 'dev' version
number bump.
[ 33094]
Subject: [PATCH] Fix uc/lc warnings in CGI.pm
From: "Jerry D. Hedden" <[EMAIL PROTECTED]>
Date: Mon, 28 Jan 2008 10:19:26 -0500
Message-ID: <[EMAIL PROTECTED]>
[ 33129]
Assorted POD nits from the Debian bug list.
[ 33143]
Subject: Re: [perl #50322] CGITempFile causes "Insecure dependency in
sprintf" in perl 5.10.0
From: "Steffen Mueller via RT" <[EMAIL PROTECTED]>
Date: Mon, 28 Jan 2008 05:16:19 -0800
Message-ID: <[EMAIL PROTECTED]>
Fixes [perl #50322]
[ 33564]
Upgrade to CGI.pm-3.34. There are still a few differences, so adding
a version bump.
[ 33568]
Upgrade to CGI-3.35.
Affected files ...
... //depot/maint-5.10/perl/lib/CGI.pm#3 integrate
... //depot/maint-5.10/perl/lib/CGI/Changes#2 integrate
... //depot/maint-5.10/perl/lib/CGI/Util.pm#3 integrate
Differences ...
==== //depot/maint-5.10/perl/lib/CGI.pm#3 (text) ====
Index: perl/lib/CGI.pm
--- perl/lib/CGI.pm#2~33509~ 2008-03-13 09:45:45.000000000 -0700
+++ perl/lib/CGI.pm 2008-03-27 04:35:31.000000000 -0700
@@ -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.240 2007/11/30 18:58:27 lstein Exp $';
-$CGI::VERSION='3.33';
+$CGI::revision = '$Id: CGI.pm,v 1.249 2008/03/25 15:17:55 lstein Exp $';
+$CGI::VERSION='3.35';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1835,7 +1835,7 @@
my($method,$action,$enctype,@other) =
rearrange([METHOD,ACTION,ENCTYPE],@p);
- $method = $self->escapeHTML(lc($method) || 'post');
+ $method = $self->escapeHTML(lc($method || 'post'));
$enctype = $self->escapeHTML($enctype || &URL_ENCODED);
if (defined $action) {
$action = $self->escapeHTML($action);
@@ -2198,9 +2198,11 @@
else {
$toencode =~ s{"}{"}gso;
}
- my $latin = uc $self->{'.charset'} eq 'ISO-8859-1' ||
- uc $self->{'.charset'} eq 'WINDOWS-1252';
- if ($latin) { # bug in some browsers
+ # Handle bug in some browsers with Latin charsets
+ if ($self->{'.charset'} &&
+ (uc($self->{'.charset'}) eq 'ISO-8859-1' ||
+ uc($self->{'.charset'}) eq 'WINDOWS-1252'))
+ {
$toencode =~ s{'}{'}gso;
$toencode =~ s{\x8b}{‹}gso;
$toencode =~ s{\x9b}{›}gso;
@@ -2567,6 +2569,7 @@
$size = $size || scalar(@values);
my(%selected) = $self->previous_or_default($name,$defaults,$override);
+
my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
my($has_size) = $size ? qq/ size="$size"/: '';
my($other) = @other ? " @other" : '';
@@ -2699,7 +2702,7 @@
my $request_uri = unescape($self->request_uri) || '';
my $query_str = $self->query_string;
- my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/;
+ my $rewrite_in_use = $request_uri && $request_uri !~ /^\Q$script_name/;
undef $path if $rewrite_in_use && $rewrite; # path not valid when
rewriting active
my $uri = $rewrite && $request_uri ? $request_uri : $script_name;
@@ -3292,10 +3295,10 @@
if (!$override && ($self->{'.fieldnames'}->{$name} ||
defined($self->param($name)) ) ) {
- grep($selected{$_}++,$self->param($name));
+ $selected{$_}++ for $self->param($name);
} elsif (defined($defaults) && ref($defaults) &&
(ref($defaults) eq 'ARRAY')) {
- grep($selected{$_}++,@{$defaults});
+ $selected{$_}++ for @{$defaults};
} else {
$selected{$defaults}++ if defined($defaults);
}
@@ -3379,8 +3382,12 @@
my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
$param .= $TAINTED;
- # Bug: Netscape doesn't escape quotation marks in file names!!!
- my($filename) = $header{'Content-Disposition'}=~/ filename="([^"]*)"/;
+ # See RFC 1867, 2183, 2045
+ # NB: File content will be loaded into memory should
+ # content-disposition parsing fail.
+ my ($filename) = $header{'Content-Disposition'}
+ =~/
filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
+ $filename =~ s/^"([^"]*)"$/$1/;
# Test for Opera's multiple upload feature
my($multipart) = ( defined( $header{'Content-Type'} ) &&
$header{'Content-Type'} =~ /multipart\/mixed/ ) ?
@@ -4040,7 +4047,7 @@
my $filename;
find_tempdir() unless -w $TMPDIRECTORY;
for (my $i = 0; $i < $MAXTRIES; $i++) {
- last if ! -f ($filename =
sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
+ last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY,
$sequence++));
}
# check that it is a more-or-less valid filename
return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$!;
@@ -4117,6 +4124,8 @@
hr;
}
+ print end_html;
+
=head1 ABSTRACT
This perl library uses perl5 objects to make it easy to create Web
@@ -5410,7 +5419,7 @@
If Apache's mod_rewrite is turned on, then the script name and path
info probably won't match the request that the user sent. Set
-rewrite=>1 (default) to return URLs that match what the user sent
-(the original request URI). Set -rewrite->0 to return URLs that match
+(the original request URI). Set -rewrite=>0 to return URLs that match
the URL after mod_rewrite's rules have run. Because the additional
path information only makes sense in the context of the rewritten URL,
-rewrite is set to false when you request path info in the URL.
@@ -7686,10 +7695,8 @@
=head1 AUTHOR INFORMATION
-Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+The GD.pm interface is copyright 1995-2007, Lincoln D. Stein. It is
+distributed under GPL and the Artistic License 2.0.
Address bug reports and comments to: [EMAIL PROTECTED] When sending
bug reports, please provide the version of CGI.pm, the version of
==== //depot/maint-5.10/perl/lib/CGI/Changes#2 (text) ====
Index: perl/lib/CGI/Changes
--- perl/lib/CGI/Changes#1~32694~ 2007-12-22 01:23:09.000000000 -0800
+++ perl/lib/CGI/Changes 2008-03-27 04:35:31.000000000 -0700
@@ -1,3 +1,27 @@
+ Version 3.35
+ 1. Resync with bleadperl, primarily fixing a bug in parsing semicolons in
uploaded filenames.
+
+ Version 3.34
+ 1. Handle Unicode %uXXXX escapes properly -- patch from [EMAIL PROTECTED]
+ 2. Fix url() method to not choke on path names that contain regex characters.
+
+ Version 3.33
+ 1. Remove uninit variable warning when calling url(-relative=>1)
+ 2. Fix uninit variable warnings for two lc calls
+ 3. Fixed failure of tempfile upload due to sprintf() taint failure in perl
5.10
+
+ Version 3.32
+ 1. Patch from Miguel Santinho to prevent sending premature headers under
mod_perl 2.0
+
+ Version 3.31
+ 1. Patch from Xavier Robin so that CGI::Carp issues a 500 Status code rather
than a 200 status code.
+ 2. Patch from Alexander Klink to select correct temporary directory in OSX
Leopard so that upload works.
+ 3. Possibly fixed "wrapped pack" error on 5.10 and higher.
+
+ Version 3.30
+ 1. Patch from Mike Barry to handle POSTDATA in the same way as PUT.
+ 2. Patch from Rafael Garcia-Suarez to correctly reencode unicode values as
byte values.
+
Version 3.29
1. The position of file handles is now reset to zero when CGI->new is called.
(Mark Stosberg)
==== //depot/maint-5.10/perl/lib/CGI/Util.pm#3 (text) ====
Index: perl/lib/CGI/Util.pm
--- perl/lib/CGI/Util.pm#2~33509~ 2008-03-13 09:45:45.000000000 -0700
+++ perl/lib/CGI/Util.pm 2008-03-27 04:35:31.000000000 -0700
@@ -7,7 +7,7 @@
@EXPORT_OK = qw(rearrange make_attributes unescape escape
expires ebcdic2ascii ascii2ebcdic);
-$VERSION = '1.5';
+$VERSION = '1.5_01';
$EBCDIC = "\t" ne "\011";
# (ord('^') == 95) for codepage 1047 as on os390, vmesa
@@ -141,8 +141,12 @@
sub utf8_chr {
my $c = shift(@_);
- return chr($c) if $] >= 5.006;
-
+ if ($] >= 5.006){
+ require utf8;
+ my $u = chr($c);
+ utf8::encode($u); # drop utf8 flag
+ return $u;
+ }
if ($c < 0x80) {
return sprintf("%c", $c);
} elsif ($c < 0x800) {
@@ -189,6 +193,17 @@
if ($EBCDIC) {
$todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
} else {
+ # handle surrogate pairs first -- dankogai
+ $todecode =~ s{
+ %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
+ %u([Dd][c-fC-F][0-9a-fA-F]{2}) # lo
+ }{
+ utf8_chr(
+ 0x10000
+ + (hex($1) - 0xD800) * 0x400
+ + (hex($2) - 0xDC00)
+ )
+ }gex;
$todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
}
@@ -200,9 +215,12 @@
shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq
$CGI::DefaultClass));
my $toencode = shift;
return undef unless defined($toencode);
+ $toencode = eval { pack("C*", unpack("U0C*", $toencode))} || pack("C*",
unpack("C*", $toencode));
+
# force bytes while preserving backward compatibility -- dankogai
-# $toencode = eval { pack("C*", unpack("U0C*", $toencode))} || pack("C*",
unpack("C*", $toencode));
- $toencode = eval { pack("U*", unpack("U0C*", $toencode))} || pack("C*",
unpack("C*", $toencode));
+ # but commented out because it was breaking CGI::Compress -- lstein
+ # $toencode = eval { pack("U*", unpack("U0C*", $toencode))} || pack("C*",
unpack("C*", $toencode));
+
if ($EBCDIC) {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
} else {
End of Patch.
