Почему Perl IO :: Socket в Windows жалуется на «Ресурс недоступен» после 64 подключений? - PullRequest
Новая
       13

Почему Perl IO :: Socket в Windows жалуется на «Ресурс недоступен» после 64 подключений?

2 голосов
/ 18 февраля 2010

Я создал сервер с Perl под Windows (ActivePerl 5.10.1 build 1006), который разветвляется при подключении, принимает некоторые данные JSON и записывает их в базу данных. Я сталкиваюсь с проблемой после подключения 64 клиентов к серверу, сообщение об ошибке «Ресурс недоступен» при попытке форка.

Запустив этот код в Linux, я обнаружил много недееспособных дочерних процессов, которые были решены путем добавления вызова wait() в родительский процесс. Это, однако, не решило проблему. Выполнение кода в Linux работает после 64 вызовов, разрешенных в Windows.

Я также запускал виртуальный сервер Windows на случай, если на сервере были ограничения, но при новой установке Perl было установлено то же ограничение на 64 соединения.

Любые идеи приветствуются. 


use IO::Socket; 
use Net::hostent; 
use JSON;
use DBI;
use Data::Dumper;

my $port=shift || 9000;
my $clients_served = 0;

while(1){
  my $server = IO::Socket::INET->new( Proto => 'tcp', 
    LocalPort => $port, 
    Listen => 1, 
    Reuse => 1); 

  die "can't setup server" unless $server; 
  print "[Server $0 is running]\n"; 

#### 
# wait for a client to connect
# once it has, fork to a seperate thread and
# retrieve the JSON data
#### 
  while (my $client = $server->accept()) { 
    my $pid = fork();

      if ($pid != 0) {
        print ("Serving client " . $clients_served++ . "\n");
      }else{
        $client->autoflush(1); 
        my $JSONObject = JSON->new->ascii->pretty->allow_nonref();
        my $hostinfo = gethostbyaddr($client->peeraddr); 
        my $client_hostname = ($hostinfo->name || $client->peerhost);

        printf "connect from %s\n", $client_hostname;

        print " $client_hostname connected..\n";
        syswrite($client, "Reached Server\n", 2048);
        if (sysread($client, my $buffer, 2048) > 0) {

          foreach my $tasks($JSONObject->decode($buffer)){
            foreach my $task (@$tasks){
              insert_record($client_hostname, $task); #empty method, contents does not affect result
            }
          }
        }

        print " $client_hostname disconnected..\n";
        close $client; 
        exit 0;
      }
  }
  $server->close();
}

exit 0;

Ответы [ 4 ]

2 голосов
/ 18 февраля 2010

Попробуйте пожать процессы зомби из готовых транзакций. Я могу получить ваш пример кода продолжайте бежать, если я добавлю еще пару строк: 

    use POSIX ':sys_wait_h';

    if ($pid != 0) {
        print ("Serving client " . $clients_served++ . "\n");
        1 while waitpid -1, WNOHANG > 0;

Если у вас может быть 64 одновременных соединений, вам, возможно, придется подумать о чем-то другом - нехорошо устанавливать обработчик SIGCHLD в Windows.

1 голос
/ 19 июня 2013

Я потратил много времени на это.

Каждая программа Windows perl имеет ограничение в 64 потока, и POSIX не поддерживается.

После того, как вы разветвляете дочерний элемент, родитель долженвызовите waitpid ($ childPID, 0), чтобы освободить поток, однако это приводит к блокировке родителя, что приводит к вопросу: какой смысл разветвляться, если родитель должен ждать, пока ребенок завершит работу?

ЧТО НЕ БЫЛО ОЧИЩЕННО, так это то, что родитель может выдать waitpid ($ childPID, 0) в любое время позже!

Когда мой дочерний поток завершает последнее, что он делает, это создает файл ... 

open OUT, ">$$.pid";
print OUT $$;
close OUT;
exit(0);

Каждый раз, когда родитель собирается форкнуть, он проверяет файлы .pid, выдает waitpid для каждого и затем удаляет файл .pid.

Это не позволит использовать более 64 подключенийв то же время, но это позволит родителю продолжить работу, пока дочерние потоки выполняют свою работу, а затем освободить потоки после завершения дочернего процесса.

Еще одно упоминание стоит отметить, что первым делом дочерний процесснужно закрыть сокет прослушивания ($ server в вопросе), чтобы только родитель отвечал новым клиентам.

1 голос
/ 16 июля 2011

Я выкопал проблему разветвления perl в Windows (ActiveState Perl 5.10). Проблема в том, что после выхода из дочернего процесса, РУЧКА для разветвленного «процесса», эмулируемая как нить, не закрывается. И, кажется, есть ограничение для 64 потоковых дескрипторов. Так как я не нашел, как закрыть эти дескрипторы потоков, я искал другое решение и обнаружил, что использование реальных потоков работает за пределом 64 (это происходит от http://www.perlmonks.org/?node_id=722374):

#! perl -slw
use strict;
use IO::Socket;
use threads;

our $ADDR ||= 'localhost:35007';

my $listener = IO::Socket::INET->new(
    LocalAddr => $ADDR,
    Listen => 5,
    Reuse   => 1,
) or die $^E;

while( my $client = $listener->accept ) {
    async {
        my($port, $iaddr) = sockaddr_in( getpeername( $client ) );
        printf "From %s:%d: %s", join('.',unpack 'C4', $iaddr ), $port, $_
            while <$client>;
        close $client;
    }->detach;
}

Это действительно работает, по крайней мере, в Windows XP. Любые предостережения, кто-нибудь?

1 голос
/ 18 февраля 2010

Это хитрость, поскольку она не дает прямого ответа на ваш вопрос, но иногда лучший способ устранить ошибки - это написать меньше кода - почему бы не позволить кому-то другому заниматься управлением процессами и обработкой сокетов, а именно Net :: Сервер ? Личность Net :: Server :: Fork предлагает то же поведение, что вы пишете сейчас, хотя лично я бы подумал о Net :: Server :: PreFork вместо.

С Net :: Server ваше приложение будет выглядеть так: 

use strict;
use warnings;
use base 'Net::Server::Fork';

sub process_request {
    my $self = shift;
    # Do JSON stuff here.
    # The client is attached to *STDIN and *STDOUT.
}

# You might omit this and the arguments to run() because
# Net::Server has command-line and config-file handling too.

my $port = shift || 90000;

__PACKAGE__->run(
    proto => "tcp",
    port => $port,
);

Что на самом деле довольно аккуратно, я должен сказать.

...