r66726 - in /branches/upstream/libcgi-simple-perl/current: ./ lib/CGI/ lib/CGI/Simple/ t/
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Fri Dec 31 15:56:55 UTC 2010
Author: dmn
Date: Fri Dec 31 15:56:48 2010
New Revision: 66726
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66726
Log:
[svn-upgrade] new version libcgi-simple-perl (1.113)
Added:
branches/upstream/libcgi-simple-perl/current/t/headers.t
branches/upstream/libcgi-simple-perl/current/t/upload_info.t
Modified:
branches/upstream/libcgi-simple-perl/current/Changes
branches/upstream/libcgi-simple-perl/current/MANIFEST
branches/upstream/libcgi-simple-perl/current/META.yml
branches/upstream/libcgi-simple-perl/current/README
branches/upstream/libcgi-simple-perl/current/SIGNATURE
branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple.pm
branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Cookie.pm
branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Standard.pm
branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Util.pm
branches/upstream/libcgi-simple-perl/current/t/020.cookie.t
branches/upstream/libcgi-simple-perl/current/t/050.simple.t
branches/upstream/libcgi-simple-perl/current/t/070.standard.t
Modified: branches/upstream/libcgi-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/Changes?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/Changes (original)
+++ branches/upstream/libcgi-simple-perl/current/Changes Fri Dec 31 15:56:48 2010
@@ -174,3 +174,63 @@
1.112 2009-05-31
- (thanks bingos) added missing IO::Scalar dependency.
+
+1.113 2010-12-27
+ - (thanks to Yamada Masahiro) randomise multipart boundary string
+ (security).
+
+ - Numerous changes from Mark Stosberg:
+
+ Port max-age support from CGI.pm, to improve compatibility and
+ RFC-compliance
+
+ Correct header comment in cookie.t
+
+ It claims that is a simple copy/paste/modify from CGI.pm's test
+ by the same name, but this has not been true for some time--
+ CGI::Simple added
+
+ httponly tests that CGI.pm lacks, for example.
+
+ Sync cookie references with CGI.pm: add reference to the
+ newer RFC 2695
+
+ "Interface to browse cookies" looks like it was typo for
+ "browser". HTTP is more precise.
+
+ Fix awkward "CGI::Simple.pm" language. It looks like it probably
+ originated from the CGI.pm form. "CGI::Simple" is used instead.
+
+ Best Practice: eliminate indirect object notation from new(),
+ parse() and fetch() calls
+
+ Security: Fix handling of embedded malicious newlines in header
+ values This is a direct port of the same security fix that
+
+ Security: use a random MIME boundary by default in
+ multipart_init(). This is a direct port of the same issue
+ which was addressed in CGI.pm, preventing some kinds of
+ potential header injection attacks.
+
+ Port from CGI.pm: Fix multi-line header parsing.
+ This fix is covered by the tests in t/header.t added in
+ the previous patch. If you run those tests without this
+ patch, you'll see how the headers would be malformed
+ without this fix.
+
+ Port CRLF injection prevention from CGI.pm
+
+ Optimize Vars(): Don't build %hash if we aren't going to use it.
+
+ Micro-optimization to Vars(): Don't call "tie" unless we need to.
+
+ - Numerous changes from K. Berov:
+
+ Added "+" to the mime character class.
+
+ Added tests for C<$mime = $q->upload_info( $filename, 'mime' );>
+
+ Fixed wrong match for mimetypes. Example: matched only
+ 'application/vnd' instead of 'application/vnd.ms-excel'.
+
+ Added "\." to the mime character class
Modified: branches/upstream/libcgi-simple-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/MANIFEST?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/MANIFEST (original)
+++ branches/upstream/libcgi-simple-perl/current/MANIFEST Fri Dec 31 15:56:48 2010
@@ -21,8 +21,10 @@
t/090.14838.t
t/100.set-cookie.t
t/110.bad-upload.t
+t/headers.t
t/manifest.t
t/pod-coverage.t
t/pod.t
t/test_file.txt
+t/upload_info.t
SIGNATURE Added here by Module::Build
Modified: branches/upstream/libcgi-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/META.yml?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/META.yml (original)
+++ branches/upstream/libcgi-simple-perl/current/META.yml Fri Dec 31 15:56:48 2010
@@ -1,31 +1,33 @@
---
-name: CGI-Simple
-version: 1.112
+abstract: 'A Simple totally OO CGI interface that is CGI.pm compliant'
author:
- 'Andy Armstrong <andy at hexten.net>'
-abstract: A Simple totally OO CGI interface that is CGI.pm compliant
+configure_requires:
+ Module::Build: 0.36
+generated_by: 'Module::Build version 0.3607'
license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: CGI-Simple
+provides:
+ CGI::Simple:
+ file: lib/CGI/Simple.pm
+ version: 1.113
+ CGI::Simple::Cookie:
+ file: lib/CGI/Simple/Cookie.pm
+ version: 1.113
+ CGI::Simple::Standard:
+ file: lib/CGI/Simple/Standard.pm
+ version: 1.113
+ CGI::Simple::Util:
+ file: lib/CGI/Simple/Util.pm
+ version: 1.113
+requires:
+ IO::Scalar: 0
+ Test::More: 0
resources:
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=CGI-Simple
license: http://dev.perl.org/licenses/
- repository: git://github.com/AndyA/CGI--Simple.git
-requires:
- IO::Scalar: 0
- Test::More: 0
-provides:
- CGI::Simple:
- file: lib/CGI/Simple.pm
- version: 1.112
- CGI::Simple::Cookie:
- file: lib/CGI/Simple/Cookie.pm
- version: 1.112
- CGI::Simple::Standard:
- file: lib/CGI/Simple/Standard.pm
- version: 1.112
- CGI::Simple::Util:
- file: lib/CGI/Simple/Util.pm
- version: 1.112
-generated_by: Module::Build version 0.33
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ repository: 'git://github.com/AndyA/CGI--Simple.git (fetch)'
+version: 1.113
Modified: branches/upstream/libcgi-simple-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/README?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/README (original)
+++ branches/upstream/libcgi-simple-perl/current/README Fri Dec 31 15:56:48 2010
@@ -1,4 +1,4 @@
-CGI-Simple version 1.112
+CGI-Simple version 1.113
INSTALLATION
Modified: branches/upstream/libcgi-simple-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/SIGNATURE?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/SIGNATURE (original)
+++ branches/upstream/libcgi-simple-perl/current/SIGNATURE Fri Dec 31 15:56:48 2010
@@ -1,5 +1,5 @@
This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.55.
+signed via the Module::Signature module, version 0.66.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
@@ -15,36 +15,38 @@
Hash: SHA1
SHA1 e045be9cdb8db55f717cf79e924203e1414225f6 Build.PL
-SHA1 9d607c4a3231ade798a32e66e5886508d2222a92 Changes
-SHA1 63309d39b5c5374b4666faca712d3a092e1595f7 MANIFEST
-SHA1 3ae8f3084974ca1037b3d9e99363b1b85501174c META.yml
+SHA1 1bd8b94957bfd7da59ef9807a45dc2d00e788ae4 Changes
+SHA1 154204e3d020e794e62de630951ee023f3475876 MANIFEST
+SHA1 ff5c3777e70cce70c0a57013ecb116f4eadc0655 META.yml
SHA1 95715f0bf53b6848943258a57e2ba3b06054b7b0 Makefile.PL
-SHA1 763fd78441823a3bdcfc8784b0b5f531ce4105b6 README
+SHA1 10e555a784ad648e40b199025e99b781c1b5ecfa README
SHA1 8c97bbeb63b586ee9c722313c2ad7858e32ff52c inc/MyBuilder.pm
-SHA1 f9f26dd48c0032c280ef97df32ed0364596a7568 lib/CGI/Simple.pm
-SHA1 029734f02cbe279d921eaeed991c6b05005b58d4 lib/CGI/Simple/Cookie.pm
-SHA1 a98e3938824d2b802b1d5f9cec7f4312ccf31de2 lib/CGI/Simple/Standard.pm
-SHA1 3e5c2304828d4f155bd7b5f9f6d2e864f41b38f6 lib/CGI/Simple/Util.pm
+SHA1 3827cb87f45b8520fd33c90c0b6fc610477bdf1f lib/CGI/Simple.pm
+SHA1 60b212aa1d5c324d5fd4b428a0509d7e37feb261 lib/CGI/Simple/Cookie.pm
+SHA1 6fce2653ddeb7dad140b54e5917021c2ae22c1ab lib/CGI/Simple/Standard.pm
+SHA1 407108f939abc700a7a415fc8db9ab3860882108 lib/CGI/Simple/Util.pm
SHA1 029a0c2274884058f99bc339fd5bb073348c2b77 t/000.load.t
-SHA1 b02cd8953e5da31678711b93f4f8ebc2939e453a t/020.cookie.t
+SHA1 e66def005f5f56804341bbf6208d09636ce90763 t/020.cookie.t
SHA1 ca2ff8ba2f9a5f68c75e8d9527af38b042067148 t/030.function.t
SHA1 e8fbebb9354bcd7755bfecaa564f44467265242c t/040.request.t
SHA1 3678058ca2f62b397aab7560caeec6a06c4c1117 t/041.multipart.t
-SHA1 8d8747fc53c5f306ab4fbc7db03542580f0b3ada t/050.simple.t
+SHA1 1cb680ef671319e86103b7927c9d93b31d3d253b t/050.simple.t
SHA1 f77e6013c2de0bcf99c73c4af2ecc6220f7ec3a1 t/060.slow_post.t
-SHA1 5e01c2acd0bd0ee4ebf9b04a02e4d87e1b879b60 t/070.standard.t
+SHA1 25f3447480a95a844b6f893ca47106788f8c19d8 t/070.standard.t
SHA1 4a7dade2334d9e4f5b223cbb6c9ebd49cb5cf4a3 t/080.util.t
SHA1 432c00d3873dd6c70998f18149ba7517ffb56602 t/090.14838.t
SHA1 73ac0f1550806696461a8c356aaff53393837aa7 t/100.set-cookie.t
SHA1 b068924cea067616ced5d01ce376a157caf701a1 t/110.bad-upload.t
+SHA1 3091c116da74659dc33651d6bf2ce2f3c96eea12 t/headers.t
SHA1 8c049d1fe65af78a4c01ebcc7d81f37b65b15738 t/manifest.t
SHA1 d8b34ef82d206d0e64a5298a3d311ba2d87e29b9 t/pod-coverage.t
SHA1 0190346d7072d458c8a10a45c19f86db641dcc48 t/pod.t
SHA1 334f18ad2bd0fb8b8757d9607f9d0089bb88a1ee t/test_file.txt
+SHA1 a232e5fa0fdc30997bdb22104c4b6eea45978b25 t/upload_info.t
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.9 (Darwin)
+Version: GnuPG v1.4.11 (Darwin)
-iEYEARECAAYFAkoiXzkACgkQwoknRJZQnCFOowCghr6L7snVjnxH/wBOHdNUTzgl
-0iIAoIqlQLnYszm64ka9qxI5UIXTO6E/
-=lVHC
+iEYEARECAAYFAk0YkHcACgkQwoknRJZQnCGcegCgxnjuy2tsQhBxwSvKPPo7t6VC
+6q8AoIAfVDbHZ2OcL1e8EXTTV+CgQig1
+=seUy
-----END PGP SIGNATURE-----
Modified: branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple.pm?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple.pm (original)
+++ branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple.pm Fri Dec 31 15:56:48 2010
@@ -13,7 +13,7 @@
$NPH $DEBUG $NO_NULL $FATAL *in
);
-$VERSION = "1.112";
+$VERSION = "1.113";
# you can hard code the global variable settings here if you want.
# warning - do not delete the unless defined $VAR part unless you
@@ -515,7 +515,7 @@
= $unfold =~ m/name="?\Q$param\E"?;\s+filename="?([^\"]*)"?/;
if ( defined $filename ) {
- my ( $mime ) = $unfold =~ m/Content-Type:\s+([-\w\/]+)/io;
+ my ( $mime ) = $unfold =~ m/Content-Type:\s+([-\w\+\.\/]+)/io;
$data =~ s/^\Q$header\E//;
( $got_data, $data, my $fh, my $size )
= $self->_save_tmpfile( $handle, $boundary, $filename,
@@ -683,12 +683,18 @@
sub Vars {
my $self = shift;
$self->{'.sep'} = shift || $self->{'.sep'} || "\0";
- my ( %hash, %tied );
- for my $param ( $self->param ) {
- $hash{$param} = join $self->{'.sep'}, $self->param( $param );
- }
- tie %tied, "CGI::Simple", $self;
- return wantarray ? %hash : \%tied;
+ if ( wantarray ) {
+ my %hash;
+ for my $param ( $self->param ) {
+ $hash{$param} = join $self->{'.sep'}, $self->param( $param );
+ }
+ return %hash;
+ }
+ else {
+ my %tied;
+ tie %tied, "CGI::Simple", $self;
+ return \%tied;
+ }
}
sub TIEHASH { $_[1] ? $_[1] : new $_[0] }
@@ -986,6 +992,31 @@
],
@params
);
+
+ my $CRLF = $self->crlf;
+
+ # CR escaping for values, per RFC 822
+ for my $header (
+ $type, $status, $cookie, $target, $expires,
+ $nph, $charset, $attachment, $p3p, @other
+ ) {
+ if ( defined $header ) {
+ # From RFC 822:
+ # Unfolding is accomplished by regarding CRLF immediately
+ # followed by a LWSP-char as equivalent to the LWSP-char.
+ $header =~ s/$CRLF(\s)/$1/g;
+
+ # All other uses of newlines are invalid input.
+ if ( $header =~ m/$CRLF/ ) {
+ # shorten very long values in the diagnostic
+ $header = substr( $header, 0, 72 ) . '...'
+ if ( length $header > 72 );
+ die
+ "Invalid header value contains a newline not followed by whitespace: $header";
+ }
+ }
+ }
+
$nph ||= $self->{'.globals'}->{'NPH'};
$charset = $self->charset( $charset )
; # get charset (and set new charset if supplied)
@@ -995,7 +1026,7 @@
# Don't use \s because of perl bug 21951
next
- unless my ( $header, $value ) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
+ unless my ( $header, $value ) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
( $_ = $header )
=~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
}
@@ -1042,7 +1073,6 @@
if $attachment;
push @header, @other;
push @header, "Content-Type: $type" if $type;
- my $CRLF = $self->crlf;
my $header = join $CRLF, @header;
$header .= $CRLF . $CRLF; # add the statutory two CRLFs
@@ -1105,7 +1135,14 @@
my ( $self, @p ) = @_;
use CGI::Simple::Util qw(rearrange);
my ( $boundary, @other ) = rearrange( ['BOUNDARY'], @p );
- $boundary = $boundary || '------- =_aaaaaaaaaa0';
+ if ( !$boundary ) {
+ $boundary = '------- =_';
+ my @chrs = ( '0' .. '9', 'A' .. 'Z', 'a' .. 'z' );
+ for ( 1 .. 17 ) {
+ $boundary .= $chrs[ rand( scalar @chrs ) ];
+ }
+ }
+
my $CRLF = $self->crlf; # get CRLF sequence
my $warning
= "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.";
@@ -1450,7 +1487,7 @@
=head1 VERSION
-This document describes CGI::Simple version 1.112.
+This document describes CGI::Simple version 1.113.
=head1 SYNOPSIS
@@ -3882,7 +3919,8 @@
Thanks for patches to:
-Ewan Edwards, Joshua N Pritikin, Mike Barry
+Ewan Edwards, Joshua N Pritikin, Mike Barry, Michael Nachbaur, Chris
+Williams, Mark Stosberg, Krasimir Berov, Yamada Masahiro
=head1 LICENCE AND COPYRIGHT
Modified: branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Cookie.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Cookie.pm?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Cookie.pm (original)
+++ branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Cookie.pm Fri Dec 31 15:56:48 2010
@@ -12,7 +12,7 @@
use strict;
use vars '$VERSION';
-$VERSION = '1.112';
+$VERSION = '1.113';
use CGI::Simple::Util qw(rearrange unescape escape);
use overload '""' => \&as_string, 'cmp' => \&compare, 'fallback' => 1;
@@ -72,13 +72,16 @@
sub new {
my ( $class, @params ) = @_;
$class = ref( $class ) || $class;
- my ( $name, $value, $path, $domain, $secure, $expires, $httponly )
+ my (
+ $name, $value, $path, $domain,
+ $secure, $expires, $max_age, $httponly
+ )
= rearrange(
[
'NAME', [ 'VALUE', 'VALUES' ],
- 'PATH', 'DOMAIN',
- 'SECURE', 'EXPIRES',
- 'HTTPONLY'
+ 'PATH', 'DOMAIN',
+ 'SECURE', 'EXPIRES',
+ 'MAX-AGE', 'HTTPONLY'
],
@params
);
@@ -92,6 +95,7 @@
$self->domain( $domain ) if defined $domain;
$self->secure( $secure ) if defined $secure;
$self->expires( $expires ) if defined $expires;
+ $self->max_age( $expires ) if defined $max_age;
$self->httponly( $httponly ) if defined $httponly;
return $self;
}
@@ -105,6 +109,7 @@
push @cookie, "domain=" . $self->domain if $self->domain;
push @cookie, "path=" . $self->path if $self->path;
push @cookie, "expires=" . $self->expires if $self->expires;
+ push @cookie, "max-age=" . $self->max_age if $self->max_age;
push @cookie, "secure" if $self->secure;
push @cookie, "HttpOnly" if $self->httponly;
return join "; ", @cookie;
@@ -153,6 +158,14 @@
return $self->{'expires'};
}
+sub max_age {
+ my ( $self, $max_age ) = @_;
+ $self->{'max-age'}
+ = CGI::Simple::Util::_expire_calc( $max_age ) - time()
+ if defined $max_age;
+ return $self->{'max-age'};
+}
+
sub path {
my ( $self, $path ) = @_;
$self->{'path'} = $path if defined $path;
@@ -171,7 +184,7 @@
=head1 NAME
-CGI::Simple::Cookie - Interface to browse cookies
+CGI::Simple::Cookie - Interface to HTTP cookies
=head1 SYNOPSIS
@@ -179,31 +192,32 @@
use CGI::Simple::Cookie;
# Create new cookies and send them
- $cookie1 = new CGI::Simple::Cookie( -name=>'ID', -value=>123456 );
- $cookie2 = new CGI::Simple::Cookie( -name=>'preferences',
+ $cookie1 = CGI::Simple::Cookie->new( -name=>'ID', -value=>123456 );
+ $cookie2 = CGI::Simple::Cookie->new( -name=>'preferences',
-value=>{ font => Helvetica,
size => 12 }
);
print header( -cookie=>[$cookie1,$cookie2] );
# fetch existing cookies
- %cookies = fetch CGI::Simple::Cookie;
+ %cookies = CGI::Simple::Cookie->fetch;
$id = $cookies{'ID'}->value;
# create cookies returned from an external source
- %cookies = parse CGI::Simple::Cookie($ENV{COOKIE});
+ %cookies = CGI::Simple::Cookie->parse($ENV{COOKIE});
=head1 DESCRIPTION
CGI::Simple::Cookie is an interface to HTTP/1.1 cookies, a mechanism
that allows Web servers to store persistent information on the browser's
side of the connection. Although CGI::Simple::Cookie is intended to be
-used in conjunction with CGI::Simple.pm (and is in fact used by it
+used in conjunction with CGI::Simple (and is in fact used by it
internally), you can use this module independently.
For full information on cookies see:
- http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
+ http://tools.ietf.org/html/rfc2109
+ http://tools.ietf.org/html/rfc2965
=head1 USING CGI::Simple::Cookie
@@ -267,7 +281,7 @@
=head2 Creating New Cookies
- $c = new CGI::Simple::Cookie( -name => 'foo',
+ $c = CGI::Simple::Cookie->new( -name => 'foo',
-value => 'bar',
-expires => '+3M',
-domain => '.capricorn.com',
@@ -282,8 +296,16 @@
object serialization protocols for full generality).
B<-expires> accepts any of the relative or absolute date formats
-recognized by CGI::Simple.pm, for example "+3M" for three months in the
-future. See CGI::Simple.pm's documentation for details.
+recognized by CGI::Simple, for example "+3M" for three months in the
+future. See CGI::Simple's documentation for details.
+
+B<-max-age> accepts the same data formats as B<< -expires >>, but sets a
+relative value instead of an absolute like B<< -expires >>. This is intended to be
+more secure since a clock could be changed to fake an absolute time. In
+practice, as of 2011, C<< -max-age >> still does not enjoy the widespread support
+that C<< -expires >> has. You can set both, and browsers that support
+C<< -max-age >> should ignore the C<< Expires >> header. The drawback
+to this approach is the bit of bandwidth for sending an extra header on each cookie.
B<-domain> points to a domain name or to a fully qualified host name.
If not specified, the cookie will be returned only to the Web server
@@ -306,7 +328,7 @@
one or more Set-Cookie: fields in the HTTP header. Here is a typical
sequence:
- $c = new CGI::Simple::Cookie( -name => 'foo',
+ $c = CGI::Simple::Cookie->new( -name => 'foo',
-value => ['bar','baz'],
-expires => '+3M'
);
@@ -318,7 +340,7 @@
Alternatively, you may concatenate the cookies together with "; " and
send them in one field.
-If you are using CGI::Simple.pm, you send cookies by providing a -cookie
+If you are using CGI::Simple, you send cookies by providing a -cookie
argument to the header() method:
print header( -cookie=>$c );
@@ -337,13 +359,13 @@
=head2 Recovering Previous Cookies
- %cookies = fetch CGI::Simple::Cookie;
+ %cookies = CGI::Simple::Cookie->fetch;
B<fetch> returns an associative array consisting of all cookies
returned by the browser. The keys of the array are the cookie names. You
can iterate through the cookies this way:
- %cookies = fetch CGI::Simple::Cookie;
+ %cookies = CGI::Simple::Cookie->fetch;
foreach (keys %cookies) {
do_something($cookies{$_});
}
@@ -351,7 +373,7 @@
In a scalar context, fetch() returns a hash reference, which may be more
efficient if you are manipulating multiple cookies.
-CGI::Simple.pm uses the URL escaping methods to save and restore reserved
+CGI::Simple uses the URL escaping methods to save and restore reserved
characters in its cookies. If you are trying to retrieve a cookie set by
a foreign server, this escaping method may trip you up. Use raw_fetch()
instead, which has the same semantics as fetch(), but performs no unescaping.
@@ -360,7 +382,7 @@
form using the parse() class method:
$COOKIES = `cat /usr/tmp/Cookie_stash`;
- %cookies = parse CGI::Simple::Cookie($COOKIES);
+ %cookies = CGI::Simple::Cookie->parse($COOKIES);
=head2 Manipulating Cookies
@@ -402,6 +424,10 @@
Get or set the cookie's expiration time.
+=item B<max_age()>
+
+Get or set the cookie's maximum age.
+
=item B<secure()>
Get or set the cookie's secure flag.
Modified: branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Standard.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Standard.pm?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Standard.pm (original)
+++ branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Standard.pm Fri Dec 31 15:56:48 2010
@@ -7,7 +7,7 @@
$NO_UNDEF_PARAMS $USE_PARAM_SEMICOLONS $HEADERS_ONCE
$NPH $DEBUG $NO_NULL $FATAL *in %EXPORT_TAGS $AUTOLOAD );
-$VERSION = "1.112";
+$VERSION = "1.113";
%EXPORT_TAGS = (
':html' => [qw(:misc)],
@@ -406,7 +406,7 @@
=head1 SEE ALSO
-L<CGI::Simple which is the back end for this module>,
+L<CGI::Simple> which is the back end for this module,
B<CGI.pm by Lincoln Stein>
=cut
Modified: branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Util.pm?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Util.pm (original)
+++ branches/upstream/libcgi-simple-perl/current/lib/CGI/Simple/Util.pm Fri Dec 31 15:56:48 2010
@@ -1,7 +1,7 @@
package CGI::Simple::Util;
use strict;
use vars qw( $VERSION @EXPORT_OK @ISA $UTIL );
-$VERSION = '1.112';
+$VERSION = '1.113';
require Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw(
@@ -115,7 +115,8 @@
else {
return $time;
}
- return ( time + $offset );
+ my $cur_time = time;
+ return ( $cur_time + $offset );
}
sub escapeHTML {
Modified: branches/upstream/libcgi-simple-perl/current/t/020.cookie.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/t/020.cookie.t?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/t/020.cookie.t (original)
+++ branches/upstream/libcgi-simple-perl/current/t/020.cookie.t Fri Dec 31 15:56:48 2010
@@ -1,8 +1,15 @@
-# This is the original cookie.t file distributed with CGI.pm 2.78
-# The only modification is to change CGI::Cookie to CGI::Simple::Cookie
-# whenever it appears
-
-use Test::More tests => 93;
+# This was forked from the original cookie.t file distributed with CGI.pm 2.78
+# Originally, only modification is to change CGI::Cookie to CGI::Simple::Cookie
+# whenever it appeared. Since then the tests suites for CGI.pm and CGI::Simple
+# have not been kept in sync.
+
+# to have a consistent baseline, we nail the current time
+# to 100 seconds after the epoch
+BEGIN {
+ *CORE::GLOBAL::time = sub { 100 };
+}
+
+use Test::More tests => 98;
use strict;
use CGI::Simple::Util qw(escape unescape);
use POSIX qw(strftime);
@@ -390,3 +397,33 @@
ok( !$c->httponly( 0 ), 'httponly attribute is cleared' );
ok( !$c->httponly, 'httponly attribute is cleared' );
}
+
+#----------------------------------------------------------------------------
+# Max-age
+#----------------------------------------------------------------------------
+
+MAX_AGE: {
+ {
+ my $cookie = CGI::Simple::Cookie->new(
+ -name => 'a',
+ value => 'b',
+ '-expires' => 'now',
+ );
+ is $cookie->expires, 'Thu, 01-Jan-1970 00:01:40 GMT';
+ is $cookie->max_age => undef,
+ 'max-age is undefined when setting expires';
+ }
+
+ {
+ my $cookie
+ = CGI::Simple::Cookie->new( -name => 'a', 'value' => 'b' );
+ $cookie->max_age( '+4d' );
+
+ is $cookie->expires, undef, 'expires is undef when setting max_age';
+ is $cookie->max_age => 4 * 24 * 60 * 60, 'setting via max-age';
+
+ $cookie->max_age( '113' );
+ is $cookie->max_age => 13, 'max_age(num) as delta';
+ }
+}
+
Modified: branches/upstream/libcgi-simple-perl/current/t/050.simple.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/t/050.simple.t?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/t/050.simple.t (original)
+++ branches/upstream/libcgi-simple-perl/current/t/050.simple.t Fri Dec 31 15:56:48 2010
@@ -1,4 +1,4 @@
-use Test::More tests => 318;
+use Test::More tests => 319;
use Carp;
use strict;
use vars qw(%field %in);
@@ -940,17 +940,25 @@
is( $sv, $header, 'redirect() - nph, 1' );
################# Server Push Methods #################
-$q = new CGI::Simple;
+$q = CGI::Simple->new;
$sv = $q->multipart_init();
like(
$sv,
- qr|Content-Type: multipart/x-mixed-replace;boundary="------- =_aaaaaaaaaa0"|,
+ qr|Content-Type: multipart/x-mixed-replace;boundary="------- =_[a-zA-Z0-9]{17}"|,
'multipart_init(), 1'
);
-like( $sv, qr/--------- =_aaaaaaaaaa0$CRLF/, 'multipart_init(), 2' );
+like( $sv, qr/--------- =_[a-zA-Z0-9]{17}$CRLF/,
+ 'multipart_init(), 2' );
$sv = $q->multipart_init( 'this_is_the_boundary' );
like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init(), 3' );
+{
+ my $sv1 = $q->multipart_init;
+ my $sv2 = $q->multipart_init;
+ isnt( $sv1, $sv2,
+ "due to random boundaries, multiple calls produce different results"
+ );
+}
$sv = $q->multipart_init( -boundary => 'this_is_another_boundary' );
like(
$sv,
Modified: branches/upstream/libcgi-simple-perl/current/t/070.standard.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/t/070.standard.t?rev=66726&op=diff
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/t/070.standard.t (original)
+++ branches/upstream/libcgi-simple-perl/current/t/070.standard.t Fri Dec 31 15:56:48 2010
@@ -1,4 +1,4 @@
-use Test::More tests => 288;
+use Test::More tests => 289;
use Carp;
use strict;
use vars qw(%field %in);
@@ -953,12 +953,21 @@
$sv = multipart_init();
like(
$sv,
- qr|Content-Type: multipart/x-mixed-replace;boundary="------- =_aaaaaaaaaa0"|,
+ qr|Content-Type: multipart/x-mixed-replace;boundary="------- =_[a-zA-Z0-9]{17}"|,
'multipart_init(), 1'
);
-like( $sv, qr/--------- =_aaaaaaaaaa0$CRLF/, 'multipart_init(), 2' );
+
+like( $sv, qr/--------- =_[a-zA-Z0-9]{17}$CRLF/,
+ 'multipart_init(), 2' );
$sv = multipart_init( 'this_is_the_boundary' );
like( $sv, qr/boundary="this_is_the_boundary"/, 'multipart_init(), 3' );
+{
+ my $sv1 = multipart_init();
+ my $sv2 = multipart_init();
+ isnt( $sv1, $sv2,
+ "due to random boundaries, multiple calls produce different results"
+ );
+}
$sv = multipart_init( -boundary => 'this_is_another_boundary' );
like(
$sv,
Added: branches/upstream/libcgi-simple-perl/current/t/headers.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/t/headers.t?rev=66726&op=file
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/t/headers.t (added)
+++ branches/upstream/libcgi-simple-perl/current/t/headers.t Fri Dec 31 15:56:48 2010
@@ -1,0 +1,78 @@
+
+# Test that header generation is spec compliant.
+# References:
+# http://www.w3.org/Protocols/rfc2616/rfc2616.html
+# http://www.w3.org/Protocols/rfc822/3_Lexical.html
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use CGI::Simple;
+
+my $cgi = CGI::Simple->new;
+
+like $cgi->header( -type => "text/html" ),
+ qr#Type: text/html#, 'known header, basic case: type => "text/html"';
+
+eval {
+ like $cgi->header(
+ -type => "text/html" . $cgi->crlf . "evil: stuff" ),
+ qr#Type: text/html evil: stuff#, 'known header';
+};
+like( $@, qr/contains a newline/, 'invalid header blows up' );
+
+like $cgi->header(
+ -type => "text/html" . $cgi->crlf . " evil: stuff " ),
+ qr#Content-Type: text/html evil: stuff#,
+ 'known header, with leading and trailing whitespace on the continuation line';
+
+eval {
+ like $cgi->header(
+ -foobar => "text/html" . $cgi->crlf . "evil: stuff" ),
+ qr#Foobar: text/htmlevil: stuff#, 'unknown header';
+};
+like(
+ $@,
+ qr/contains a newline/,
+ 'unknown header with CRLF embedded blows up'
+);
+
+like $cgi->header( -foobar => "Content-type: evil/header" ),
+ qr#^Foobar: Content-type: evil/header#m,
+ 'unknown header with leading newlines';
+
+eval {
+ like $cgi->redirect(
+ -type => "text/html" . $cgi->crlf . "evil: stuff" ),
+ qr#Type: text/htmlevil: stuff#, 'redirect w/ known header';
+};
+like(
+ $@,
+ qr/contains a newline/,
+ 'redirect with known header with CRLF embedded blows up'
+);
+
+eval {
+ like $cgi->redirect(
+ -foobar => "text/html" . $cgi->crlf . "evil: stuff" ),
+ qr#Foobar: text/htmlevil: stuff#, 'redirect w/ unknown header';
+};
+like(
+ $@,
+ qr/contains a newline/,
+ 'redirect with unknown header with CRLF embedded blows up'
+);
+
+eval {
+ like $cgi->redirect(
+ $cgi->crlf . $cgi->crlf . "Content-Type: text/html" ),
+ qr#Location: Content-Type#, 'redirect w/ leading newline ';
+};
+like(
+ $@,
+ qr/contains a newline/,
+ 'redirect with leading newlines blows up'
+);
+
Added: branches/upstream/libcgi-simple-perl/current/t/upload_info.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-simple-perl/current/t/upload_info.t?rev=66726&op=file
==============================================================================
--- branches/upstream/libcgi-simple-perl/current/t/upload_info.t (added)
+++ branches/upstream/libcgi-simple-perl/current/t/upload_info.t Fri Dec 31 15:56:48 2010
@@ -1,0 +1,60 @@
+use Test::More tests => 3;
+use strict;
+use warnings;
+use IO::Scalar;
+
+use CGI::Simple;
+# Set up a CGI environment
+$ENV{REQUEST_METHOD} = 'POST';
+$ENV{QUERY_STRING} = '';
+$ENV{PATH_INFO} = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME} = '/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'upload.info.com';
+$ENV{CONTENT_TYPE}
+ = q{multipart/form-data; boundary=---------------------------10263292819275730631136676268};
+$ENV{REQUEST_URI}
+ = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
+$ENV{HTTP_LOVE} = 'true';
+
+my $body = <<EOF;
+-----------------------------10263292819275730631136676268\r
+Content-Disposition: form-data; name="rm"\r
+\r
+index\r
+-----------------------------10263292819275730631136676268\r
+Content-Disposition: form-data; name="file0"; filename="image.png"\r
+Content-Type: image/png\r
+\r
+fake\r
+-----------------------------10263292819275730631136676268\r
+Content-Disposition: form-data; name="file1"; filename="image.svg"\r
+Content-Type: image/svg+xml\r
+\r
+<svg>fake</svg>\r
+-----------------------------10263292819275730631136676268\r
+Content-Disposition: form-data; name="file2"; filename="spreadsheet.xls"\r
+Content-Type: application/vnd.ms-excel\r
+\r
+fake\r
+-----------------------------10263292819275730631136676268--\r
+
+EOF
+$ENV{CONTENT_LENGTH} = length $body;
+
+my $h = IO::Scalar->new( \$body );
+my $q = new CGI::Simple( $h );
+ok( $q->upload_info( $q->param( 'file0' ), 'mime' ) eq 'image/png',
+ 'Guess mime for image/png' );
+ok( $q->upload_info( $q->param( 'file1' ), 'mime' ) eq 'image/svg+xml',
+ 'Guess mime for image/svg+xml' );
+ok(
+ $q->upload_info( $q->param( 'file2' ), 'mime' ) eq
+ 'application/vnd.ms-excel',
+ 'Guess mime for application/vnd.ms-excel'
+);
+
+#2010-03-19 by Krasimir Berov, based on 041.multipart.t
+
More information about the Pkg-perl-cvs-commits
mailing list