Perl을 사용하여 HTTP 요청에 대해 잘못된 Content-Length 헤더를 보내려면 어떻게해야합니까?

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-