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

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.