Question

我正在尝试调试在解析Plack::Request时出现在服务器日志中的奇怪警告。在某些情况下，一个损坏的UserAgent将发送一个看起来像“6375,6375”的Content-Length标题，这显然是错误的。

要正确解决这个问题，我需要能够重现警告。我想将其包含在单元测试中，这样我就可以确保在警告静音后没有回归。但是，我在使用Perl时遇到了麻烦。我知道这可以使用netcat和socat完成，但我不希望单元测试必须依赖其他二进制文件进行安装。

这是我尝试过的：

#!/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
);

输出是：

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

这对我来说太有帮助了。：）

如果我使用HTTP::Request和LWP::UserAgent，则结果相同。

所以，我尝试了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;

输出结果为：

{   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",
}

再次，太有帮助了。在这一点上，我可以使用一些建议。

Answer 1

似乎更高级别的API正在修复您的错误;这是一个使用原始套接字的例子，可以克服这个问题;

#!/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-

如何使用Perl为HTTP请求发送不正确的Content-Length标头？

1 个答案: