[Catalyst-commits] r6189 - in branches/HTTP-Body: . lib/HTTP t t/data/urlencoded

[andyg at dev.catalyst.perl.org]

Author: andyg
Date: 2007-03-23 20:56:52 +0000 (Fri, 23 Mar 2007)
New Revision: 6189

Added:
   branches/HTTP-Body/t/data/urlencoded/002-content.dat
   branches/HTTP-Body/t/data/urlencoded/002-headers.yml
   branches/HTTP-Body/t/data/urlencoded/002-results.yml
Modified:
   branches/HTTP-Body/Changes
   branches/HTTP-Body/lib/HTTP/Body.pm
   branches/HTTP-Body/t/05urlencoded.t
Log:
HTTP::Body - ignore all data beyond Content-Length.  Fixes MSIE CRLF issue

Modified: branches/HTTP-Body/Changes
===================================================================
--- branches/HTTP-Body/Changes	2007-03-23 17:41:47 UTC (rev 6188)
+++ branches/HTTP-Body/Changes	2007-03-23 20:56:52 UTC (rev 6189)
@@ -1,6 +1,8 @@
 This file documents the revision history for Perl extension HTTP::Body.
 
-0.7   2007-03-23 10:00:00
+0.7
+        - Some browsers such as MSIE send extra data after the body content.  We now
+          properly ignore anything beyond Content-Length.
         - Fixed parsing an empty (zero-length) file using multipart.
           http://rt.cpan.org/NoAuth/Bug.html?id=25392
 

Modified: branches/HTTP-Body/lib/HTTP/Body.pm
===================================================================
--- branches/HTTP-Body/lib/HTTP/Body.pm	2007-03-23 17:41:47 UTC (rev 6188)
+++ branches/HTTP-Body/lib/HTTP/Body.pm	2007-03-23 20:56:52 UTC (rev 6189)
@@ -109,17 +109,26 @@
 
 sub add {
     my $self = shift;
+    
+    my $cl = $self->content_length;
 
     if ( defined $_[0] ) {
+        $self->{length} += length( $_[0] );
+        
+        # Don't allow buffer data to exceed content-length
+        if ( $self->{length} > $cl ) {
+            $_[0] = substr $_[0], 0, $cl - $self->{length};
+            $self->{length} = $cl;
+        }
+        
         $self->{buffer} .= $_[0];
-        $self->{length} += length( $_[0] );
     }
 
     unless ( $self->state eq 'done' ) {
         $self->spin;
     }
 
-    return ( $self->length - $self->content_length );
+    return ( $self->length - $cl );
 }
 
 =item body

Modified: branches/HTTP-Body/t/05urlencoded.t
===================================================================
--- branches/HTTP-Body/t/05urlencoded.t	2007-03-23 17:41:47 UTC (rev 6188)
+++ branches/HTTP-Body/t/05urlencoded.t	2007-03-23 20:56:52 UTC (rev 6189)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 10;
 
 use Cwd;
 use HTTP::Body;
@@ -13,7 +13,7 @@
 
 my $path = catdir( getcwd(), 't', 'data', 'urlencoded' );
 
-for ( my $i = 1; $i <= 1; $i++ ) {
+for ( my $i = 1; $i <= 2; $i++ ) {
 
     my $test    = sprintf( "%.3d", $i );
     my $headers = YAML::LoadFile( catfile( $path, "$test-headers.yml" ) );

Added: branches/HTTP-Body/t/data/urlencoded/002-content.dat
===================================================================
--- branches/HTTP-Body/t/data/urlencoded/002-content.dat	                        (rev 0)
+++ branches/HTTP-Body/t/data/urlencoded/002-content.dat	2007-03-23 20:56:52 UTC (rev 6189)
@@ -0,0 +1 @@
+one=foo&two=bar

Added: branches/HTTP-Body/t/data/urlencoded/002-headers.yml
===================================================================
--- branches/HTTP-Body/t/data/urlencoded/002-headers.yml	                        (rev 0)
+++ branches/HTTP-Body/t/data/urlencoded/002-headers.yml	2007-03-23 20:56:52 UTC (rev 6189)
@@ -0,0 +1,4 @@
+---
+Content-Length: 15
+Content-Type: application/x-www-form-urlencoded
+User-Agent: 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.1.4322)'

Added: branches/HTTP-Body/t/data/urlencoded/002-results.yml
===================================================================
--- branches/HTTP-Body/t/data/urlencoded/002-results.yml	                        (rev 0)
+++ branches/HTTP-Body/t/data/urlencoded/002-results.yml	2007-03-23 20:56:52 UTC (rev 6189)
@@ -0,0 +1,6 @@
+---
+body: ~
+param:
+  one: foo
+  two: bar
+upload: {}