Why does Perl's IO::Socket on Windows complain

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

I spent a long time working this out.

Each Windows perl program has a limit of 64 threads and POSIX is not supported.

After you fork a child, the parent needs to call waitpid($childPID,0) to free up the thread, however this causes the parent to block, leading to the question: What is the point of forking if the parent must wait for the child to finish?

WHAT WAS NOT CLEAR is that the parent can issue waitpid($childPID,0) at any time later on!

When my child thread has finished the last thing it does is create a file...

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

Each time the parent is about to fork it checks for .pid files, and issues the waitpid for each and then deletes the .pid file.

This will not allow more than 64 connections at the same time, but it will allow the parent to continue while child threads do their work, and then free up threads when the child has finished.

Another worthwile mention is that the first thing the child should do is to close the listening socket ($server in the question) so that only the parent will answer new clients.

Answer 2

I've digged the problem of perl's fork on Windows (ActiveState Perl 5.10). The problem is that after child exits, the HANDLE for the forked "process", emulated as thread, is not closed. And there seems to be a limit for 64 thread handles. Since I didn't find how to close those thread handles, I've looked for another solution and found that using real threads works past 64 limit (this comes from 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;
}

This really works, at least on Windows XP. Any caveats, anybody?

Answer 3

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 4

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.