[perl #107962] IO::Socket async connect() logic is broken on Solaris

# New Ticket Created by  carson@taltos.org 
# Please include the string:  [perl #107962]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=107962 >



This is a bug report for perl from carson@taltos.org,
generated with the help of perlbug 1.39 running under perl 5.14.2.


-----------------------------------------------------------------
[Please describe your issue here]
The async connect() logic in IO::Socket is broken for Solaris (and almost
certainly other OS variants). It assumes you're allowed to call connect() a
second time, which is not at all guaranteed. Solaris correctly returns EINVAL
when IO::Socket does so (as does Windows, but they spell it WSAEINVAL, and
there is code that handles that already).

There was a recent commit to change the select() logic, but it's still wrong.

Below is some very lightly tested code that tries to do the right thing on all platforms.

sub connect {
    @_ == 2 or croak 'usage: $sock->connect(NAME)';
    my $sock = shift;
    my $addr = shift;
    my $timeout = ${*$sock}{'io_socket_timeout'};
    my $err;
    my $blocking;

    $blocking = $sock->blocking(0) if $timeout;
    if (!connect($sock, $addr)) {
        if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
            require IO::Select;

            my $sel = new IO::Select $sock;

            undef $!;
            my($r,$w,$e) = IO::Select::select($sel,$sel,$sel,$timeout);
            if (!defined($r) && !defined($w) && !defined($e)) {
                # select returns an empty list on timeout or other error
                $err = $!;
                if ($err == 0) {
                    # timeout
                    $err = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
                    $@ = "connect: timeout";
                }
            }
            elsif(@$w[0] || @$r[0]) {
                # select() returns writable when connect() completes
                # select() returns readable if there's an error
                # if both, we either received data very quickly, or it's
                # an odd OS specific error behaviour.
                if (@$r[0]) {
                    if (exists(&Socket::SO_ERROR)) {
                        # The best way to get the error state, if supported
                        $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR);
                        if ($err == 0) {
                            undef $err;
                        }
                    }
                    else {
                        # If SO_ERROR isn't supported, the options to get
                        # the error code are all bad. sysread($fd, $junk, 0)
                        # works on some systems. Calling connect() again
                        # works on others. But neither is reliable in
                        # portable code. The only portable option is
                        # getpeername(), which returns a generic error.
                        if (! getpeername($sock)) {
                            $err = $!;
                        }
                    }
                }
            }
            elsif(@$e[0]) {
                # We really shouldn't ever get here. Exception means
                # OOB data is waiting on most UNIX platforms, and
                # should never be set without read or write.
                # Windows return from select after the timeout in case of
                # WSAECONNREFUSED(10061) if exception set is not used.
                # This behavior is different from Linux.
                # Using the exception
                # set we now emulate the behavior in Linux
                #    - Karthik Rajagopalan
                $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR);
                $@ = "connect: $err";
            }
        }
        elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK}))  {
            $err = $!;
            $@ = "connect: $!";
        }
    }

    $sock->blocking(1) if $blocking;

    $! = $err if $err;

    $err ? undef : $sock;
}


[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=library
    severity=high
    module=IO::Socket
---
Site configuration information for perl 5.14.2:

Configured by carson at Tue Jan 10 19:32:20 PST 2012.

Summary of my perl5 (revision 5 version 14 subversion 2) configuration:
   
  Platform:
    osname=solaris, osvers=2.11, archname=i86pc-solaris-64
    uname='sunos gandalf.local.taltos.org 5.11 11.0 i86pc i386 i86pc '
    config_args='-Dprefix=/Tools/SunOS_5.11_i86pc_amd64/perl-5.14.2 -Doptimize=-xO5 -xchip=sandybridge -xarch=sse4_2 -xarch=avx -xarch=aes -Dcf_email=carson@taltos.org -Dinstallsitelib=/var/tmp/site_perl/5.14.2 -Dotherlibdirs=/usr/local/lib/site_perl/5.14.2:/usr/local/lib/site_perl/5.14 -Dccflags=-m64 -d'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-m64 -I/usr/local/include -m64 -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -DPERL_USE_SAFE_PUTENV',
    optimize='-xO5 -xchip=sandybridge -xarch=sse4_2 -xarch=avx -xarch=aes',
    cppflags='-m64 -I/usr/local/include'
    ccversion='Sun C 5.12 SunOS_i386 Spica 2011/07/21', gccversion='', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/lib -L/usr/ccs/lib -L/opt/solstudiodev/prod/lib -L/lib -L/usr/local/lib -L/usr/gnu/lib -m64 '
    libpth=/usr/lib /usr/ccs/lib /opt/solstudiodev/prod/lib /lib /usr/local/lib /usr/gnu/lib
    libs=-lsocket -lnsl -lgdbm -ldb -ldl -lm -lc
    perllibs=-lsocket -lnsl -ldl -lm -lc
    libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-KPIC', lddlflags=' -G -m64 -L/usr/lib -L/usr/ccs/lib -L/opt/solstudiodev/prod/lib -L/lib -L/usr/local/lib -L/usr/gnu/lib'

Locally applied patches:
    

---
@INC for perl 5.14.2:
    /Tools/SunOS_5.11_i86pc_amd64/perl-5.14.2/lib/site_perl/5.14.2/i86pc-solaris-64
    /Tools/SunOS_5.11_i86pc_amd64/perl-5.14.2/lib/site_perl/5.14.2
    /Tools/SunOS_5.11_i86pc_amd64/perl-5.14.2/lib/5.14.2/i86pc-solaris-64
    /Tools/SunOS_5.11_i86pc_amd64/perl-5.14.2/lib/5.14.2
    /usr/local/lib/site_perl/5.14.2/i86pc-solaris-64
    /usr/local/lib/site_perl/5.14.2
    /usr/local/lib/site_perl/5.14
    .

---
Environment for perl 5.14.2:
    HOME=/home/carson
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LC_ALL=
    LC_COLLATE=
    LC_CTYPE=
    LC_MESSAGES=
    LC_MONETARY=
    LC_NUMERIC=
    LC_TIME=
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/tools/perl/bin:/tools/python/bin:/opt/solstudiodev/bin:/usr/ccs/bin:/bin:/usr/bin:/sbin:/usr/sbin:/usr/openwin/bin:/usr/dt/bin:/usr/local/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

• Re: [perl #107962] IO::Socket async connect() logic is broken onSolaris by Carson Gaspar
• [perl #107962] IO::Socket async connect() logic is broken on Solaris by James E Keenan via RT
• Re: [perl #107962] IO::Socket async connect() logic is broken onSolaris by Nicholas Clark
• Re: [perl #107962] IO::Socket async connect() logic is broken onSolaris by Paul LeoNerd Evans
• [perl #107962] IO::Socket async connect() logic is broken on Solaris by carson @ taltos . org