1

いくつかの理由で、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
'
4

1 に答える 1

3

これは予想されることです。POST リクエストは次のようになります

POST / HTTP/1.1
Header: Value

Data=Value

ヘッダーの終了後に処理を終了しますが、データは本体にあります!

本当に独自の HTTP サーバーを作成したい場合は、ヘッダーから HTTP メソッドを抽出する必要があります。である場合はPOST、ヘッダーから値を見て、そのContent-lengthバイト数を読み取ることができます。

read $client, my $post_data, $content_length;

更新された質問を WRT します。

実動 HTTP サーバーを構築したい場合は、苦労することになります。この内容は難しいです。perlipcTCP サーバーのトピックをカバーするものを読んでください。次に、これの上に 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;
于 2013-08-06T14:49:41.793 に答える