diff -Nru libcgi-psgi-perl-0.13/Changes libcgi-psgi-perl-0.15/Changes --- libcgi-psgi-perl-0.13/Changes 2010-10-31 06:09:13.000000000 +0000 +++ libcgi-psgi-perl-0.15/Changes 2011-05-17 20:59:11.000000000 +0000 @@ -1,5 +1,12 @@ Revision history for Perl extension CGI::PSGI +0.15 Tue May 17 13:58:50 PDT 2011 + - Updated the list of overriding methods per CGI.pm update + - Added a note that you can't use CGI::Pretty (reported by Maestro) + +0.14 Sat Dec 25 11:35:52 PST 2010 + - Port fixes for header injection from CGI.pm (markstos) + 0.13 Sat Oct 30 23:09:06 PDT 2010 - Specify Test::More dep diff -Nru libcgi-psgi-perl-0.13/debian/changelog libcgi-psgi-perl-0.15/debian/changelog --- libcgi-psgi-perl-0.13/debian/changelog 2011-10-17 13:04:17.000000000 +0000 +++ libcgi-psgi-perl-0.15/debian/changelog 2011-08-29 13:01:31.000000000 +0000 @@ -1,3 +1,12 @@ +libcgi-psgi-perl (0.15-1) unstable; urgency=low + + * New upstream release + * Switch to dpkg-source 3.0 (quilt) format + * Update Standards-Version (no changes) + * Add missing inc/Module/Install debian/copyright entries + + -- Dominic Hargreaves Mon, 29 Aug 2011 14:01:30 +0100 + libcgi-psgi-perl (0.13-1) unstable; urgency=low * Initial Release. (Closes: #606816) diff -Nru libcgi-psgi-perl-0.13/debian/control libcgi-psgi-perl-0.15/debian/control --- libcgi-psgi-perl-0.13/debian/control 2011-10-17 13:04:17.000000000 +0000 +++ libcgi-psgi-perl-0.15/debian/control 2011-08-29 12:59:17.000000000 +0000 @@ -6,7 +6,7 @@ perl (>= 5.10.1) | libcgi-pm-perl (>= 3.33), perl (>= 5.10.1) | libtest-simple-perl (>= 0.88) Maintainer: Dominic Hargreaves -Standards-Version: 3.9.1 +Standards-Version: 3.9.2 Homepage: http://search.cpan.org/dist/CGI-PSGI/ Vcs-Browser: http://git.debian.org/?p=users/dom/libcgi-psgi-perl.git Vcs-Git: git://git.debian.org/~dom/libcgi-psgi-perl.git diff -Nru libcgi-psgi-perl-0.13/debian/copyright libcgi-psgi-perl-0.15/debian/copyright --- libcgi-psgi-perl-0.13/debian/copyright 2011-10-17 13:04:17.000000000 +0000 +++ libcgi-psgi-perl-0.15/debian/copyright 2011-08-29 13:00:50.000000000 +0000 @@ -1,4 +1,4 @@ -Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135 +Format-Specification: http://anonscm.debian.org/viewvc/dep/web/deps/dep5.mdwn?view=markup&pathrev=135 Maintainer: Tatsuhiko Miyagawa Source: http://search.cpan.org/dist/CGI-PSGI/ Name: CGI-PSGI @@ -7,6 +7,12 @@ Copyright: Tatsuhiko Miyagawa License: Artistic or GPL-1+ +Files: inc/Module/* +Copyright: 2002-2011, Adam Kennedy + 2002-2011, Audrey Tang + 2002-2011, Brian Ingerson +License: Artistic or GPL-1+ + Files: debian/* Copyright: 2010, Dominic Hargreaves License: Artistic or GPL-1+ diff -Nru libcgi-psgi-perl-0.13/debian/source/format libcgi-psgi-perl-0.15/debian/source/format --- libcgi-psgi-perl-0.13/debian/source/format 1970-01-01 00:00:00.000000000 +0000 +++ libcgi-psgi-perl-0.15/debian/source/format 2011-10-17 13:04:17.000000000 +0000 @@ -0,0 +1 @@ +3.0 (quilt) diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install/Base.pm libcgi-psgi-perl-0.15/inc/Module/Install/Base.pm --- libcgi-psgi-perl-0.13/inc/Module/Install/Base.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install/Base.pm 2011-05-17 21:00:07.000000000 +0000 @@ -4,7 +4,7 @@ use strict 'vars'; use vars qw{$VERSION}; BEGIN { - $VERSION = '1.00'; + $VERSION = '1.01'; } # Suspend handler for "redefined" warnings diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install/Can.pm libcgi-psgi-perl-0.15/inc/Module/Install/Can.pm --- libcgi-psgi-perl-0.13/inc/Module/Install/Can.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install/Can.pm 2011-05-17 21:00:07.000000000 +0000 @@ -9,7 +9,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.00'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install/Fetch.pm libcgi-psgi-perl-0.15/inc/Module/Install/Fetch.pm --- libcgi-psgi-perl-0.13/inc/Module/Install/Fetch.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install/Fetch.pm 2011-05-17 21:00:07.000000000 +0000 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.00'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install/Makefile.pm libcgi-psgi-perl-0.15/inc/Module/Install/Makefile.pm --- libcgi-psgi-perl-0.13/inc/Module/Install/Makefile.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install/Makefile.pm 2011-05-17 21:00:07.000000000 +0000 @@ -8,7 +8,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.00'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install/Metadata.pm libcgi-psgi-perl-0.15/inc/Module/Install/Metadata.pm --- libcgi-psgi-perl-0.13/inc/Module/Install/Metadata.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install/Metadata.pm 2011-05-17 21:00:07.000000000 +0000 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.00'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } @@ -515,6 +515,7 @@ 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, + 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, @@ -550,9 +551,9 @@ sub _extract_bugtracker { my @links = $_[0] =~ m#L<( - \Qhttp://rt.cpan.org/\E[^>]+| - \Qhttp://github.com/\E[\w_]+/[\w_]+/issues| - \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list + https?\Q://rt.cpan.org/\E[^>]+| + https?\Q://github.com/\E[\w_]+/[\w_]+/issues| + https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install/Win32.pm libcgi-psgi-perl-0.15/inc/Module/Install/Win32.pm --- libcgi-psgi-perl-0.13/inc/Module/Install/Win32.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install/Win32.pm 2011-05-17 21:00:07.000000000 +0000 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.00'; + $VERSION = '1.01'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install/WriteAll.pm libcgi-psgi-perl-0.15/inc/Module/Install/WriteAll.pm --- libcgi-psgi-perl-0.13/inc/Module/Install/WriteAll.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install/WriteAll.pm 2011-05-17 21:00:07.000000000 +0000 @@ -6,7 +6,7 @@ use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '1.00'; + $VERSION = '1.01'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } diff -Nru libcgi-psgi-perl-0.13/inc/Module/Install.pm libcgi-psgi-perl-0.15/inc/Module/Install.pm --- libcgi-psgi-perl-0.13/inc/Module/Install.pm 2010-10-31 06:09:26.000000000 +0000 +++ libcgi-psgi-perl-0.15/inc/Module/Install.pm 2011-05-17 21:00:06.000000000 +0000 @@ -31,7 +31,7 @@ # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. - $VERSION = '1.00'; + $VERSION = '1.01'; # Storage for the pseudo-singleton $MAIN = undef; @@ -467,4 +467,4 @@ 1; -# Copyright 2008 - 2010 Adam Kennedy. +# Copyright 2008 - 2011 Adam Kennedy. diff -Nru libcgi-psgi-perl-0.13/lib/CGI/PSGI.pm libcgi-psgi-perl-0.15/lib/CGI/PSGI.pm --- libcgi-psgi-perl-0.13/lib/CGI/PSGI.pm 2010-10-31 06:09:16.000000000 +0000 +++ libcgi-psgi-perl-0.15/lib/CGI/PSGI.pm 2011-05-17 20:59:55.000000000 +0000 @@ -2,7 +2,7 @@ use strict; use 5.008_001; -our $VERSION = '0.13'; +our $VERSION = '0.15'; use base qw(CGI); @@ -73,6 +73,23 @@ 'EXPIRES','NPH','CHARSET', 'ATTACHMENT','P3P'],@p); + # 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/$CGI::CRLF(\s)/$1/g; + + # All other uses of newlines are invalid input. + if ($header =~ m/$CGI::CRLF|\015|\012/) { + # 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"; + } + } + } + $type ||= 'text/html' unless defined($type); if (defined $charset) { $self->charset($charset); @@ -168,9 +185,12 @@ content_type path_translated request_uri + Accept + user_agent virtual_host remote_host remote_addr + referrer server_name server_software virtual_port @@ -214,11 +234,11 @@ use CGI::PSGI; - sub app { + my $app = sub { my $env = shift; my $q = CGI::PSGI->new($env); return [ $q->psgi_header, [ $body ] ]; - } + }; =head1 DESCRIPTION @@ -269,7 +289,7 @@ =head2 psgi_header - my ($status_code, $headers_aref) = $cgi->psgi_header(%args); + my ($status_code, $headers_aref) = $cgi->psgi_header(%args); Works like CGI.pm's L, but the return format is modified. It returns an array with the status code and arrayref of header pairs that PSGI @@ -289,6 +309,12 @@ If your application doesn't use C<< $cgi->redirect >>, you can ignore this method and generate the status code and headers arrayref another way. +=head1 LIMITATIONS + +Do not use L or something similar in your controller. The +module messes up L's DIY autoloader and breaks CGI::PSGI (and +potentially other) inheritance. + =head1 AUTHOR Tatsuhiko Miyagawa Emiyagawa@bulknews.netE diff -Nru libcgi-psgi-perl-0.13/MANIFEST libcgi-psgi-perl-0.15/MANIFEST --- libcgi-psgi-perl-0.13/MANIFEST 2010-03-31 08:16:18.000000000 +0000 +++ libcgi-psgi-perl-0.15/MANIFEST 2011-05-17 20:59:52.000000000 +0000 @@ -19,8 +19,10 @@ t/cookie.t t/http.t t/psgi.t +t/psgi_headers.t t/redirect.t t/upload.t +tools/extract-methods xt/perlcritic.t xt/pod.t xt/podspell.t diff -Nru libcgi-psgi-perl-0.13/META.yml libcgi-psgi-perl-0.15/META.yml --- libcgi-psgi-perl-0.13/META.yml 2010-10-31 06:09:27.000000000 +0000 +++ libcgi-psgi-perl-0.15/META.yml 2011-05-17 21:00:07.000000000 +0000 @@ -8,7 +8,7 @@ configure_requires: ExtUtils::MakeMaker: 6.42 distribution_type: module -generated_by: 'Module::Install version 1.00' +generated_by: 'Module::Install version 1.01' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -25,4 +25,4 @@ resources: license: http://dev.perl.org/licenses/ repository: git://github.com/miyagawa/CGI-PSGI.git -version: 0.13 +version: 0.15 diff -Nru libcgi-psgi-perl-0.13/README libcgi-psgi-perl-0.15/README --- libcgi-psgi-perl-0.13/README 2009-09-28 21:05:41.000000000 +0000 +++ libcgi-psgi-perl-0.15/README 2010-11-11 00:29:15.000000000 +0000 @@ -1,27 +1,88 @@ -This is Perl module CGI::PSGI. +NAME + CGI::PSGI - Adapt CGI.pm to the PSGI protocol -INSTALLATION +SYNOPSIS + use CGI::PSGI; -CGI::PSGI installation is straightforward. If your CPAN shell is set up, -you should just be able to do + my $app = sub { + my $env = shift; + my $q = CGI::PSGI->new($env); + return [ $q->psgi_header, [ $body ] ]; + }; - % cpan CGI::PSGI +DESCRIPTION + This module is for web application framework developers who currently + uses CGI to handle query parameters, and would like for the frameworks + to comply with the PSGI protocol. -Download it, unpack it, then build it as per the usual: + Only slight modifications should be required if the framework is already + collecting the body content to print to STDOUT at one place (rather + using the print-as-you-go approach). - % perl Makefile.PL - % make && make test + On the other hand, if you are an "end user" of CGI.pm and have a CGI + script that you want to run under PSGI web servers, this module might + not be what you want. Take a look at CGI::Emulate::PSGI instead. -Then install it: + Your application, typically the web application framework adapter should + update the code to do "CGI::PSGI->new($env)" instead of "CGI->new" to + create a new CGI object. (This is similar to how CGI::Fast object is + initialized in a FastCGI environment.) - % make install +INTERFACES SUPPORTED + Only the object-oriented interface of CGI.pm is supported through + CGI::PSGI. This means you should always create an object with + "CGI::PSGI->new($env)" and should call methods on the object. -DOCUMENTATION + The function-based interface like "use CGI ':standard'" does not work + with this module. -CGI::PSGI documentation is available as in POD. So you can do: +METHODS + CGI::PSGI adds the following extra methods to CGI.pm: - % perldoc CGI::PSGI + env + $env = $cgi->env; -to read the documentation online with your favorite pager. + Returns the PSGI environment in a hash reference. This allows + CGI.pm-based application frameworks such as CGI::Application to access + PSGI extensions, typically set by Plack Middleware components. + + So if you enable Plack::Middleware::Session, your application and plugin + developers can access the session via: + + $cgi->env->{'plack.session'}->get("foo"); + + Of course this should be coded carefully by checking the existence of + "env" method as well as the hash key "plack.session". + + psgi_header + my ($status_code, $headers_aref) = $cgi->psgi_header(%args); + + Works like CGI.pm's header(), but the return format is modified. It + returns an array with the status code and arrayref of header pairs that + PSGI requires. + + If your application doesn't use "$cgi->header", you can ignore this + method and generate the status code and headers arrayref another way. + + psgi_redirect + my ($status_code, $headers_aref) = $cgi->psgi_redirect(%args); + + Works like CGI.pm's redirect(), but the return format is modified. It + returns an array with the status code and arrayref of header pairs that + PSGI requires. + + If your application doesn't use "$cgi->redirect", you can ignore this + method and generate the status code and headers arrayref another way. + +AUTHOR + Tatsuhiko Miyagawa + + Mark Stosberg + +LICENSE + This library is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + +SEE ALSO + CGI, CGI::Emulate::PSGI -Tatsuhiko Miyagawa diff -Nru libcgi-psgi-perl-0.13/t/psgi_headers.t libcgi-psgi-perl-0.15/t/psgi_headers.t --- libcgi-psgi-perl-0.13/t/psgi_headers.t 1970-01-01 00:00:00.000000000 +0000 +++ libcgi-psgi-perl-0.15/t/psgi_headers.t 2010-12-25 19:35:41.000000000 +0000 @@ -0,0 +1,55 @@ + +# 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; +use CGI::PSGI; + +# Set up a CGI environment +my $env; +$env->{REQUEST_METHOD} = 'GET'; +$env->{QUERY_STRING} = 'game=chess&game=checkers&weather=dull'; +$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} = 'the.good.ship.lollypop.com'; +$env->{REQUEST_URI} = "$env->{SCRIPT_NAME}$env->{PATH_INFO}?$env->{QUERY_STRING}"; +$env->{HTTP_LOVE} = 'true'; + +my $cgi = CGI::PSGI->new($env); + +my ($status, $headers) = $cgi->psgi_header( -type => "text/html" ); +is_deeply $headers, [ 'Content-Type' => 'text/html; charset=ISO-8859-1' ], + 'known header, basic case: type => "text/html"'; + +eval { $cgi->psgi_header( -type => "text/html".$CGI::CRLF."evil: stuff" ) }; +like($@,qr/contains a newline/,'invalid header blows up'); + +($status, $headers) = $cgi->psgi_header( -type => "text/html".$CGI::CRLF." evil: stuff " ); +like $headers->[1], + qr#text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line'; + +eval { $cgi->psgi_header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) }; +like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up'); + +eval { $cgi->psgi_header( -foobar => "\nContent-type: evil/header" ) }; +like($@,qr/contains a newline/,'header with leading newline blows up'); + +eval { $cgi->psgi_redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ), }; +like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up'); + +eval { $cgi->psgi_redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) }; +like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up'); + +eval { $cgi->psgi_redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html") }; +like($@,qr/contains a newline/,'redirect with leading newlines blows up'); + diff -Nru libcgi-psgi-perl-0.13/tools/extract-methods libcgi-psgi-perl-0.15/tools/extract-methods --- libcgi-psgi-perl-0.13/tools/extract-methods 1970-01-01 00:00:00.000000000 +0000 +++ libcgi-psgi-perl-0.15/tools/extract-methods 2011-05-17 19:49:14.000000000 +0000 @@ -0,0 +1,14 @@ +#!perl +chomp(my $file = `perldoc -l CGI`); +open my $io, "<", $file or die $!; + +my $sub; +while (<$io>) { + chomp; + /^sub (\w+)/ and $sub = $1; + /^}\s*$/ and do { + print "$sub\n" if $code{$sub} =~ /([\%\$]ENV|http\()/; undef $sub + }; + $code{$sub} .= "$_\n" if $sub; + /^\s*package [^C]/ and exit; +}