r24936 - in /branches/upstream/libcgi-pm-perl/current: CGI.pm CGI/Pretty.pm CGI/Util.pm Changes META.yml t/upload.t t/uploadInfo.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Tue Sep 9 15:17:27 UTC 2008
Author: gregoa
Date: Tue Sep 9 15:17:24 2008
New Revision: 24936
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24936
Log:
[svn-upgrade] Integrating new upstream version, libcgi-pm-perl (3.42)
Modified:
branches/upstream/libcgi-pm-perl/current/CGI.pm
branches/upstream/libcgi-pm-perl/current/CGI/Pretty.pm
branches/upstream/libcgi-pm-perl/current/CGI/Util.pm
branches/upstream/libcgi-pm-perl/current/Changes
branches/upstream/libcgi-pm-perl/current/META.yml
branches/upstream/libcgi-pm-perl/current/t/upload.t
branches/upstream/libcgi-pm-perl/current/t/uploadInfo.t
Modified: branches/upstream/libcgi-pm-perl/current/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI.pm?rev=24936&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI.pm Tue Sep 9 15:17:24 2008
@@ -18,13 +18,13 @@
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.259 2008/08/20 13:45:25 lstein Exp $';
-$CGI::VERSION='3.41';
+$CGI::revision = '$Id: CGI.pm,v 1.260 2008/09/08 14:13:23 lstein Exp $';
+$CGI::VERSION='3.42';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
# $CGITempFile::TMPDIRECTORY = '/usr/tmp';
-use CGI::Util qw(rearrange make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic);
+use CGI::Util qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic);
#use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN',
# 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd'];
@@ -1381,7 +1381,7 @@
'multipart_init' => <<'END_OF_FUNC',
sub multipart_init {
my($self, at p) = self_or_default(@_);
- my($boundary, at other) = rearrange([BOUNDARY], at p);
+ my($boundary, at other) = rearrange_header([BOUNDARY], at p);
$boundary = $boundary || '------- =_aaaaaaaaaa0';
$self->{'separator'} = "$CRLF--$boundary$CRLF";
$self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
@@ -3762,7 +3762,7 @@
(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;
@@ -4060,6 +4060,14 @@
"${vol}${SL}Temporary Items",
"${SL}WWW_ROOT", "${SL}SYS\$SCRATCH",
"C:${SL}system${SL}temp");
+
+ if( $CGI::OS eq 'WINDOWS' ){
+ unshift @TEMP,
+ $ENV{TEMP},
+ $ENV{TMP},
+ $ENV{WINDIR} . $SL . 'TEMP';
+ }
+
unshift(@TEMP,$ENV{'TMPDIR'}) if defined $ENV{'TMPDIR'};
# this feature was supposed to provide per-user tmpfiles, but
@@ -4088,7 +4096,7 @@
sub DESTROY {
my($self) = @_;
- $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return;
+ $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\~-]+)$! || return;
my $safe = $1; # untaint operation
unlink $safe; # get rid of the file
}
@@ -4109,7 +4117,7 @@
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;
Modified: branches/upstream/libcgi-pm-perl/current/CGI/Pretty.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI/Pretty.pm?rev=24936&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI/Pretty.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI/Pretty.pm Tue Sep 9 15:17:24 2008
@@ -176,6 +176,35 @@
}
sub _reset_globals { initialize_globals(); }
+# ugly, but quick fix
+sub import {
+ my $self = shift;
+ no strict 'refs';
+ ${ "$self\::AutoloadClass" } = 'CGI';
+
+ # This causes modules to clash.
+ undef %CGI::EXPORT;
+ undef %CGI::EXPORT;
+
+ $self->_setup_symbols(@_);
+ my ($callpack, $callfile, $callline) = caller;
+
+ # To allow overriding, search through the packages
+ # Till we find one in which the correct subroutine is defined.
+ my @packages = ($self,@{"$self\:\:ISA"});
+ foreach my $sym (keys %CGI::EXPORT) {
+ my $pck;
+ my $def = ${"$self\:\:AutoloadClass"} || $CGI::DefaultClass;
+ foreach $pck (@packages) {
+ if (defined(&{"$pck\:\:$sym"})) {
+ $def = $pck;
+ last;
+ }
+ }
+ *{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
+ }
+}
+
1;
=head1 NAME
Modified: branches/upstream/libcgi-pm-perl/current/CGI/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI/Util.pm?rev=24936&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI/Util.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI/Util.pm Tue Sep 9 15:17:24 2008
@@ -4,7 +4,7 @@
use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
require Exporter;
@ISA = qw(Exporter);
- at EXPORT_OK = qw(rearrange make_attributes unescape escape
+ at EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape
expires ebcdic2ascii ascii2ebcdic);
$VERSION = '1.5_01';
@@ -70,16 +70,34 @@
}
# Smart rearrangement of parameters to allow named parameter
-# calling. We do the rearangement if:
+# calling. We do the rearrangement if:
# the first parameter begins with a -
+
sub rearrange {
+ my ($order, at param) = @_;
+ my ($result, $leftover) = _rearrange_params( $order, @param );
+ push @$result, make_attributes( $leftover, defined $CGI::Q ? $CGI::Q->{escape} : 1 )
+ if keys %$leftover;
+ @$result;
+}
+
+sub rearrange_header {
+ my ($order, at param) = @_;
+
+ my ($result,$leftover) = _rearrange_params( $order, @param );
+ push @$result, make_attributes( $leftover, 0, 1 ) if keys %$leftover;
+
+ @$result;
+}
+
+sub _rearrange_params {
my($order, at param) = @_;
- return () unless @param;
+ return [] unless @param;
if (ref($param[0]) eq 'HASH') {
@param = %{$param[0]};
} else {
- return @param
+ return \@param
unless (defined($param[0]) && substr($param[0],0,1) eq '-');
}
@@ -103,14 +121,17 @@
}
}
- push (@result,make_attributes(\%leftover,defined $CGI::Q ? $CGI::Q->{escape} : 1)) if %leftover;
- @result;
+ return \@result, \%leftover;
}
sub make_attributes {
my $attr = shift;
return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
my $escape = shift || 0;
+ my $do_not_quote = shift;
+
+ my $quote = $do_not_quote ? '' : '"';
+
my(@att);
foreach (keys %{$attr}) {
my($key) = $_;
@@ -122,7 +143,7 @@
($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
- push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
+ push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/);
}
return @att;
}
Modified: branches/upstream/libcgi-pm-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/Changes?rev=24936&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Changes (original)
+++ branches/upstream/libcgi-pm-perl/current/Changes Tue Sep 9 15:17:24 2008
@@ -1,3 +1,11 @@
+
+ Version 3.42
+ 1. Added patch from Renee Baecker that makes it possible to subclass
+ CGI::Pretty.
+ 2. Added patch from Nicholas Clark to allow ~ characters in temporary directories.
+ 3. Added patch from Renee Baecker that fixes the inappropriate escaping of fields
+ in multipart headers.
+
Version 3.41
1. Fix url() returning incorrect path when query string contains escaped newline.
2. Added additional windows temporary directories and environment variables, courtesy patch from Renee Baecker
Modified: branches/upstream/libcgi-pm-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/META.yml?rev=24936&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/META.yml (original)
+++ branches/upstream/libcgi-pm-perl/current/META.yml Tue Sep 9 15:17:24 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CGI.pm
-version: 3.41
+version: 3.42
abstract: ~
license: ~
author: ~
Modified: branches/upstream/libcgi-pm-perl/current/t/upload.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/upload.t?rev=24936&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/upload.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/upload.t Tue Sep 9 15:17:24 2008
@@ -19,32 +19,45 @@
# %ENV setup.
#-----------------------------------------------------------------------------
-%ENV = (
- %ENV,
- 'SCRIPT_NAME' => '/test.cgi',
- 'SERVER_NAME' => 'perl.org',
- 'HTTP_CONNECTION' => 'TE, close',
- 'REQUEST_METHOD' => 'POST',
- 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
- 'CONTENT_LENGTH' => 3285,
- 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
- 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
- 'HTTP_TE' => 'deflate,gzip;q=0.3',
- 'QUERY_STRING' => '',
- 'REMOTE_PORT' => '1855',
- 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
- 'SERVER_PORT' => '80',
- 'REMOTE_ADDR' => '127.0.0.1',
- 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
- 'SERVER_PROTOCOL' => 'HTTP/1.1',
- 'PATH' => '/usr/local/bin:/usr/bin:/bin',
- 'REQUEST_URI' => '/test.cgi',
- 'GATEWAY_INTERFACE' => 'CGI/1.1',
- 'SCRIPT_URL' => '/test.cgi',
- 'SERVER_ADDR' => '127.0.0.1',
- 'DOCUMENT_ROOT' => '/home/develop',
- 'HTTP_HOST' => 'www.perl.org'
-);
+my %myenv;
+
+BEGIN {
+ %myenv = (
+ 'SCRIPT_NAME' => '/test.cgi',
+ 'SERVER_NAME' => 'perl.org',
+ 'HTTP_CONNECTION' => 'TE, close',
+ 'REQUEST_METHOD' => 'POST',
+ 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
+ 'CONTENT_LENGTH' => 3285,
+ 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
+ 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
+ 'HTTP_TE' => 'deflate,gzip;q=0.3',
+ 'QUERY_STRING' => '',
+ 'REMOTE_PORT' => '1855',
+ 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
+ 'SERVER_PORT' => '80',
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'PATH' => '/usr/local/bin:/usr/bin:/bin',
+ 'REQUEST_URI' => '/test.cgi',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'SCRIPT_URL' => '/test.cgi',
+ 'SERVER_ADDR' => '127.0.0.1',
+ 'DOCUMENT_ROOT' => '/home/develop',
+ 'HTTP_HOST' => 'www.perl.org'
+ );
+
+ for my $key (keys %myenv) {
+ $ENV{$key} = $myenv{$key};
+ }
+}
+
+END {
+ for my $key (keys %myenv) {
+ delete $ENV{$key};
+ }
+}
#-----------------------------------------------------------------------------
# Simulate the upload (really, multiple uploads contained in a single stream).
Modified: branches/upstream/libcgi-pm-perl/current/t/uploadInfo.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/uploadInfo.t?rev=24936&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/uploadInfo.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/uploadInfo.t Tue Sep 9 15:17:24 2008
@@ -19,32 +19,46 @@
# %ENV setup.
#-----------------------------------------------------------------------------
-%ENV = (
- %ENV,
- 'SCRIPT_NAME' => '/test.cgi',
- 'SERVER_NAME' => 'perl.org',
- 'HTTP_CONNECTION' => 'TE, close',
- 'REQUEST_METHOD' => 'POST',
- 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
- 'CONTENT_LENGTH' => 3285,
- 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
- 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
- 'HTTP_TE' => 'deflate,gzip;q=0.3',
- 'QUERY_STRING' => '',
- 'REMOTE_PORT' => '1855',
- 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
- 'SERVER_PORT' => '80',
- 'REMOTE_ADDR' => '127.0.0.1',
- 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
- 'SERVER_PROTOCOL' => 'HTTP/1.1',
- 'PATH' => '/usr/local/bin:/usr/bin:/bin',
- 'REQUEST_URI' => '/test.cgi',
- 'GATEWAY_INTERFACE' => 'CGI/1.1',
- 'SCRIPT_URL' => '/test.cgi',
- 'SERVER_ADDR' => '127.0.0.1',
- 'DOCUMENT_ROOT' => '/home/develop',
- 'HTTP_HOST' => 'www.perl.org'
-);
+my %myenv;
+
+BEGIN {
+ %myenv = (
+ 'SCRIPT_NAME' => '/test.cgi',
+ 'SERVER_NAME' => 'perl.org',
+ 'HTTP_CONNECTION' => 'TE, close',
+ 'REQUEST_METHOD' => 'POST',
+ 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
+ 'CONTENT_LENGTH' => 3285,
+ 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
+ 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
+ 'HTTP_TE' => 'deflate,gzip;q=0.3',
+ 'QUERY_STRING' => '',
+ 'REMOTE_PORT' => '1855',
+ 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
+ 'SERVER_PORT' => '80',
+ 'REMOTE_ADDR' => '127.0.0.1',
+ 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
+ 'SERVER_PROTOCOL' => 'HTTP/1.1',
+ 'PATH' => '/usr/local/bin:/usr/bin:/bin',
+ 'REQUEST_URI' => '/test.cgi',
+ 'GATEWAY_INTERFACE' => 'CGI/1.1',
+ 'SCRIPT_URL' => '/test.cgi',
+ 'SERVER_ADDR' => '127.0.0.1',
+ 'DOCUMENT_ROOT' => '/home/develop',
+ 'HTTP_HOST' => 'www.perl.org'
+ );
+
+ for my $key (keys %myenv) {
+ $ENV{$key} = $myenv{$key};
+ }
+}
+
+END {
+ for my $key (keys %myenv) {
+ delete $ENV{$key};
+ }
+}
+
#-----------------------------------------------------------------------------
# Simulate the upload (really, multiple uploads contained in a single stream).
More information about the Pkg-perl-cvs-commits
mailing list