连接使用简单的Perl脚本重置

时间:2009-10-07 20:03:17

标签: perl tcp reset

下面是一个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>

3 个答案:

答案 0 :(得分:1)

Win32上的fork不是已损坏吗?

实际上,由于您的子进程正在执行与您的父部分完全不同的操作,因此使用threads可能会更好。

在评论中回答你的问题时,只需考虑用

替换所有的分支逻辑(!!)
$peer_name = $connection->peerhost();
threads->create( \&do_it, $connection );
say "Got connection from $peer_name";

(例如,请参阅this。) 除了服务器线程之外,不要担心在其他任何地方关闭连接。

答案 1 :(得分:0)

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

搜索Google windows xp sp3 tcp connection limit的结果可能也很重要。

答案 2 :(得分:0)

我的模块HTTP::Server::Brick适用于Windows,但不幸的是,测试依赖于Strawberry perl(它位于todo列表中),因此您需要手动安装,或者只需复制单个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>

还快速记下关于已知被破坏的窗口上的注释re perl fork,它基本上只使用perl线程来模仿fork()调用。它不是无缝的,但对于简单的情况,它是一种使用线程的简单方法。

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