Why does Perl's IO::Socket on Windows complain about "Resource Not Available" after 64 connections?

Question

I created a server with Perl under Windows (ActivePerl 5.10.1 build 1006) that forks upon being connected to, accepts some JSON data, and writes it to a database. I am running into a problem after 64 clients connect to the server, the error message being "Resource is not available" when trying to fork.

Running this code under Linux I found many defunct child process, which was solved by adding a wait() call on the parent. This however did not solve the problem. Running the code under Linux works past the 64 calls allowed in Windows.

I also spun up a virtual Windows server in case it was restrictions on the server, but a fresh install of Perl resulted in the same 64 connection limit.

Any ideas is appreciated.

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;

Answer 1

Try reaping the zombie processes from the finished transactions. I can get your sample code to keep running if I include a couple more lines:

    use POSIX ':sys_wait_h';

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

If you might have 64 simultaneous connections, you might have to think of something else -- it's no good to install a SIGCHLD handler on Windows.

Answer 2

This is a dodge since it doesn't answer your question directly, but sometimes the best way to remove bugs is to write less code -- why not let someone else do the process management and socket handling for you -- namely Net::Server? The Net::Server::Fork personality offers the same behavior as you're writing now, although personally I would think about Net::Server::PreFork instead.

With Net::Server, your app would look like:

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,
);

Which is really pretty tidy, I have to say.