Re: Socket hang. (Windows or Perl? Solutions?) (Updated)

Hi BrowserUk,

Today, I came across this thread and like to share the solution used inside MCE::Util to have sockets close immediately on the Windows platform. Below are the relevant lines in the demonstration that follows.

# anything windows, including Cygwin
my $is_winenv = ( $^O =~ /mswin|mingw|msys|cygwin/i );

# write a char before calling shutdown
syswrite($client, '0') if $is_winenv;
$client->shutdown( 2 );
close $client;

syswrite($svr, '0') if $is_winenv;
$svr->shutdown( 2 );
close $svr;
[download]

I ran your demonstration with the fix using Strawberry Perl.

#! perl -slw
use strict;
use Time::HiRes qw[ time usleep ];
use threads;
use threads::shared;
use IO::Socket;

our $port //= 12345;

my $svrN    :shared = 0;
my $clientN :shared = 0;

my $is_winenv = ( $^O =~ /mswin|mingw|msys|cygwin/i );
my $start = time;

async {
    my $svr = IO::Socket::INET->new(
        Listen =>  SOMAXCONN,
        Reuse =>1,
        LocalPort => $port,
        Timeout => 0.1,
    ) or die $!;

    while( my $client = $svr->accept ) {
        my $in = <$client>;
        print $client "echod:$in";
        syswrite($client, '0') if $is_winenv;
        $client->shutdown( 2 );
        close $client;
        ++$svrN;
    }
}->detach;

async {
    while( 1 ) {
        my $svr = IO::Socket::INET->new(
            PeerHost => 'localhost',
            PeerPort => $port,
            Reuse => 1,
            Timeout => 0.1,
        ) or usleep( 10_000 ), next;

        sleep 0;

        print $svr ++$clientN;
        my $echo = <$svr>;

        sleep 0;

        syswrite($svr, '0') if $is_winenv;
        $svr->shutdown( 2 );
        close $svr;

        sleep 0;
    }
}->detach;

$|++;

while( usleep 100_000 ) {
    printf "\rserver:$svrN client:$clientN cycles: %.3f/sec",
        $svrN / ( time() - $start );
}
[download]

I pressed Ctrl-C after reaching 200k connections.

Y:\>perl demo_thr.pl
server:208500 client:208501 cycles: 2128.246/secTerminating on signal 
+SIGINT(2)
[download]

Running netstat using Cygwin shows no extra connections lingering around. Netstat reports 22 ~ 24 (not more) while Strawberry Perl ran.

$ netstat -na | wc -l
     21
[download]

Without the fix, netstat reports a high number that keeps increasing due to sockets not closing immediately.

$ netstat -na | wc -l
  14055
[download]

Regards, Mario

Comment on Re: Socket hang. (Windows or Perl? Solutions?) (Updated) Select or Download Code

Replies are listed 'Best First'.
Re^2: Socket hang. (Windows or Perl? Solutions?) (Updated) by marioroy (Prior) on Sep 01, 2018 at 04:25 UTC
Hi again! BrowserUk's demo is possible for Perl lacking threads support. A condition variable is needed to prevent a race condition, especially for processes that spawn quickly. For example, the 2nd worker attempting to connect before the 1st worker initiates the connection. #! perl -slw # Parallel example for Perl not built with threads support. # Based on https://www.perlmonks.org/?node_id=897591. use strict; use Time::HiRes qw[ time usleep ]; use MCE::Hobo; use MCE::Shared; use IO::Socket; our $port //= 12345; my $condvar = MCE::Shared->condvar; my $svrN = MCE::Shared->scalar( 0 ); my $clientN = MCE::Shared->scalar( 0 ); my $is_winenv = ( $^O =~ /mswin\|mingw\|msys\|cygwin/i ); my $start = time; mce_async { my $svr = IO::Socket::INET->new( Listen => SOMAXCONN, Reuse =>1, LocalPort => $port, Timeout => 0.1, ) or die $!; # signal the client ready $condvar->signal; while( my $client = $svr->accept ) { my $in = <$client>; print $client "echod:$in"; syswrite($client, '0') if $is_winenv; $client->shutdown( 2 ); close $client; $svrN->incr; } }; mce_async { # wait for the server connection $condvar->wait; while( 1 ) { my $svr = IO::Socket::INET->new( PeerHost => 'localhost', PeerPort => $port, Reuse => 1, Timeout => 0.1, ) or usleep( 10_000 ), next; sleep 0; print $svr $clientN->incr; my $echo = <$svr>; sleep 0; syswrite($svr, '0') if $is_winenv; $svr->shutdown( 2 ); close $svr; sleep 0; } }; $\|++; while( usleep 100_000 ) { my ( $n1, $n2 ) = ( $svrN->get, $clientN->get ); printf "\rserver:$n1 client:$n2 cycles: %.3f/sec", $n1 / ( time() - $start ); } [download] Note: MCE::Shared involves sockets. So it will not run as fast as threads::shared. Not to worry, it's not far behind. Strawberry Perl `Y:\>perl demo_thr.pl server:29889 client:29889 cycles: 2119.429/secTerminating on signal SI +GINT(2) Y:\>perl demo_mce.pl server:35619 client:35620 cycles: 1771.711/secTerminating on signal SI +GINT(2)` [download] Cygwin `$ perl demo_thr.pl server:31879 client:31879 cycles: 2128.663/sec $ perl demo_mce.pl server:31690 client:31691 cycles: 1856.834/sec` [download] Regards, Mario	[reply] [d/l] [select]
Re^2: Socket hang. (Windows or Perl? Solutions?) (Updated) by BrowserUk (Patriarch) on Sep 01, 2018 at 07:50 UTC
Thanks marioroy; but I documented the solution I found to the problem in Re^4: Socket hang. (Windows or Perl? Solutions?) (Updated). 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". The enemy of (IT) success is complexity. In the absence of evidence, opinion is indistinguishable from prejudice. Suck that fhit	[reply]


Pathologically Eclectic Rubbish Lister
	PerlMonks