Question

我在这个标题为Perl HTTP server的SO Q＆amp; A上找到了以下Perl代码。具体来说是this answer。这是我修改过的代码：

httpserver.pl

#!/usr/bin/perl

use strict;
use warnings;

use CGI qw/ :standard /;
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Response;
use HTTP::Status;
use POSIX qw/ WNOHANG /;

use constant HOSTNAME => qx{hostname};

my %O = (
    'listen-host' => '127.0.0.1',
    'listen-port' => 8080,
    'listen-clients' => 30,
    'listen-max-req-per-child' => 100,
);

my $d = HTTP::Daemon->new(
    LocalAddr => $O{'listen-host'},
    LocalPort => $O{'listen-port'},
    Reuse => 1,
) or die "Can't start http listener at $O{'listen-host'}:$O{'listen-port'}";

print "Started HTTP listener at " . $d->url . "\n";

my %chld;

if ($O{'listen-clients'}) {
    $SIG{CHLD} = sub {
        # checkout finished children
        while ((my $kid = waitpid(-1, WNOHANG)) > 0) {
            delete $chld{$kid};
        }
    };
}

while (1) {
    if ($O{'listen-clients'}) {
        # prefork all at once
        for (scalar(keys %chld) .. $O{'listen-clients'} - 1 ) {
            my $pid = fork;

            if (!defined $pid) { # error
                die "Can't fork for http child $_: $!";
            }
            if ($pid) { # parent
                $chld{$pid} = 1;
            }
            else { # child
                $_ = 'DEFAULT' for @SIG{qw/ INT TERM CHLD /};
                http_child($d);
                exit;
            }
        }

        sleep 1;
    }
    else {
        http_child($d);
    }

}

sub http_child {
    my $d = shift;

    my $i;
    my $css = <<CSS;
        form { display: inline; }
CSS

    while (++$i < $O{'listen-max-req-per-child'}) {
        my $c = $d->accept or last;
        my $r = $c->get_request(1) or last;
        $c->autoflush(1);

        print sprintf("[%s] %s %s\n", $c->peerhost, $r->method, $r->uri->as_string);

        my %FORM = $r->uri->query_form();

        if ($r->uri->path eq '/') {
            _http_response($c, { content_type => 'text/html' },
                start_html(
                    -title => HOSTNAME,
                    -encoding => 'utf-8',
                    -style => { -code => $css },
                ),
                p('Here are all input parameters:'),
                pre(Data::Dumper->Dump([\%FORM],['FORM'])),
                (map { p(a({ href => $_->[0] }, $_->[1])) }
                    ['/', 'Home'],
                    ['/ping', 'Ping the simple text/plain content'],
                    ['/error', 'Sample error page'],
                    ['/other', 'Sample not found page'],
                ),
                end_html(),
            )
        }
        elsif ($r->uri->path eq '/ping') {
            _http_response($c, { content_type => 'text/plain' }, 1);
        }
        elsif ($r->uri->path eq '/error') {a
            my $error = 'AAAAAAAAA! My server error!';
            _http_error($c, RC_INTERNAL_SERVER_ERROR, $error);
            die $error;
        }
        elsif ($r->method eq 'POST' and $r->uri->path eq '/formdata') {
                        #_http_response($c, { content_type => 'text/plain' }, 1);
                        print "--> begin form data <--\n";
                        _http_response($c, { content_type => 'text/html' },
                            start_html(
                                -title => HOSTNAME,
                                -encoding => 'utf-8',
                                -style => { -code => $css },
                            ),
                            p('Here are all the input parameters:'),
                            pre(Data::Dumper->Dump([\%FORM],['FORM'])),
                            end_html(),
                        );
                        print Data::Dumper->Dump([$r], [qw(r)]);
                        print "--> end form data <--\n";
        }
        else {
            _http_error($c, RC_NOT_FOUND);
        }

        $c->close();
        undef $c;
    }
}

sub _http_error {
    my ($c, $code, $msg) = @_;

    $c->send_error($code, $msg);
}

sub _http_response {
    my $c = shift;
    my $options = shift;

    $c->send_response(
        HTTP::Response->new(
            RC_OK,
            undef,
            [
                'Content-Type' => $options->{content_type},
                'Cache-Control' => 'no-store, no-cache, must-revalidate, post-check=0, pre-check=0',
                'Pragma' => 'no-cache',
                'Expires' => 'Thu, 01 Dec 1994 16:00:00 GMT',
            ],
            join("\n", @_),
        )
    );
}

curl命令

我正在使用此curl命令连接到服务器。

$ curl -X POST -H "Content-Type: multipart/form-data;  \
    boundary=----------------------------4ebf00fbcf09" \
    --data-binary @test.txt                            \
    http://localhost:8080/formdata?arg1=blah1\&arg2=blah2

test.txt数据文件

与此测试文件一起使用。

$ cat test.txt 
This is some test text in a file.

运行时返回以下内容：

<!DOCTYPE html
    PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>greeneggs.bubba.net
</title>
<style type="text/css">
<!--/* <![CDATA[ */
        form { display: inline; }


/* ]]> */-->
</style>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
</head>
<body>

<p>Here are all the input parameters:</p>
<pre>$FORM = {
          'arg2' => 'blah2',
          'arg1' => 'blah1'
        };
</pre>

</body>
</html>

我的问题

如何处理服务器端多数据表单中的数据？我认为可以通过请求（$r）访问数据，但是当我使用Data :: Dumper进行分析时，我看不到任何类似于数据的内容。

通过curl命令连接到http服务器后输出：

[127.0.0.1] POST /formdata?arg1=blah1&arg2=blah2
--> begin form data <--
$r = bless( {
              '_protocol' => 'HTTP/1.1',
              '_content' => '',
              '_uri' => bless( do{\(my $o = '/formdata?arg1=blah1&arg2=blah2')}, 'URI::http' ),
              '_headers' => bless( {
                                     'user-agent' => 'curl/7.29.0',
                                     'content-type' => 'multipart/form-data; boundary=----------------------------4ebf00fbcf09',
                                     'accept' => '*/*',
                                     'content-length' => '34',
                                     'host' => 'localhost:8080'
                                   }, 'HTTP::Headers' ),
              '_method' => 'POST'
            }, 'HTTP::Request' );
--> end form data <--

我错过了什么？

Answer 1

$ c-＆gt; get_request（$ headers_only）

get_request（）方法通常不会返回，直到从客户端收到整个请求。如果请求是上传大文件，那么这可能不是您想要的（并且使用分块传输编码HTTP甚至可以支持无限请求消息 - 例如上传实时音频）。如果您传递一个TRUE值作为$ headers_only参数，那么get_request（）将在解析请求标头后立即返回，并且您负责读取其余的请求内容。如果你打算在同一个连接上再次调用$ c-＆gt; get_request，你最好读取正确的字节数。

尝试更改（上面的httpsserver.pl内），

my $r = $c->get_request(1) or last;

到

my $r = $c->get_request() or last;

如何访问在multipart / form-data POST中上传的内容数据？

httpserver.pl

curl命令

test.txt数据文件

我的问题

1 个答案: