Соединение сбрасывается простым скриптом Perl - PullRequest
Новая
       18

Соединение сбрасывается простым скриптом Perl

0 голосов
/ 08 октября 2009

Ниже приведен сценарий 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 ]

1 голос
/ 08 октября 2009

Разве fork на Win32 не известен как не работает ?

На самом деле, поскольку ваш дочерний процесс делает что-то совершенно отличное от родительского раздела, вам может быть лучше использовать threads .

Отвечая на ваш вопрос в комментариях, просто подумайте о замене всей вашей логики разветвления (!!) на 

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

(см. это , например.) И не беспокойтесь о закрытии соединения где-либо еще, кроме потока сервера.

0 голосов
/ 08 октября 2009

Мой модуль HTTP :: Server :: Brick работает в Windows, но, к сожалению, тесты зависают на Strawberry Perl (он есть в списке задач), поэтому вам нужно либо выполнить установку вручную, либо просто скопируйте в один модуль perl и используйте cpan для установки зависимостей. Тем не менее, он прекрасно собирает / тестирует под Cygwin в Windows и, конечно, в 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? Отправка 503 для всех URL-адресов - довольно короткий файл конфигурации Apache.

0 голосов
/ 08 октября 2009

Помогает ли HTTP :: Daemon ? Включено в ядро.

Результаты поиска в Google по запросу Пределы TCP-соединения для Windows XP SP3 также могут иметь значение.

...