From 1443e2aaf1bddda2b92376af13a31de106af2ab7 Mon Sep 17 00:00:00 2001 From: Marcela Mašláňová Date: Jul 21 2008 08:27:57 +0000 Subject: - 455933 update to CGI-3.38 --- diff --git a/perl-5.10.0-CGI-3.37.patch b/perl-5.10.0-CGI-3.37.patch deleted file mode 100644 index 8c2f209..0000000 --- a/perl-5.10.0-CGI-3.37.patch +++ /dev/null @@ -1,584 +0,0 @@ -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