Небольшая проблема с IO::Socket server и данными POST

Question

По некоторым причинам я могу использовать только IO::Socket для сборки своего маленького http-сервера (но не для других выделенных модулей).

EDIT1: я отредактировал свой вопрос, я хочу знать, что я могу поставить вместо закомментированной строки "#last ..."

Вот мой сценарий:

use strict;
use IO::Socket;

my $server = IO::Socket::INET->new(LocalPort => 6800,
    Type => SOCK_STREAM,
    Reuse => 1,
    Listen => 10) or die "$@\n";
my $client ;

while ( $client = $server->accept()) {

    my $client_info;
    while(<$client>) {
        #last if /^\r\n$/;
        print "received: '" . $_ . "'\n";
        $client_info .= $_;
    }

    print $client "HTTP/1.0 200 OK\r\n";
    print $client "Content-type: text/html\r\n\r\n";

    print $client '<H1>Hello World(!), from a perl web server</H1>';
    print $client '<br><br>you sent:<br><pre>' . $client_info . '</pre>';

    close($client);
}

Теперь, когда я отправляю запрос POST, он (скрипт) не учитывает последнюю строку (данные POST):

wget -qO- --post-data='hello=ok' http://127.0.0.1:6800
<H1>Hello World(!), from a perl web server</H1><br><br>you sent:<br><pre>POST / HTTP/1.1
User-Agent: Wget/1.14 (linux-gnu)
Accept: */*
Host: 127.0.0.1:6800
Connection: Keep-Alive
Content-Type: application/x-www-form-urlencoded
Content-Length: 8
</pre>

Выходные данные скрипта:

perl server.pl 
received: 'POST / HTTP/1.1
'
received: 'User-Agent: Wget/1.14 (linux-gnu)
'
received: 'Accept: */*
'
received: 'Host: 127.0.0.1:6800
'
received: 'Connection: Keep-Alive
'
received: 'Content-Type: application/x-www-form-urlencoded
'
received: 'Content-Length: 8
'

Answer 1

Этого следовало ожидать. POST-запрос выглядит так

POST / HTTP/1.1
Header: Value

Data=Value

Вы заканчиваете обработку после окончания заголовка, но данные находятся в теле!

Если вы действительно хотите написать свой собственный HTTP-сервер, вы должны извлечь HTTP-метод из заголовка. Если это POST, вы можете посмотреть на значение из Content-length заголовок и прочитайте это количество байтов:

read $client, my $post_data, $content_length;

---

WRT обновленный вопрос:

Если вы хотите создать производственный HTTP-сервер, у вас будут плохие времена. Это сложно. Пожалуйста, прочитайте perlipc который охватывает тему серверов TCP. Затем вы можете реализовать подмножество HTTP поверх этого.

Также прочитайте модули на CPAN, которые реализуют серверы. Даже если вы не можете скомпилировать модули в своей системе, вы можете использовать модули с чистым Perl или найти части кода, которые вы можете использовать повторно. Большие части CPAN могут использоваться по лицензии GPL.

Если вы хотите сделать это, сделайте это правильно. Напишите себе подпрограмму, которая анализирует HTTP-запрос. Вот эскиз, который не обрабатывает закодированные поля и т.д.:

use strict; use warnings; use autodie;

BEGIN { die "Untested code" }

package Local::HTTP::Request {
  sub new {
    my ($class, $method, $path, $version, $header_fields, $content) = @_;
    ...;
  }
  ...; # accessors
  sub new_from_fh {
    my ($class, $fh) = @_;
    local $/ = "\015\102"; # CRLF line endings
    chomp(my $first_line = <$fh>);
    my ($method, $path, $version) = ...; # parse the $first_line

    # this cute little sub parses a single field incl. continuation
    # and returns the next line as well.
    my $parse_a_field = sub {
      chomp(my $line = shift);
      my ($name, $value) = split /:\s+/, $line, 2;
      while(defined(my $nextline = <$fh>)) {
        # handle line continuation
        if ($nextline =~ s/^[ \t]//) {
          chomp $nextline;
          $value .= $nextline;
        } else {
          return $name, $value, $nextline;
        }
      }
    };

    my %fields;
    my $line = <$fh>;
    until ($line eq $/) {
      (my $name, my $value, $line) = $parse_a_field->($line);
      $fields{lc $name} = $value;
    }

    read $fh, my $content, $fields{"content-length"} // 0;

    return $class->new( ... );
  }
}

Тогда в вашем accept цикл:

 my $request = Local::HTTP::Request->new_from_fh($client);

 print $client "HTTP/1.0 200 OK", "\015\012";
 print $client "Content-type: text/plain", "\015\012";
 print $client "\015\012";
 print $client "Request body:\n";
 print $client $request->content;