From 6a36cc7cb84c0de106a1a858ba2b6e257fe92d54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcela=20Ma=C5=A1l=C3=A1=C5=88ov=C3=A1?= Date: Mon, 19 May 2008 12:06:49 +0000 Subject: [PATCH] 447142 update CGI for bugzilla. --- perl-5.10.0-CGI-3.37.patch | 584 +++++++++++++++++++++++++++++++++++++ perl.spec | 13 +- 2 files changed, 593 insertions(+), 4 deletions(-) create mode 100644 perl-5.10.0-CGI-3.37.patch diff --git a/perl-5.10.0-CGI-3.37.patch b/perl-5.10.0-CGI-3.37.patch new file mode 100644 index 0000000..8c2f209 --- /dev/null +++ b/perl-5.10.0-CGI-3.37.patch @@ -0,0 +1,584 @@ +diff -up perl-5.10.0/lib/CGI/Apache.pm.eee perl-5.10.0/lib/CGI/Apache.pm +diff -up perl-5.10.0/lib/CGI/Carp.pm.eee perl-5.10.0/lib/CGI/Carp.pm +--- perl-5.10.0/lib/CGI/Carp.pm.eee 2007-12-18 11:47:07.000000000 +0100 ++++ perl-5.10.0/lib/CGI/Carp.pm 2008-03-27 15:23:36.000000000 +0100 +@@ -323,7 +323,7 @@ use File::Spec; + + $main::SIG{__WARN__}=\&CGI::Carp::warn; + +-$CGI::Carp::VERSION = '1.29'; ++$CGI::Carp::VERSION = '1.30_01'; + $CGI::Carp::CUSTOM_MSG = undef; + $CGI::Carp::DIE_HANDLER = undef; + +@@ -575,6 +575,7 @@ END + print STDOUT $mess; + } + else { ++ print STDOUT "Status: 500\n"; + print STDOUT "Content-type: text/html\n\n"; + print STDOUT $mess; + } +diff -up perl-5.10.0/lib/CGI/Changes.eee perl-5.10.0/lib/CGI/Changes +--- perl-5.10.0/lib/CGI/Changes.eee 2007-12-18 11:47:07.000000000 +0100 ++++ perl-5.10.0/lib/CGI/Changes 2008-04-23 15:08:05.000000000 +0200 +@@ -1,3 +1,35 @@ ++ Version 3.37 ++ 1. Fix pragmas so that they persist over modperl invocations (e.g. RT 34761) ++ 2. Fixed handling of chunked multipart uploads; thanks to Michael Bernhardt ++ who reported and fixed the problem. ++ ++ Version 3.36 ++ 1. Fix CGI::Cookie to support cookies that are separated by "," instead of ";". ++ ++ 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 DANKOGAI@cpan.org ++ 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) +diff -up perl-5.10.0/lib/CGI/Cookie.pm.eee perl-5.10.0/lib/CGI/Cookie.pm +--- perl-5.10.0/lib/CGI/Cookie.pm.eee 2007-12-18 11:47:07.000000000 +0100 ++++ perl-5.10.0/lib/CGI/Cookie.pm 2008-03-28 18:15:51.000000000 +0100 +@@ -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.28'; ++$CGI::Cookie::VERSION='1.29'; + + use CGI::Util qw(rearrange unescape escape); + use CGI; +@@ -51,7 +51,7 @@ sub fetch { + my %results; + my($key,$value); + +- my(@pairs) = split("[;,] ?",$raw_cookie); ++ my @pairs = split("[;,] ?",$raw_cookie); + foreach (@pairs) { + s/\s*(.*?)\s*/$1/; + if (/^([^=]+)=(.*)/) { +@@ -88,7 +88,7 @@ sub parse { + my ($self,$raw_cookie) = @_; + my %results; + +- my(@pairs) = split("; ?",$raw_cookie); ++ my @pairs = split("[;,] ?",$raw_cookie); + foreach (@pairs) { + s/\s*(.*?)\s*/$1/; + my($key,$value) = split("=",$_,2); +diff -up perl-5.10.0/lib/CGI/Fast.pm.eee perl-5.10.0/lib/CGI/Fast.pm +--- perl-5.10.0/lib/CGI/Fast.pm.eee 2007-12-18 11:47:07.000000000 +0100 ++++ perl-5.10.0/lib/CGI/Fast.pm 2008-04-14 19:53:12.000000000 +0200 +@@ -55,6 +55,7 @@ sub new { + } + } + CGI->_reset_globals; ++ $self->_setup_symbols(@SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS; + return $CGI::Q = $self->SUPER::new($initializer, @param); + } + +diff -up perl-5.10.0/lib/CGI.pm.eee perl-5.10.0/lib/CGI.pm +--- perl-5.10.0/lib/CGI.pm.eee 2007-12-18 11:47:07.000000000 +0100 ++++ perl-5.10.0/lib/CGI.pm 2008-04-23 15:08:23.000000000 +0200 +@@ -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.234 2007/04/16 16:58:46 lstein Exp $'; +-$CGI::VERSION='3.29'; ++$CGI::revision = '$Id: CGI.pm,v 1.251 2008/04/23 13:08:23 lstein Exp $'; ++$CGI::VERSION='3.37'; + + # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. + # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. +@@ -37,7 +37,12 @@ use constant XHTML_DTD => ['-//W3C//DTD + $TAINTED = substr("$0$^X",0,0); + } + +-$MOD_PERL = 0; # no mod_perl by default ++$MOD_PERL = 0; # no mod_perl by default ++ ++#global settings ++$POST_MAX = -1; # no limit to uploaded files ++$DISABLE_UPLOADS = 0; ++ + @SAVED_SYMBOLS = (); + + +@@ -91,13 +96,6 @@ sub initialize_globals { + # it can just be renamed, instead of read and written. + $CLOSE_UPLOAD_FILES = 0; + +- # Set this to a positive value to limit the size of a POSTing +- # to a certain number of bytes: +- $POST_MAX = -1; +- +- # Change this to 1 to disable uploads entirely: +- $DISABLE_UPLOADS = 0; +- + # Automatically determined -- don't change + $EBCDIC = 0; + +@@ -111,6 +109,9 @@ sub initialize_globals { + # use CGI qw(-no_undef_params); + $NO_UNDEF_PARAMS = 0; + ++ # return everything as utf-8 ++ $PARAM_UTF8 = 0; ++ + # Other globals that you shouldn't worry about. + undef $Q; + $BEEN_THERE = 0; +@@ -352,6 +353,7 @@ sub new { + $self->r(Apache->request) unless $self->r; + my $r = $self->r; + $r->register_cleanup(\&CGI::_reset_globals); ++ $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS; + } + else { + # XXX: once we have the new API +@@ -360,6 +362,7 @@ sub new { + my $r = $self->r; + $r->subprocess_env unless exists $ENV{REQUEST_METHOD}; + $r->pool->cleanup_register(\&CGI::_reset_globals); ++ $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS; + } + undef $NPH; + } +@@ -445,15 +448,14 @@ sub param { + + return unless defined($name) && $self->{$name}; + +- 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]; ++ my @result = @{$self->{$name}}; ++ ++ if ($PARAM_UTF8) { ++ eval "require Encode; 1;" unless Encode->can('decode'); # bring in these functions ++ @result = map {ref $_ ? $_ : Encode::decode(utf8=>$_) } @result; + } ++ ++ return wantarray ? @result : $result[0]; + } + + sub self_or_default { +@@ -641,7 +643,7 @@ sub init { + last METHOD; + } + +- if ($meth eq 'POST') { ++ if ($meth eq 'POST' || $meth eq 'PUT') { + $self->read_from_client(\$query_string,$content_length,0) + if $content_length > 0; + # Some people want to have their cake and eat it too! +@@ -667,11 +669,11 @@ sub init { + } + + # YL: Begin Change for XML handler 10/19/2001 +- if (!$is_xforms && $meth eq 'POST' ++ if (!$is_xforms && ($meth eq 'POST' || $meth eq 'PUT') + && defined($ENV{'CONTENT_TYPE'}) + && $ENV{'CONTENT_TYPE'} !~ m|^application/x-www-form-urlencoded| + && $ENV{'CONTENT_TYPE'} !~ m|^multipart/form-data| ) { +- my($param) = 'POSTDATA' ; ++ my($param) = $meth . 'DATA' ; + $self->add_parameter($param) ; + push (@{$self->{$param}},$query_string); + undef $query_string ; +@@ -904,6 +906,7 @@ sub _setup_symbols { + $DEBUG=0, next if /^[:-]no_?[Dd]ebug$/; + $DEBUG=2, next if /^[:-][Dd]ebug$/; + $USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/; ++ $PARAM_UTF8++, next if /^[:-]utf8$/; + $XHTML++, next if /^[:-]xhtml$/; + $XHTML=0, next if /^[:-]no_?xhtml$/; + $USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/; +@@ -1519,7 +1522,7 @@ sub header { + push(@header,map {ucfirst $_} @other); + push(@header,"Content-Type: $type") if $type ne ''; + my $header = join($CRLF,@header)."${CRLF}${CRLF}"; +- if ($MOD_PERL and not $nph) { ++ if (($MOD_PERL >= 1) && !$nph) { + $self->r->send_cgi_header($header); + return ''; + } +@@ -1699,6 +1702,7 @@ sub _style { + my $cdata_end = $XHTML ? "\n/* ]]> */-->\n" : " -->\n"; + + my @s = ref($style) eq 'ARRAY' ? @$style : $style; ++ my $other = ''; + + for my $s (@s) { + if (ref($s)) { +@@ -1708,7 +1712,7 @@ sub _style { + ref($s) eq 'ARRAY' ? @$s : %$s)); + my $type = defined $stype ? $stype : 'text/css'; + my $rel = $alternate ? 'alternate stylesheet' : 'stylesheet'; +- my $other = @other ? join ' ',@other : ''; ++ $other = "@other" if @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 +@@ -1831,7 +1835,7 @@ sub startform { + 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); +@@ -2147,8 +2151,9 @@ END_OF_FUNC + sub checkbox { + my($self,@p) = self_or_default(@_); + +- my($name,$checked,$value,$label,$override,$tabindex,@other) = +- rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE],TABINDEX],@p); ++ my($name,$checked,$value,$label,$labelattributes,$override,$tabindex,@other) = ++ rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,LABELATTRIBUTES, ++ [OVERRIDE,FORCE],TABINDEX],@p); + + $value = defined $value ? $value : 'on'; + +@@ -2165,7 +2170,8 @@ sub checkbox { + my($other) = @other ? "@other " : ''; + $tabindex = $self->element_tab($tabindex); + $self->register_parameter($name); +- return $XHTML ? CGI::label(qq{$the_label}) ++ return $XHTML ? CGI::label($labelattributes, ++ qq{$the_label}) + : qq{$the_label}; + } + END_OF_FUNC +@@ -2192,9 +2198,11 @@ sub escapeHTML { + 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; +@@ -2327,13 +2335,14 @@ sub _box_group { + my $self = shift; + my $box_type = shift; + +- my($name,$values,$defaults,$linebreak,$labels,$attributes, +- $rows,$columns,$rowheaders,$colheaders, ++ my($name,$values,$defaults,$linebreak,$labels,$labelattributes, ++ $attributes,$rows,$columns,$rowheaders,$colheaders, + $override,$nolabels,$tabindex,$disabled,@other) = +- rearrange([ NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,ATTRIBUTES, +- ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER], +- [OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED +- ],@_); ++ rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,LABELATTRIBUTES, ++ ATTRIBUTES,ROWS,[COLUMNS,COLS],[ROWHEADERS,ROWHEADER],[COLHEADERS,COLHEADER], ++ [OVERRIDE,FORCE],NOLABELS,TABINDEX,DISABLED ++ ],@_); ++ + + my($result,$checked,@elements,@values); + +@@ -2393,7 +2402,7 @@ sub _box_group { + + if ($XHTML) { + push @elements, +- CGI::label( ++ CGI::label($labelattributes, + qq($label)).${break}; + } else { + push(@elements,qq/${label}${break}/); +@@ -2560,6 +2569,7 @@ sub scrolling_list { + $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" : ''; +@@ -2692,7 +2702,7 @@ sub url { + 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; +@@ -2723,6 +2733,7 @@ sub url { + + $url .= $path if $path_info and defined $path; + $url .= "?$query_str" if $query and $query_str ne ''; ++ $url ||= ''; + $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg; + return $url; + } +@@ -3284,10 +3295,10 @@ sub previous_or_default { + + 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); + } +@@ -3371,8 +3382,12 @@ sub read_multipart { + 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/ ) ? +@@ -3431,7 +3446,7 @@ sub read_multipart { + + my ($data); + local($\) = ''; +- my $totalbytes; ++ my $totalbytes = 0; + while (defined($data = $buffer->read)) { + if (defined $self->{'.upload_hook'}) + { +@@ -3696,7 +3711,7 @@ sub new { + (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg; + my $fv = ++$FH . $safename; + my $ref = \*{"Fh::$fv"}; +- $file =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return; ++ $file =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$! || return; + my $safe = $1; + sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return; + unlink($safe) if $delete; +@@ -3768,7 +3783,7 @@ sub new { + } + + my $self = {LENGTH=>$length, +- CHUNKED=>!defined $length, ++ CHUNKED=>!$length, + BOUNDARY=>$boundary, + INTERFACE=>$interface, + BUFFER=>'', +@@ -4032,10 +4047,10 @@ sub new { + 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_ \'\":/.\$\\-]+)$!; ++ return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$!; + # this used to untaint, now it doesn't + # $filename = $1; + return bless \$filename; +@@ -4109,6 +4124,8 @@ CGI - Simple Common Gateway Interface Cl + hr; + } + ++ print end_html; ++ + =head1 ABSTRACT + + This perl library uses perl5 objects to make it easy to create Web +@@ -4477,6 +4494,10 @@ it, use code like this: + + my $data = $query->param('POSTDATA'); + ++Likewise if PUTed data can be retrieved with code like this: ++ ++ my $data = $query->param('PUTDATA'); ++ + (If you don't know what the preceding means, don't worry about it. It + only affects people trying to use CGI for XML processing and other + specialized tasks.) +@@ -4812,6 +4833,16 @@ If start_html()'s -dtd parameter specifi + XHTML will automatically be disabled without needing to use this + pragma. + ++=item -utf8 ++ ++This makes CGI.pm treat all parameters as UTF-8 strings. Use this with ++care, as it will interfere with the processing of binary uploads. It ++is better to manually select which fields are expected to return utf-8 ++strings and convert them using code like this: ++ ++ use Encode; ++ my $arg = decode utf8=>param('foo'); ++ + =item -nph + + This makes CGI.pm produce a header appropriate for an NPH (no +@@ -5388,7 +5419,7 @@ Generate just the protocol and net locat + 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. +@@ -6389,6 +6420,9 @@ are the tab indexes of each button. Exa + -tabindex => ['moe','minie','eenie','meenie'] # tab in this order + -tabindex => {meenie=>100,moe=>101,minie=>102,eenie=>200} # tab in this order + ++The optional B<-labelattributes> argument will contain attributes ++attached to the