From: John Napiorkowski <jjnapiork@cpan.org>
Date: Thu, 13 Nov 2014 23:26:58 +0000 (-0600)
Subject: make the httpexception filter more choosey
X-Git-Tag: 5.90076~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=9c86666a0171945d0b543cfb81510621fc42d6af

make the httpexception filter more choosey
---

diff --git a/Changes b/Changes
index a1b4d27..2d6fb80 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.90076 - 2014-11-13
+  - If throwing an exception object that does the code method, make sure that
+    method returns an expected HTTP status code before passing it on to the
+    HTTP Exception middleware.
+
 5.90075 - 2014-10-06
   - Documentation patch for $c->req->param to point out the recently discovered
     potential security issues: http://blog.gerv.net/2014/10/new-class-of-vulnerability-in-perl-web-applications/
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index a94388f..8d8000b 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -127,7 +127,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 
 # Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90075';
+our $VERSION = '5.90076';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -1775,7 +1775,15 @@ sub execute {
 
     if ( my $error = $@ ) {
         #rethow if this can be handled by middleware
-        if(blessed $error && ($error->can('as_psgi') || $error->can('code'))) {
+        if(
+          blessed $error && (
+            $error->can('as_psgi') ||
+            (
+              $error->can('code') &&
+              $error->code =~m/^[1-5][0-9][0-9]$/
+            )
+          )
+        ) {
             foreach my $err (@{$c->error}) {
                 $c->log->error($err);
             }
@@ -2101,7 +2109,15 @@ sub handle_request {
         $status = $c->finalize;
     } catch {
         #rethow if this can be handled by middleware
-        if(blessed $_ && ($_->can('as_psgi') || $_->can('code'))) {
+        if(
+          blessed($_) && (
+            $_->can('as_psgi') ||
+            (
+              $_->can('code') &&
+              $_->code =~m/^[1-5][0-9][0-9]$/
+            )
+          )
+        ) {
             $_->can('rethrow') ? $_->rethrow : croak $_;
         }
         chomp(my $error = $_);
diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm
index 0b64e0e..cbf5f7c 100644
--- a/lib/Catalyst/Runtime.pm
+++ b/lib/Catalyst/Runtime.pm
@@ -7,7 +7,7 @@ BEGIN { require 5.008003; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90075';
+our $VERSION = '5.90076';
 
 =head1 NAME
 
diff --git a/t/http_exceptions.t b/t/http_exceptions.t
index 5cb3117..ad6544a 100644
--- a/t/http_exceptions.t
+++ b/t/http_exceptions.t
@@ -12,10 +12,6 @@ use Plack::Test;
 {
   package MyApp::Exception;
 
-  use overload
-    # Use the overloading thet HTTP::Exception uses
-    bool => sub { 1 }, '""' => 'as_string', fallback => 1;
-
   sub new {
     my ($class, $code, $headers, $body) = @_;
     return bless +{res => [$code, $headers, $body]}, $class;
@@ -35,8 +31,14 @@ use Plack::Test;
     };
   }
 
+  package MyApp::AnotherException;
+
+  sub new { bless +{}, shift }
+
+  sub code { 400 }
+
   sub as_string { 'bad stringy bad' }
-  
+
   package MyApp::Controller::Root;
 
   use base 'Catalyst::Controller';
@@ -60,6 +62,11 @@ use Plack::Test;
       403, ['content-type'=>'text/plain'], ['Forbidden']);
   }
 
+  sub from_code_type :Local {
+    my $e = MyApp::AnotherException->new;
+    die $e;
+  }
+
   sub classic_error :Local {
     my ($self, $c) = @_;
     Catalyst::Exception->throw("Ex Parrot");
@@ -107,6 +114,14 @@ test_psgi $psgi, sub {
 
 test_psgi $psgi, sub {
     my $cb = shift;
+    my $res = $cb->(GET "/root/from_code_type");
+    is $res->code, 400;
+    is $res->content, 'bad stringy bad', 'bad stringy bad';
+    unlike $res->content, qr'HTTPExceptions', 'HTTPExceptions';
+};
+
+test_psgi $psgi, sub {
+    my $cb = shift;
     my $res = $cb->(GET "/root/classic_error");
     is $res->code, 500;
     like $res->content, qr'Ex Parrot', 'Ex Parrot';
@@ -127,5 +142,5 @@ test_psgi $psgi, sub {
 # in the callbacks might never get run (thus all ran tests pass but not all
 # required tests run).
 
-done_testing(14);
+done_testing(17);
 
diff --git a/t/utf_incoming.t b/t/utf_incoming.t
new file mode 100644
index 0000000..b0f908f
--- /dev/null
+++ b/t/utf_incoming.t
@@ -0,0 +1,49 @@
+use utf8;
+use warnings;
+use strict;
+
+use Test::More;
+use HTTP::Request::Common;
+use Plack::Test;
+
+# Test cases for incoming utf8 
+
+{
+  package MyApp::Controller::Root;
+  $INC{'MyApp/Controller/Root.pm'} = __FILE__;
+
+  use base 'Catalyst::Controller';
+
+  sub heart :Path('♥') {
+    my ($self, $c) = @_;
+    $c->response->body("This is the body");
+  }
+
+  sub hat :Path('^') {
+    my ($self, $c) = @_;
+    $c->response->body("This is the body");
+  }
+
+  sub base :Chained('/') CaptureArgs(0) { }
+    sub link :Chained('base') PathPart('♥') Args(0) {
+      my ($self, $c) = @_;
+      $c->response->body("This is the body");
+    }
+
+  package MyApp;
+  use Catalyst;
+
+  Test::More::ok(MyApp->setup, 'setup app');
+}
+
+ok my $psgi = MyApp->psgi_app, 'build psgi app';
+
+test_psgi $psgi, sub {
+    my $cb = shift;
+    #my $res = $cb->(GET "/root/test");
+    #is $res->code, 200, 'OK';
+    #is $res->content, 'This is the body', 'correct body';
+    #is $res->content_length, 16, 'correct length';
+};
+
+done_testing;