Connection resets with simple Perl script

问题

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>

回答1:

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.

回答2:

Does HTTP::Daemon help? It is included in the core.

Results of searching Google for windows xp sp3 tcp connection limit might also be relevant.

回答3:

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.

来源：https://stackoverflow.com/questions/1533862/connection-resets-with-simple-perl-script

标签

perl

tcp

reset