Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

Re: TCP Server hangs with multiple client connections

by BrowserUk (Pope)
on Aug 02, 2012 at 23:46 UTC ( #985121=note: print w/replies, xml ) Need Help??

in reply to TCP Server hangs with multiple client connections

You don't mention it explicitly, but if you are using Thread::Pool, that is responsible for half your problems. The last time I tested that module it was badly broken and very, very slow. A quick look now and not much seems to have changed.

The other half is that you are trying to use non-blocking sockets on Windows via:

Blocking => 0);

Which unless the powers-that-be have finally gotten around to fixing it, doesn't work on windows.

Also, mixing select processing with multi-threading -- in the way you have done it -- is fraught with problems. It can be done (correctly), but is actually rarely needed.

It is hard to assess your program given that you supply bits rather than the whole thing; and omit significant details -- like the modules you are using -- but you seem to be doing things in very complicated ways.

For reference, here is a simple -- but substantially complete -- pool-based, multi-threaded echo server, that runs very well under extreme load on my Vista machine without skipping a beat:

#! perl -slw use strict; use threads; use threads::shared; use Thread::Queue; use IO::Socket; my $semSTDOUT :shared; sub tprint{ lock $semSTDOUT; print @_; } $|++; my %cache; my $Qwork = new Thread::Queue; my $Qdone = new Thread::Queue; my $done :shared = 0; sub worker { my $tid = threads->tid; while( my $fno = $Qwork->dequeue ) { open my $client, "+<&", $fno or die $!; tprint "$tid: Duped $fno to $client"; my $buffer = ''; while( my $c = sysread( $client, $buffer, 1, length $buffer ) +) { syswrite( $client, $buffer, 1, length( $buffer ) -1 ); while( $buffer =~ s[(^[^\n]+)\n][]g ) { tprint "$tid: got and echoed $1"; } last if $done; } close $client; $Qdone->enqueue( $fno ); tprint "$tid: $client closed"; } } our $W //= 4; my $lsn = new IO::Socket::INET( Listen => 5, LocalPort => '12345' ) or die "Failed to open listening port: $!\n"; my @workers = map threads->create( \&worker, \%cache ), 1 .. $W; $SIG{ INT } = sub { close $lsn; $done = 1; $Qwork->enqueue( (undef) x $W ); }; while( my $client = $lsn->accept ) { my $fno = fileno $client; $cache{ $fno } = $client; $Qwork->enqueue( $fno ); delete $cache{ $Qdone->dequeue } while $Qdone->pending; } tprint "Listener closed"; $_->join for @workers; tprint "Workers done";

If you want some real help with your code -- rather than getting fobbed off with "Use this module I just found on cpan and switch to flavour-du-jour of *nix." -- you'll need to let me see your complete program (here or off-forum).

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://985121]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2018-01-22 01:20 GMT
Find Nodes?
    Voting Booth?
    How did you see in the new year?

    Results (230 votes). Check out past polls.