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

发布于 2024-08-07 22:19:40 字数 1399 浏览 7 评论 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>

原文

Below is a Perl script whose sole purpose is to receive an HTTP request, and spit out "503 Service Unavailable" and a short message. It works fine, except in many cases, the connection resets, which causes the browser to show an error message. This is on Win32. I have no idea what's wrong with it.

#!/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>

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

阳光①夏 2024-08-14 22:19:40

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

实际上，由于您的子进程正在执行与父进程完全不同的操作，因此您最好使用线程。

在回答评论中的问题时，只需考虑将所有分叉逻辑 (!!) 替换为

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

( 请参阅

Isn't fork on Win32 known as broken?

Really since your child process is doing something totally different from your parent section, you might be better off with threads.

In answer to your question in the comments, just think about replacing all your forking logic (!!) with

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

( See this for example. )
And don't worry about closing connection anywhere else but the server thread.

回复收藏 0 原文

黑色毁心梦 2024-08-14 22:19:40

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

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

回复收藏 0 原文

背叛残局 2024-08-14 22:19:40

我的模块 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>

还有一个关于 re perl fork on windows 已知被破坏的评论的快速注释，它基本上只是使用 perl 线程来模仿 fork() 调用。它不是无缝的，但对于简单的情况，这是使用线程的简单方法。

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

My module HTTP::Server::Brick works on Windows, but the tests hang on Strawberry perl unfortunately (it's on the todo list) so you would either need to do a manual install, or just copy in the single perl Module and use cpan to install the dependencies. It does however build/test fine under cygwin on Windows and of course on unix.

Here's how I'd implement your requirement using HTTP::Server::Brick, noting that it is fairly naive and suffers from the same problem as yours in that there is no upper limit on the number of threads/processes.

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>

Also a quick note about the comment re perl fork on windows known to be broken, it basically just uses perl threads to mimic the fork() call. It's not seamless, but for simple situations it's an easy way of using threads.

One final note - maybe you're just better off installing cygwin plus the apache or lighthttpd package? Sending a 503 for all urls is a pretty short apache config file.

回复收藏 0 原文

~没有更多了~