diff -up perl-5.10.0/lib/CGI/Apache.pm.olde perl-5.10.0/lib/CGI/Apache.pm diff -up perl-5.10.0/lib/CGI/Carp.pm.olde perl-5.10.0/lib/CGI/Carp.pm --- perl-5.10.0/lib/CGI/Carp.pm.olde 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.olde perl-5.10.0/lib/CGI/Changes --- perl-5.10.0/lib/CGI/Changes.olde 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/CGI/Changes 2008-06-25 16:51:35.000000000 +0200 @@ -1,3 +1,46 @@ + Version 3.38 + 1. Fix annoying warning in http://rt.cpan.org/Ticket/Display.html?id=34551 + 2. Added nobr() function http://rt.cpan.org/Ticket/Display.html?id=35377 + 3. popup_menu() allows multiple items to be selected by default, satisfying + http://rt.cpan.org/Ticket/Display.html?id=35376 + 4. Patch from Renee Backer to avoid doubled headers. + 5. Fixed documentation bug that describes what happens when a + parameter is empty (e.g. "?test1="). + 6. Fixed minor warning described at http://rt.cpan.org/Public/Bug/Display.html?id=36435 + 7. Fixed overlap of attribute and parameter space described in http://rt.perl.org/rt3//Ticket/Display.html?id=24294 + + 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.olde perl-5.10.0/lib/CGI/Cookie.pm --- perl-5.10.0/lib/CGI/Cookie.pm.olde 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/eg/caution.xbm.olde perl-5.10.0/lib/CGI/eg/caution.xbm diff -up perl-5.10.0/lib/CGI/eg/clickable_image.cgi.olde perl-5.10.0/lib/CGI/eg/clickable_image.cgi diff -up perl-5.10.0/lib/CGI/eg/cookie.cgi.olde perl-5.10.0/lib/CGI/eg/cookie.cgi diff -up perl-5.10.0/lib/CGI/eg/crash.cgi.olde perl-5.10.0/lib/CGI/eg/crash.cgi diff -up perl-5.10.0/lib/CGI/eg/customize.cgi.olde perl-5.10.0/lib/CGI/eg/customize.cgi diff -up perl-5.10.0/lib/CGI/eg/diff_upload.cgi.olde perl-5.10.0/lib/CGI/eg/diff_upload.cgi diff -up perl-5.10.0/lib/CGI/eg/dna_small_gif.uu.olde perl-5.10.0/lib/CGI/eg/dna_small_gif.uu diff -up perl-5.10.0/lib/CGI/eg/file_upload.cgi.olde perl-5.10.0/lib/CGI/eg/file_upload.cgi diff -up perl-5.10.0/lib/CGI/eg/frameset.cgi.olde perl-5.10.0/lib/CGI/eg/frameset.cgi diff -up perl-5.10.0/lib/CGI/eg/index.html.olde perl-5.10.0/lib/CGI/eg/index.html diff -up perl-5.10.0/lib/CGI/eg/internal_links.cgi.olde perl-5.10.0/lib/CGI/eg/internal_links.cgi diff -up perl-5.10.0/lib/CGI/eg/javascript.cgi.olde perl-5.10.0/lib/CGI/eg/javascript.cgi diff -up perl-5.10.0/lib/CGI/eg/make_links.pl.olde perl-5.10.0/lib/CGI/eg/make_links.pl diff -up perl-5.10.0/lib/CGI/eg/monty.cgi.olde perl-5.10.0/lib/CGI/eg/monty.cgi diff -up perl-5.10.0/lib/CGI/eg/multiple_forms.cgi.olde perl-5.10.0/lib/CGI/eg/multiple_forms.cgi diff -up perl-5.10.0/lib/CGI/eg/nph-clock.cgi.olde perl-5.10.0/lib/CGI/eg/nph-clock.cgi diff -up perl-5.10.0/lib/CGI/eg/nph-multipart.cgi.olde perl-5.10.0/lib/CGI/eg/nph-multipart.cgi diff -up perl-5.10.0/lib/CGI/eg/popup.cgi.olde perl-5.10.0/lib/CGI/eg/popup.cgi diff -up perl-5.10.0/lib/CGI/eg/RunMeFirst.olde perl-5.10.0/lib/CGI/eg/RunMeFirst diff -up perl-5.10.0/lib/CGI/eg/save_state.cgi.olde perl-5.10.0/lib/CGI/eg/save_state.cgi diff -up perl-5.10.0/lib/CGI/eg/tryit.cgi.olde perl-5.10.0/lib/CGI/eg/tryit.cgi diff -up perl-5.10.0/lib/CGI/eg/wilogo_gif.uu.olde perl-5.10.0/lib/CGI/eg/wilogo_gif.uu diff -up perl-5.10.0/lib/CGI/Fast.pm.olde perl-5.10.0/lib/CGI/Fast.pm --- perl-5.10.0/lib/CGI/Fast.pm.olde 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.olde perl-5.10.0/lib/CGI.pm --- perl-5.10.0/lib/CGI.pm.olde 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/lib/CGI.pm 2008-06-25 16:52:19.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.254 2008/06/25 14:52:19 lstein Exp $'; +$CGI::VERSION='3.38'; # 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; @@ -226,7 +227,7 @@ if ($needs_binmode) { tt u i b blockquote pre img a address cite samp dfn html head base body Link nextid title meta kbd start_html end_html input Select option comment charset escapeHTML/], - ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param + ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param nobr embed basefont style span layer ilayer font frameset frame script small big Area Map/], ':html4'=>[qw/abbr acronym bdo col colgroup del fieldset iframe ins label legend noframes noscript object optgroup Q @@ -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; } @@ -437,23 +440,22 @@ sub param { # If values is provided, then we set it. if (@values or defined $value) { $self->add_parameter($name); - $self->{$name}=[@values]; + $self->{param}{$name}=[@values]; } } else { $name = $p[0]; } - return unless defined($name) && $self->{$name}; + return unless defined($name) && $self->{param}{$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->{param}{$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 { @@ -574,14 +576,14 @@ sub init { $self->add_parameter($param); $self->read_from_client(\$value,$content_length,0) if $content_length > 0; - push (@{$self->{$param}},$value); + push (@{$self->{param}{$param}},$value); $is_xforms = 1; } elsif ($ENV{'CONTENT_TYPE'} =~ /multipart\/related.+boundary=\"?([^\";,]+)\"?.+start=\"?\]+)\>?\"?/) { my($boundary,$start) = ($1,$2); my($param) = 'XForms:Model'; $self->add_parameter($param); my($value) = $self->read_multipart_related($start,$boundary,$content_length,0); - push (@{$self->{$param}},$value); + push (@{$self->{param}{$param}},$value); if ($MOD_PERL) { $query_string = $self->r->args; } else { @@ -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,13 +669,13 @@ 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); + push (@{$self->{param}{$param}},$query_string); undef $query_string ; } # YL: End Change for XML handler 10/19/2001 @@ -685,7 +687,7 @@ sub init { $self->parse_params($query_string); } else { $self->add_parameter('keywords'); - $self->{'keywords'} = [$self->parse_keywordlist($query_string)]; + $self->{param}{'keywords'} = [$self->parse_keywordlist($query_string)]; } } @@ -752,7 +754,7 @@ sub save_request { @QUERY_PARAM = $self->param; # save list of parameters foreach (@QUERY_PARAM) { next unless defined $_; - $QUERY_PARAM{$_}=$self->{$_}; + $QUERY_PARAM{$_}=$self->{param}{$_}; } $QUERY_CHARSET = $self->charset; %QUERY_FIELDNAMES = %{$self->{'.fieldnames'}}; @@ -771,7 +773,7 @@ sub parse_params { $param = unescape($param); $value = unescape($value); $self->add_parameter($param); - push (@{$self->{$param}},$value); + push (@{$self->{param}{$param}},$value); } } @@ -779,7 +781,7 @@ sub add_parameter { my($self,$param)=@_; return unless defined $param; push (@{$self->{'.parameters'}},$param) - unless defined($self->{$param}); + unless defined($self->{param}{$param}); } sub all_parameters { @@ -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$/; @@ -1005,7 +1008,7 @@ sub delete { my %to_delete; foreach my $name (@to_delete) { - CORE::delete $self->{$name}; + CORE::delete $self->{param}{$name}; CORE::delete $self->{'.fieldnames'}->{$name}; $to_delete{$name}++; } @@ -1054,8 +1057,8 @@ END_OF_FUNC sub keywords { my($self,@values) = self_or_default(@_); # If values is provided, then we set it. - $self->{'keywords'}=[@values] if @values; - my(@result) = defined($self->{'keywords'}) ? @{$self->{'keywords'}} : (); + $self->{param}{'keywords'}=[@values] if @values; + my(@result) = defined($self->{param}{'keywords'}) ? @{$self->{param}{'keywords'}} : (); @result; } END_OF_FUNC @@ -1200,7 +1203,7 @@ sub append { my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : (); if (@values) { $self->add_parameter($name); - push(@{$self->{$name}},@values); + push(@{$self->{param}{$name}},@values); } return $self->param($name); } @@ -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 ''; } @@ -1663,12 +1666,22 @@ sub start_html { : qq()); } } - push(@result,ref($head) ? @$head : $head) if $head; + my $meta_bits_set = 0; + if( $head ) { + if( ref $head ) { + push @result, @$head; + $meta_bits_set = 1 if grep { /http-equiv=["']Content-Type/i }@$head; + } + else { + push @result, $head; + $meta_bits_set = 1 if $head =~ /http-equiv=["']Content-Type/i; + } + } # handle the infrequently-used -style and -script parameters push(@result,$self->_style($style)) if defined $style; push(@result,$self->_script($script)) if defined $script; - push(@result,$meta_bits) if defined $meta_bits; + push(@result,$meta_bits) if defined $meta_bits and !$meta_bits_set; # handle -noscript parameter push(@result,< */-->\n" : " -->\n"; my @s = ref($style) eq 'ARRAY' ? @$style : $style; + my $other = ''; for my $s (@s) { if (ref($s)) { @@ -1708,7 +1722,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 +1845,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 +2161,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 +2180,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 +2208,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 +2345,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 +2412,7 @@ sub _box_group { if ($XHTML) { push @elements, - CGI::label( + CGI::label($labelattributes, qq($label)).${break}; } else { push(@elements,qq/${label}${break}/); @@ -2428,12 +2447,14 @@ sub popup_menu { my($name,$values,$default,$labels,$attributes,$override,$tabindex,@other) = rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS, ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@p); - my($result,$selected); + my($result,%selected); if (!$override && defined($self->param($name))) { - $selected = $self->param($name); - } else { - $selected = $default; + $selected{$self->param($name)}++; + } elsif ($default) { + %selected = map {$_=>1} ref($default) eq 'ARRAY' + ? @$default + : $default; } $name=$self->escapeHTML($name); my($other) = @other ? " @other" : ''; @@ -2444,20 +2465,22 @@ sub popup_menu { $result = qq/