Re: windows nt/2000 breaks non-blocking sockets

On Fri, Aug 17, 2001 at 03:47:45PM -0700, Gurusamy Sarathy wrote:
> On Fri, 17 Aug 2001 17:39:58 EDT, Rocco Caputo wrote:
> >Symptom:
> >
> >Non-blocking connect() calls on Windows 2000/NT systems return error
> >10022 (invalid argument) despite the parameters being fine.
> >
> >Cause:
> >
> >http://support.microsoft.com/support/kb/articles/Q179/9/42.ASP
> >
> >Synopsis:
> >
> >Newer versions of Windows need WSA_FLAG_OVERLAPPED to be set at the
> >time sockets are created, otherwise the sockets can't be made
> >non-blocking later.  Previous versions of Windows don't require the
> >flag, so non-blocking sockets work there.
> 
> This is not really obvious to me.
> 
> Perl uses socket() (not WSASocket()) to create sockets on Windows.
> This page claims that socket() already sets the overlapped bit:
> 
>   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/hh/winsock/ovrvw3_769e.asp
> 
> And the URL you have given above doesn't contradict that.
> 
> Can you show me a self-contained example of the perl code that works
> on wNT but not on w2000?

Sorry, no.  I'm tracking down this error on a borrowed Windows NT 4.0
machine, under less than ideal conditions.  I don't have a Win2000
machine to try it on, but I do have a self-contained testcase.  I
apologize for its length.

Non-blocking connect() tends to fail on NT and similar systems.  It
tends to work on Win9x systems.  If it's not the WSA_FLAG_OVERLAPPED
problem, then it's something that looks almost identical to it.

-- Rocco Caputo / troc@netrus.net / poe.perl.org / poe.sourceforge.net


#!/usr/bin/perl -w

# Set to 1 to call _stop_blocking() before calling connect().  On NT
# 4.0, this causes connect() to immediately return an error, with $!
# set to 10022 (invalid argument).
#
# Set to 0 to bypass _stop_blocking() before calling connect().
# Oddly, connect() doesn't actually block on NT 4.0.  I expected a
# deadlock.  The socket pair is established, and life goes on.

sub DO_NONBLOCKING_CONNECT () { 1 }

#-------------------------------

use strict;
use Symbol qw(gensym);
use IO::Socket;
use POSIX qw(fcntl_h errno_h);

# Provide a dummy EINPROGRESS for systems that don't have one.  Give
# it a documented value.  This code is stolen from
# POE::Wheel::SocketFactory.

BEGIN {
  # http://support.microsoft.com/support/kb/articles/Q150/5/37.asp
  # defines EINPROGRESS as 10035.  We provide it here because some
  # Win32 users report POSIX::EINPROGRESS is not vendor-supported.
  if ($^O eq 'MSWin32') {
    eval '*EINPROGRESS = sub { 10036 };';
    eval '*EWOULDBLOCK = sub { 10035 };';
    eval '*F_GETFL     = sub {     0 };';
    eval '*F_SETFL     = sub {     0 };';
  }
}

# Portable turn-off-blocking code, also stolen from POE::Wheel::SocketFactory.

sub _stop_blocking {
  my $socket_handle = shift;

  # Do it the Win32 way.
  if ($^O eq 'MSWin32') {
    my $set_it = "1";

    # 126 is FIONBIO (some docs say 0x7F << 16)
    ioctl( $socket_handle,
           0x80000000 | (4 << 16) | (ord('f') << 8) | 126,
           $set_it
         )
      or die "ioctl: $!";
  }

  # Do it the way everyone else does.
  else {
    my $flags = fcntl($socket_handle, F_GETFL, 0) or die "getfl: $!";
    $flags = fcntl($socket_handle, F_SETFL, $flags | O_NONBLOCK)
      or die "setfl: $!";
  }
}

# Make a socket.  This is a homebrew socketpair() for systems that
# don't support it.

sub make_socket {

  ### Server side.

  my $acceptor = gensym();
  my $accepted = gensym();

  my $tcp = getprotobyname('tcp') or die "getprotobyname: $!";
  socket( $acceptor, PF_INET, SOCK_STREAM, $tcp ) or die "socket: $!";

  setsockopt( $acceptor, SOL_SOCKET, SO_REUSEADDR, 1) or die "reuse: $!";

  my $server_addr = inet_aton('127.0.0.1') or die "inet_aton: $!";
  $server_addr = pack_sockaddr_in(0, $server_addr)
    or die "sockaddr_in: $!";

  bind( $acceptor, $server_addr ) or die "bind: $!";
  _stop_blocking($acceptor);
  $server_addr = getsockname($acceptor);
  listen( $acceptor, SOMAXCONN ) or die "listen: $!";

  ### Client side.

  my $connector = gensym();

  socket( $connector, PF_INET, SOCK_STREAM, $tcp ) or die "socket: $!";

  # This is the only thing that changes.
  DO_NONBLOCKING_CONNECT and do {
    _stop_blocking($connector);
  };

  unless (connect( $connector, $server_addr )) {
    die "connect (1) error " . ($!+0) . ": $!"
      if $! and ($! != EINPROGRESS) and ($! != EWOULDBLOCK);
  }

  ### Loop around 'til it's all done.

  my $in_read  = '';
  my $in_write = '';

  vec( $in_read,  fileno($acceptor),  1 ) = 1;
  vec( $in_write, fileno($connector), 1 ) = 1;

  my $done = 0;
  while ($done != 0x11) {
    my $hits = select( my $out_read   = $in_read,
                       my $out_write  = $in_write,
                       undef,
                       5
                     );
    die "select: $!" unless $hits;

    # Accept happened.
    if (vec($out_read, fileno($acceptor), 1)) {
      $done |= 0x10;
    }

    # Connect happened.
    if (vec($out_write, fileno($connector), 1)) {
      $! = unpack('i', getsockopt($connector, SOL_SOCKET, SO_ERROR));
      die "connect (2) error " . ($_+0) . ": $!" if $!;
      $done |= 0x01;
    }
  }

  return ($accepted, $connector);
}

my ($listener, $connector) = make_socket();
print "Success!\n" if defined $listener and defined $connector;

__END__

• windows nt/2000 breaks non-blocking sockets by Rocco Caputo
• Re: windows nt/2000 breaks non-blocking sockets by Gurusamy Sarathy
• Re: windows nt/2000 breaks non-blocking sockets by Rocco Caputo