CODEWITHSUNDEEP
perlhttphttp-headerscpancontent-length
oalders
oalders

Reputation: 5279

How can I send an incorrect Content-Length header for an HTTP request using Perl?

I'm trying to debug a weird warning that is showing up in server logs when a Plack::Request is being parsed. In some cases, a broken UserAgent will send a Content-Length header that looks something like "6375, 6375", which is obviously wrong.

To fix this properly, I need to be able to reproduce the warning. I'd like to include this in a unit test so that I can ensure there are no regressions after the warning is silenced. However, I'm having trouble doing this with Perl. I know this can be done using netcat and socat, but I don't want the unit test to have to rely on other binaries to be installed.

Here is what I've tried:

#!/usr/bin/env perl

use strict;
use warnings;

use JSON::XS qw( encode_json );
use WWW::Mechanize;

my $mech = WWW::Mechanize->new;

$mech->add_handler(
    request_prepare => sub {
        my ( $req, $ua, $h ) = @_;
        $req->headers->header( 'Content-Length' => 9999 );
        return;
    }
);

my $json = encode_json( { foo => 'bar' } );

$mech->post(
    'http://example.com'/url,
    'Content-Length' => 999,
    Content          => $json
);

Output is:

Content-Length header value was wrong, fixed at /opt/perl5.16.3/lib/site_perl/5.16.3/LWP/Protocol/http.pm line 260.
200

That's entirely too helpful for me. :)

If I use HTTP::Request and LWP::UserAgent, it's the same end result.

So, I tried HTTP::Tiny.

#!/usr/bin/env perl

use strict;
use warnings;

use DDP;
use HTTP::Tiny;
use JSON::XS qw( encode_json );

my $http = HTTP::Tiny->new;

my $json = encode_json( { foo => 'bar' } );
my $response = $http->request(
    'POST',
    'http://example.com'/url',
    {   headers => { 'Content-Length' => 999, },
        content => $json,
    }
);

p $response;

The output is:

{   content => "Content-Length missmatch (got: 13 expected: 999)
",
    headers => {
        content
            -length => 49,
        content-type => "text/plain",
    },
    reason  => "Internal Exception",
    status  => 599,
    success => "",
    url     => "http://example.com'/url",
}

Again, too helpful. At this point, I could use a few suggestions.

Upvotes: 4

Views: 3015

Answers (1)

harvey
harvey

Reputation: 2953

Seems like the higher level API's are fixing your error; Here's an example using raw sockets that overcomes this;

#!/usr/bin/env perl
use strict 'vars';
use warnings;
use Socket;

# initialize host and port
my $host = 'www.example.com';
my $port =  80;

# contact the server
open_tcp(F, $host, $port) 
  or die 'Could not connect to server';

# Send request data
while ( my $request = <DATA> ) {
  print F $request;
}

# Get Response
while ( my $response = <F> ) {
  print "Response:> $response";
}

close(F);

# TCP Helper
sub open_tcp
{
  # get parameters
  my ($FS, $dest, $port) = @_;

  my $proto = getprotobyname('tcp');
  socket($FS, PF_INET, SOCK_STREAM, $proto);
  my $sin = sockaddr_in($port,inet_aton($dest));
  connect($FS,$sin);

  my $old_fh = select($FS); 
  $| = 1; # don't buffer output
  select($old_fh);
}

__DATA__
GET / HTTP/1.1
Host: example.com
Content-Length: 999


-END-

Upvotes: 2

Related Questions