From: Andy Grundman <andy@hybridized.org>
Date: Wed, 14 Sep 2005 18:48:06 +0000 (+0000)
Subject: Released RequireSSL 0.04: bug fixes, full test suite
X-Git-Tag: v0.04^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Plugin-RequireSSL.git;a=commitdiff_plain;h=4585dfb15d7d9d2983f365d04c5b3423334184d7

Released RequireSSL 0.04: bug fixes, full test suite
---

diff --git a/Changes b/Changes
index c850236..2f7cb21 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 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.
diff --git a/MANIFEST b/MANIFEST
index 731a9a7..146acc4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -8,3 +8,8 @@ README
 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
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..2ffcc10
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,25 @@
+# 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\.#
diff --git a/META.yml b/META.yml
index 38dcb58..f54c07b 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 ---
 name: Catalyst-Plugin-RequireSSL
-version: 0.03
+version: 0.04
 author:
   - 'Andy Grundman, <andy@hybridized.org>'
 abstract: Force SSL mode on select pages
@@ -10,5 +10,5 @@ requires:
 provides:
   Catalyst::Plugin::RequireSSL:
     file: lib/Catalyst/Plugin/RequireSSL.pm
-    version: 0.03
+    version: 0.04
 generated_by: Module::Build version 0.2611
diff --git a/lib/Catalyst/Plugin/RequireSSL.pm b/lib/Catalyst/Plugin/RequireSSL.pm
index a03aad5..f5457db 100644
--- a/lib/Catalyst/Plugin/RequireSSL.pm
+++ b/lib/Catalyst/Plugin/RequireSSL.pm
@@ -4,9 +4,9 @@ use strict;
 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;
@@ -19,6 +19,7 @@ sub require_ssl {
             $c->log->warn( "RequireSSL: Would have redirected to $redir" );
         }
         else {
+            $c->_ssl_strip_output(1);
             $c->res->redirect( $redir );
         }
     }
@@ -48,6 +49,11 @@ sub finalize {
         $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(@_);
 }
 
@@ -84,12 +90,20 @@ sub _redirect_uri {
 
     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;
 }
diff --git a/t/04ssl.t b/t/04ssl.t
new file mode 100644
index 0000000..18fc7d1
--- /dev/null
+++ b/t/04ssl.t
@@ -0,0 +1,49 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 15;
+use Catalyst::Test 'TestApp';
+use HTTP::Request::Common;
+
+# 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 redirection params
+ok( $res = request('http://localhost/ssl/secured?a=2&a=1&b=3&c=4'), 'request ok' );
+is( $res->header('location'), 'https://localhost/ssl/secured?a=1&a=2&b=3&c=4', 'redirect with params ok' );
+
+# test that it doesn't redirect on POST
+my $request = POST( 'http://localhost/ssl/secured', 
+    'Content'      => '',
+    'Content-Type' => 'application/x-www-form-urlencoded'
+);
+ok( $res = request($request), 'request ok' );
+is( $res->code, 200, 'POST ok' );
+
+# test that it doesn't redirect if already in SSL mode
+SKIP:
+{
+    skip "These tests require a patch to Catalyst", 7;
+    # patch is to Catalyst::Engine::HTTP::Base in 5.3x
+    #             Catalyst::Engine::Test in 5.5
+    ok( $res = request('https://localhost/ssl/secured'), 'request ok' );
+    is( $res->code, 200, 'SSL request, ok' );
+    
+    # test redirect back to http mode
+    ok( $res = request('https://localhost/ssl/unsecured'), 'request ok' );
+    is( $res->code, 302, 'redirect back to http ok' );
+    is( $res->header('location'), 'http://localhost/ssl/unsecured', 'redirect uri ok' );
+    
+    # test redirection params
+    ok( $res = request('https://localhost/ssl/unsecured?a=2&a=1&b=3&c=4'), 'request ok' );
+    is( $res->header('location'), 'http://localhost/ssl/unsecured?a=1&a=2&b=3&c=4', 'redirect with params ok' );
+}
+
diff --git a/t/05ssl_host.t b/t/05ssl_host.t
new file mode 100644
index 0000000..56235f9
--- /dev/null
+++ b/t/05ssl_host.t
@@ -0,0 +1,32 @@
+#!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' );
+}
+
diff --git a/t/06remain_in_ssl.t b/t/06remain_in_ssl.t
new file mode 100644
index 0000000..956385a
--- /dev/null
+++ b/t/06remain_in_ssl.t
@@ -0,0 +1,31 @@
+#!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' );
+}
+
diff --git a/t/lib/TestApp.pm b/t/lib/TestApp.pm
new file mode 100644
index 0000000..9ef2899
--- /dev/null
+++ b/t/lib/TestApp.pm
@@ -0,0 +1,20 @@
+package TestApp;
+
+use strict;
+use Catalyst;
+use Data::Dumper;
+
+our $VERSION = '0.01';
+
+TestApp->config(
+    name => 'TestApp',
+);
+
+TestApp->setup( qw/RequireSSL/ );
+
+sub default : Private {
+    my ( $self, $c ) = @_;
+    
+}
+
+1;
diff --git a/t/lib/TestApp/C/SSL.pm b/t/lib/TestApp/C/SSL.pm
new file mode 100644
index 0000000..6faeddf
--- /dev/null
+++ b/t/lib/TestApp/C/SSL.pm
@@ -0,0 +1,20 @@
+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;