Revision history for Perl extension Catalyst::Plugin::RequireSSL
+0.04 2005-09-14 13:30:00
+ - Fixed bug in redirect code that ignored duplicate key names.
+ - Strip all output content when doing a redirect from HTTP -> HTTPS
+ to avoid sending secure data over HTTP.
+ - Added test suite.
+
0.03 2005-09-05 22:00:00
- Proper handling for static files in SSL mode when using
Static::Simple.
t/01use.t
t/02pod.t
t/03podcoverage.t
+t/04ssl.t
+t/05ssl_host.t
+t/06remain_in_ssl.t
+t/lib/TestApp.pm
+t/lib/TestApp/C/SSL.pm
--- /dev/null
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
---
name: Catalyst-Plugin-RequireSSL
-version: 0.03
+version: 0.04
author:
- 'Andy Grundman, <andy@hybridized.org>'
abstract: Force SSL mode on select pages
provides:
Catalyst::Plugin::RequireSSL:
file: lib/Catalyst/Plugin/RequireSSL.pm
- version: 0.03
+ version: 0.04
generated_by: Module::Build version 0.2611
use base qw/Class::Accessor::Fast/;
use NEXT;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
-__PACKAGE__->mk_accessors('_require_ssl');
+__PACKAGE__->mk_accessors( qw/_require_ssl _ssl_strip_output/ );
sub require_ssl {
my $c = shift;
$c->log->warn( "RequireSSL: Would have redirected to $redir" );
}
else {
+ $c->_ssl_strip_output(1);
$c->res->redirect( $redir );
}
}
$c->res->redirect( $c->_redirect_uri('http') );
}
+ # do not allow any output to be displayed on the insecure page
+ if ( $c->_ssl_strip_output ) {
+ $c->res->body( undef );
+ }
+
return $c->NEXT::finalize(@_);
}
my $redir
= $type . '://' . $c->config->{require_ssl}->{$type} . $c->req->path;
-
+
if ( scalar $c->req->param ) {
- my @params
- = map { "$_=" . $c->req->params->{$_} } sort $c->req->param;
- $redir .= "?" . join "&", @params;
- }
+ my @params;
+ foreach my $arg ( sort keys %{ $c->req->params } ) {
+ if ( ref $c->req->params->{$arg} ) {
+ my $list = $c->req->params->{$arg};
+ push @params, map { "$arg=" . $_ } sort @{$list};
+ }
+ else {
+ push @params, "$arg=" . $c->req->params->{$arg};
+ }
+ }
+ $redir .= '?' . join( '&', @params );
+ }
return $redir;
}
--- /dev/null
+#!perl\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use FindBin;\r
+use lib "$FindBin::Bin/lib";\r
+\r
+use Test::More tests => 15;\r
+use Catalyst::Test 'TestApp';\r
+use HTTP::Request::Common;\r
+\r
+# test an SSL redirect\r
+ok( my $res = request('http://localhost/ssl/secured'), 'request ok' );\r
+is( $res->code, 302, 'redirect code ok' );\r
+is( $res->header('location'), 'https://localhost/ssl/secured', 'redirect uri ok' );\r
+isnt( $res->content, 'Secured', 'no content displayed on secure page, ok' );\r
+\r
+# test redirection params\r
+ok( $res = request('http://localhost/ssl/secured?a=2&a=1&b=3&c=4'), 'request ok' );\r
+is( $res->header('location'), 'https://localhost/ssl/secured?a=1&a=2&b=3&c=4', 'redirect with params ok' );\r
+\r
+# test that it doesn't redirect on POST\r
+my $request = POST( 'http://localhost/ssl/secured', \r
+ 'Content' => '',\r
+ 'Content-Type' => 'application/x-www-form-urlencoded'\r
+);\r
+ok( $res = request($request), 'request ok' );\r
+is( $res->code, 200, 'POST ok' );\r
+\r
+# test that it doesn't redirect if already in SSL mode\r
+SKIP:\r
+{\r
+ skip "These tests require a patch to Catalyst", 7;\r
+ # patch is to Catalyst::Engine::HTTP::Base in 5.3x\r
+ # Catalyst::Engine::Test in 5.5\r
+ ok( $res = request('https://localhost/ssl/secured'), 'request ok' );\r
+ is( $res->code, 200, 'SSL request, ok' );\r
+ \r
+ # test redirect back to http mode\r
+ ok( $res = request('https://localhost/ssl/unsecured'), 'request ok' );\r
+ is( $res->code, 302, 'redirect back to http ok' );\r
+ is( $res->header('location'), 'http://localhost/ssl/unsecured', 'redirect uri ok' );\r
+ \r
+ # test redirection params\r
+ ok( $res = request('https://localhost/ssl/unsecured?a=2&a=1&b=3&c=4'), 'request ok' );\r
+ is( $res->header('location'), 'http://localhost/ssl/unsecured?a=1&a=2&b=3&c=4', 'redirect with params ok' );\r
+}\r
+\r
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 6;
+use Catalyst::Test 'TestApp';
+
+TestApp->config->{require_ssl} = {
+ https => 'secure.mydomain.com',
+ http => 'www.mydomain.com',
+};
+
+# test an SSL redirect
+ok( my $res = request('http://localhost/ssl/secured'), 'request ok' );
+is( $res->code, 302, 'redirect code ok' );
+is( $res->header('location'), 'https://secure.mydomain.com/ssl/secured', 'other domain redirect uri ok' );
+isnt( $res->content, 'Secured', 'no content displayed on secure page, ok' );
+
+# test redirect back to HTTP
+SKIP:
+{
+ skip "These tests require a patch to Catalyst", 2;
+ # patch is to Catalyst::Engine::HTTP::Base in 5.3x
+ # Catalyst::Engine::Test in 5.5
+ ok( $res = request('https://secure.mydomain.com/ssl/unsecured'), 'request ok' );
+ is( $res->header('location'), 'http://www.mydomain.com/ssl/unsecured', 'other domain redirect uri ok' );
+}
+
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 6;
+use Catalyst::Test 'TestApp';
+
+TestApp->config->{require_ssl} = {
+ remain_in_ssl => 1,
+};
+
+# test an SSL redirect
+ok( my $res = request('http://localhost/ssl/secured'), 'request ok' );
+is( $res->code, 302, 'redirect code ok' );
+is( $res->header('location'), 'https://localhost/ssl/secured', 'redirect uri ok' );
+isnt( $res->content, 'Secured', 'no content displayed on secure page, ok' );
+
+# test redirect back to HTTP, should not redirect
+SKIP:
+{
+ skip "These tests require a patch to Catalyst", 2;
+ # patch is to Catalyst::Engine::HTTP::Base in 5.3x
+ # Catalyst::Engine::Test in 5.5
+ ok( $res = request('https://localhost/ssl/unsecured'), 'request ok' );
+ is( $res->code, 200, 'remain in SSL ok' );
+}
+
--- /dev/null
+package TestApp;\r
+\r
+use strict;\r
+use Catalyst;\r
+use Data::Dumper;\r
+\r
+our $VERSION = '0.01';\r
+\r
+TestApp->config(\r
+ name => 'TestApp',\r
+);\r
+\r
+TestApp->setup( qw/RequireSSL/ );\r
+\r
+sub default : Private {\r
+ my ( $self, $c ) = @_;\r
+ \r
+}\r
+\r
+1;\r
--- /dev/null
+package TestApp::C::SSL;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub secured : Local {
+ my ( $self, $c ) = @_;
+
+ $c->require_ssl;
+
+ $c->res->output( 'Secured' );
+}
+
+sub unsecured : Local {
+ my ( $self, $c ) = @_;
+
+ $c->res->output( 'Unsecured' );
+}
+
+1;
projects / catagits/Catalyst-Plugin-RequireSSL.git / commitdiff