From: Gurusamy Sarathy Date: Sun, 20 Feb 2000 12:13:37 +0000 (+0000) Subject: IO::Socket now sets $!, avoids eval/die (patch from Graham Barr X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9fcc6c44229e7c36dee08e5d883d12284a44f17;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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; # }