IO::Socket now sets $!, avoids eval/die (patch from Graham Barr

modified to use Errno more portably)

p4raw-id: //depot/perl@5161

diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm
index 0e81c4b..79820fe 100644 (file)
--- a/ext/IO/lib/IO/Socket.pm
+++ b/ext/IO/lib/IO/Socket.pm
@@ -14,6 +14,7 @@ use Carp;
 use strict;
 our(@ISA, $VERSION);
 use Exporter;
+use Errno;
 
 # legacy
 
@@ -22,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc');
 
 @ISA = qw(IO::Handle);
 
-$VERSION = "1.252";
+$VERSION = "1.26";
 
 sub import {
     my $pkg = shift;
@@ -100,35 +101,36 @@ sub connect {
     my $sock = shift;
     my $addr = shift;
     my $timeout = ${*$sock}{'io_socket_timeout'};
-
+    my $err;
     my $blocking;
     $blocking = $sock->blocking(0) if $timeout;
 
-    eval {
-       croak 'connect: Bad address'
-           if(@_ == 2 && !defined $_[1]);
-
-       unless(connect($sock, $addr)) {
-           if($timeout && ($! == &IO::EINPROGRESS)) {
-               require IO::Select;
+    if (!connect($sock, $addr)) {
+       if ($timeout && exists(&IO::EINPROGRESS) && ($! == &IO::EINPROGRESS)) {
+           require IO::Select;
 
-               my $sel = new IO::Select $sock;
+           my $sel = new IO::Select $sock;
 
-               unless($sel->can_write($timeout) && defined($sock->peername)) {
-                   croak "connect: timeout";
-               }
+           if (!$sel->can_write($timeout)) {
+               $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+               $@ = "connect: timeout";
            }
-           else {
-               croak "connect: $!";
+           elsif(!connect($sock,$addr)) {
+               $err = $!;
+               $@ = "connect: $!";
            }
        }
-    };
+       else {
+           $err = $!;
+           $@ = "connect: $!";
+       }
+    }
 
-    my $ret = $@ ? undef : $sock;
+    $sock->blocking(1) if $blocking;
 
-    $sock->blocking($blocking) if $timeout;
+    $! = $err if $err;
 
-    $ret;
+    $err ? undef : $sock;
 }
 
 sub bind {
@@ -158,23 +160,23 @@ sub accept {
     my $new = $pkg->new(Timeout => $timeout);
     my $peer = undef;
 
-    eval {
-       if($timeout) {
-           require IO::Select;
+    if($timeout) {
+       require IO::Select;
 
-           my $sel = new IO::Select $sock;
+       my $sel = new IO::Select $sock;
+
+       unless ($sel->can_read($timeout)) {
+           $@ = 'accept: timeout';
+           $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+           return;
+       }
+    }
+
+    $peer = accept($new,$sock)
+       or return;
 
-           croak "accept: timeout"
-               unless $sel->can_read($timeout);
-       }
-       $peer = accept($new,$sock) || undef;
-    };
-    croak "$@" if $@ and $sock;
-
-    return wantarray ? defined $peer ? ($new, $peer)
-                                    : () 
-                    : defined $peer ? $new
-                                    : undef;
+    return wantarray ? ($new, $peer)
+                    : $new;
 }
 
 sub sockname {

diff --git a/ext/IO/lib/IO/Socket/INET.pm b/ext/IO/lib/IO/Socket/INET.pm
index 30a9230..af64c96 100644 (file)
--- a/ext/IO/lib/IO/Socket/INET.pm
+++ b/ext/IO/lib/IO/Socket/INET.pm
@@ -12,9 +12,10 @@ use IO::Socket;
 use Socket;
 use Carp;
 use Exporter;
+use Errno qw(EINVAL);  # EINVAL appears portable
 
 @ISA = qw(IO::Socket);
-$VERSION = "1.24";
+$VERSION = "1.25";
 
 IO::Socket::INET->register_domain( AF_INET );
 
@@ -38,10 +39,16 @@ sub _sock_info {
        if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
 
   if(defined $proto) {
-    @proto = $proto =~ m,\D, ? getprotobyname($proto)
-                            : getprotobynumber($proto);
-
-    $proto = $proto[2] || undef;
+    if (@proto = ( $proto =~ m,\D,
+               ? getprotobyname($proto)
+               : getprotobynumber($proto))
+    ) {
+      $proto = $proto[2] || undef;
+    }
+    else {
+      $@ = "Bad protocol '$proto'";
+      return;
+    }
   }
 
   if(defined $port) {
@@ -50,8 +57,12 @@ sub _sock_info {
     my $defport = $1 || undef;
     my $pnum = ($port =~ m,^(\d+)$,)[0];
 
-    @serv= getservbyname($port, $proto[0] || "")
-       if($port =~ m,\D,);
+    if ($port =~ m,\D,) {
+      unless (@serv = getservbyname($port, $proto[0] || "")) {
+       $@ = "Bad service '$port'";
+       return;
+      }
+    }
 
     $port = $pnum || $serv[2] || $defport || undef;
 
@@ -67,10 +78,14 @@ sub _sock_info {
 
 sub _error {
     my $sock = shift;
-    local($!);
-    $@ = join("",ref($sock),": ",@_);
-    close($sock)
+    my $err = shift;
+    {
+      local($!);
+      $@ = join("",ref($sock),": ",@_);
+      close($sock)
        if(defined fileno($sock));
+    }
+    $! = $err;
     return undef;
 }
 
@@ -96,12 +111,13 @@ sub configure {
 
     ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
                                        $arg->{LocalPort},
-                                       $arg->{Proto});
+                                       $arg->{Proto})
+                       or return _error($sock, $!, $@);
 
     $laddr = defined $laddr ? inet_aton($laddr)
                            : INADDR_ANY;
 
-    return _error($sock,"Bad hostname '",$arg->{LocalAddr},"'")
+    return _error($sock, EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
        unless(defined $laddr);
 
     $arg->{PeerAddr} = $arg->{PeerHost}
@@ -110,7 +126,8 @@ sub configure {
     unless(exists $arg->{Listen}) {
        ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
                                            $arg->{PeerPort},
-                                           $proto);
+                                           $proto)
+                       or return _error($sock, $!, $@);
     }
 
     $proto ||= (getprotobyname('tcp'))[2];
@@ -122,28 +139,28 @@ sub configure {
 
     if(defined $raddr) {
        @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
-       return _error($sock,"Bad hostname '",$arg->{PeerAddr},"'")
+       return _error($sock, EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
            unless @raddr;
     }
 
     while(1) {
 
        $sock->socket(AF_INET, $type, $proto) or
-           return _error($sock,"$!");
+           return _error($sock, $!, "$!");
 
        if ($arg->{Reuse}) {
            $sock->sockopt(SO_REUSEADDR,1) or
-                   return _error($sock,"$!");
+                   return _error($sock, $!, "$!");
        }
 
        if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
            $sock->bind($lport || 0, $laddr) or
-                   return _error($sock,"$!");
+                   return _error($sock, $!, "$!");
        }
 
        if(exists $arg->{Listen}) {
            $sock->listen($arg->{Listen} || 5) or
-               return _error($sock,"$!");
+               return _error($sock, $!, "$!");
            last;
        }
 
@@ -152,13 +169,13 @@ sub configure {
  
         $raddr = shift @raddr;
 
-       return _error($sock,'Cannot determine remote port')
+       return _error($sock, EINVAL, 'Cannot determine remote port')
                unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
 
        last
            unless($type == SOCK_STREAM || defined $raddr);
 
-       return _error($sock,"Bad hostname '",$arg->{PeerAddr},"'")
+       return _error($sock, EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
            unless defined $raddr;
 
 #        my $timeout = ${*$sock}{'io_socket_timeout'};
@@ -169,12 +186,14 @@ sub configure {
             return $sock;
         }
 
-       return _error($sock,"$!")
+       return _error($sock, $!, "Timeout")
            unless @raddr;
 
 #      if ($timeout) {
 #          my $new_timeout = $timeout - (time() - $before);
-#          return _error($sock, "Timeout") if $new_timeout <= 0;
+#          return _error($sock,
+#                         (exists(&Errno::ETIMEDOUT) ? &Errno::ETIMEDOUT : EINVAL),
+#                         "Timeout") if $new_timeout <= 0;
 #          ${*$sock}{'io_socket_timeout'} = $new_timeout;
 #        }