0

下面是一个 Perl 脚本，其唯一目的是接收 HTTP 请求，并输出“503 Service Unavailable”和一条短消息。它工作正常，但在许多情况下，连接会重置，这会导致浏览器显示错误消息。这是在 Win32 上。我不知道它有什么问题。

#!/usr/local/bin/perl

use strict;
use IO::Socket::INET;
my $f = join('', <DATA>);

$SIG{CHLD} = 'IGNORE';
my $sock = IO::Socket::INET->new(ReuseAddr => 1, Listen => 512, LocalPort => 80, LocalHost => '0.0.0.0', Proto => 'tcp');
die "Cant't create a listening socket: $@" unless $sock;

while (my $connection = $sock->accept) {
    my $child;
    die "Can't fork: $!" unless defined ($child = fork());
    if ($child == 0) {
        #print "Child $$ running. ";
        $sock->close;
        do_it($connection);
        #print "Child $$ exiting.\n";
        exit 0;
    } else {
        print "Connection from ".$connection->peerhost."\n";
        $connection->close();
    }
}

sub do_it {
    my $socket = shift;
    my $pr = print $socket $f;
    if (!$pr) {
        $socket->close();
        exit(0);
    }
}

__DATA__
HTTP/1.1 503 Service Unavailable
Date: Mon, 12 Mar 2009 19:12:16 GMT
Server: Down
Connection: close
Content-Type: text/html


<html>
<head><title>Down for Maintenance</title></head>
<body>
<h2>Down for Maintenance</h2>
<p>The site is down for maintenance. It will be online again shortly.</p>
</body>
</html>
4

3 回答 3

1

在Win32上不是fork被称为损坏吗？

确实，由于您的子进程正在做与父部分完全不同的事情，因此使用线程可能会更好。

在评论中回答您的问题时，只需考虑将所有分叉逻辑（！！）替换为

$peer_name = $connection->peerhost();
threads->create( \&do_it, $connection );
say "Got connection from $peer_name";

（例如，请参阅this。）并且不要担心在服务器线程之外的任何其他地方关闭连接。

于 2009-10-07T20:22:42.123 回答
0

HTTP::Daemon有帮助吗？它包含在核心中。

在 Google 上搜索windows xp sp3 tcp 连接限制的结果也可能是相关的。

于 2009-10-07T20:16:01.683 回答
0

我的模块HTTP::Server::Brick在 Windows 上工作，但不幸的是，测试挂在 Strawberry perl 上（它在待办事项列表上）所以你要么需要手动安装，要么只复制单个 perl 模块并使用 cpan安装依赖项。然而，它确实在 Windows 上的 cygwin 下构建/测试良好，当然在 unix 上。

以下是我使用HTTP::Server::Brick实现您的要求的方法，并指出它相当幼稚，并且遇到与您相同的问题，因为线程/进程的数量没有上限。

use strict;
use warnings;

use HTTP::Server::Brick;
use HTTP::Status qw(:constants);

my $server = HTTP::Server::Brick->new( port => 80 );

my $html = join '', <DATA>;

$server->mount( '/' => {
 wildcard => 1,
 handler => sub {
  my ($req, $res) = @_;
  $res->add_content($html);
  return HTTP_SERVICE_UNAVAILABLE;
 },
   });

$server->start;

__DATA__
<html>
<head><title>Down for Maintenance</title></head>
<body>
<h2>Down for Maintenance</h2>
<p>The site is down for maintenance. It will be online again shortly.</p>
</body>
</html>

还有一个关于在已知被破坏的窗口上重新 perl fork 的注释的快速说明，它基本上只是使用 perl 线程来模仿 fork() 调用。它不是无缝的，但对于简单的情况，它是一种使用线程的简单方法。

最后一点 - 也许你最好安装 cygwin 加上 apache 或 lighthttpd 包？为所有 url 发送 503 是一个非常短的 apache 配置文件。

于 2009-10-08T00:54:06.437 回答