Как я могу отправить неверный заголовок Content-Length для HTTP-запроса с помощью Perl?

Я пытаюсь отладить странное предупреждение, которое появляется в журналах сервера, когда разбираетсяPlack::Request . В некоторых случаях сломанный UserAgent отправит заголовок длины содержимого, который выглядит примерно как "6375, 6375", что явно неправильно.

Чтобы исправить это должным образом, я должен быть в состоянии воспроизвести предупреждение. Я хотел бы включить это в модульный тест, чтобы убедиться в отсутствии регрессий после отключения предупреждения. Тем не менее, у меня возникли проблемы с этим с 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",
}

Опять же, слишком полезно. В этот момент, Мне бы не помешало несколько советов.

1 4
http perl http-headers

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-
1