X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=0cfcbae1c3cc583723dea6507ce508e25760a246;hp=f5232b91ed3fcc60f3dba0a3705082c14504821d;hb=566678d0245e49d7f2f1abce553b5bdb87879086;hpb=0810283f5e3c710d09ab56ceb8fb0b6bfbe3bbe9

diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm
index f5232b9..0cfcbae 100644
--- a/lib/Catalyst/Request.pm
+++ b/lib/Catalyst/Request.pm
@@ -10,7 +10,8 @@ use HTTP::Headers;
 use Stream::Buffered;
 use Hash::MultiValue;
 use Scalar::Util;
-
+use HTTP::Body;
+use Catalyst::Exception;
 use Moose;
 
 use namespace::clean -except => 'meta';
@@ -118,7 +119,11 @@ has body_data => (
 
 sub _build_body_data {
     my ($self) = @_;
-    my $content_type = $self->content_type;
+
+    # Not sure if these returns should not be exceptions...
+    my $content_type = $self->content_type || return;
+    return unless ($self->method eq 'POST' || $self->method eq 'PUT');
+
     my ($match) = grep { $content_type =~/$_/i }
       keys(%{$self->data_handlers});
 
@@ -127,7 +132,7 @@ sub _build_body_data {
       local $_ = $fh;
       return $self->data_handlers->{$match}->($fh, $self);
     } else { 
-      return undef;
+      Catalyst::Exception->throw("$content_type is does not have an available data handler");
     }
 }
 
@@ -312,7 +317,7 @@ sub prepare_body_chunk {
 }
 
 sub prepare_body_parameters {
-    my ( $self ) = @_;
+    my ( $self, $c ) = @_;
 
     $self->prepare_body if ! $self->_has_body;
 
@@ -320,9 +325,29 @@ sub prepare_body_parameters {
       return $self->_use_hash_multivalue ? Hash::MultiValue->new : {};
     }
 
+    my $params = $self->_body->param;
+
+    # If we have an encoding configured (like UTF-8) in general we expect a client
+    # to POST with the encoding we fufilled the request in. Otherwise don't do any
+    # encoding (good change wide chars could be in HTML entity style llike the old
+    # days -JNAP
+
+    # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure
+    # and do any needed decoding.
+
+    # This only does something if the encoding is set via the encoding param.  Remember
+    # this is assuming the client is not bad and responds with what you provided.  In
+    # general you can just use utf8 and get away with it.
+    #
+    # I need to see if $c is here since this also doubles as a builder for the object :(
+
+    if($c and $c->encoding) {
+        $params = $c->_handle_unicode_decoding($params);
+    }
+
     return $self->_use_hash_multivalue ?
-        Hash::MultiValue->from_mixed($self->_body->param) :
-        $self->_body->param;
+        Hash::MultiValue->from_mixed($params) :
+        $params;
 }
 
 sub prepare_connection {
@@ -502,6 +527,13 @@ data of the type 'application/json' and return access to that data via this
 method.  You may define addition data_handlers via a global configuration
 setting.  See L<Catalyst\DATA HANDLERS> for more information.
 
+If the POST is malformed in some way (such as undefined or not content that
+matches the content-type) we raise a L<Catalyst::Exception> with the error
+text as the message.
+
+If the POSTed content type does not match an available data handler, this
+will also raise an exception.
+
 =head2 $req->body_parameters
 
 Returns a reference to a hash containing body (POST) parameters. Values can
@@ -636,16 +668,22 @@ If multiple C<baz> parameters are provided this code might corrupt data or
 cause a hash initialization error. For a more straightforward interface see
 C<< $c->req->parameters >>.
 
-B<NOTE> A recently discovered exploit in L<CGI> style param methods does exist
-in L<Catalyst>.  Here's the whitepaper of the exploit:
+B<NOTE> Interfaces like this, which are based on L<CGI> and the C<param> method
+are known to cause demonstrated exploits. It is highly recommended that you
+avoid using this method, and migrate existing code away from it.  Here's a
+whitepaper of the exploit:
 
 L<http://blog.gerv.net/2014/10/new-class-of-vulnerability-in-perl-web-applications/>
 
+B<NOTE> Further discussion on IRC indicate that the L<Catalyst> core team from 'back then'
+were well aware of this hack and this is the main reason we added the new approach to
+getting parameters in the first place.
+
 Basically this is an exploit that takes advantage of how L<\param> will do one thing
 in scalar context and another thing in list context.  This is combined with how Perl
 chooses to deal with duplicate keys in a hash definition by overwriting the value of
 existing keys with a new value if the same key shows up again.  Generally you will be
-vulnerale to this exploit if you are using this method in a direct assignment in a
+vulnerable to this exploit if you are using this method in a direct assignment in a
 hash, such as with a L<DBIx::Class> create statement.  For example, if you have
 parameters like:
 
@@ -681,6 +719,9 @@ keyword:
       foo => scalar($c->req->param('foo')),
     });
 
+Upcoming versions of L<Catalyst> will disable this interface by default and require
+you to positively enable it should you require it for backwards compatibility reasons.
+
 =cut
 
 sub param {
@@ -922,7 +963,7 @@ sub mangle_params {
         next unless defined $value;
         for ( ref $value eq 'ARRAY' ? @$value : $value ) {
             $_ = "$_";
-            utf8::encode( $_ ) if utf8::is_utf8($_);
+            #      utf8::encode($_);
         }
     };