From 790d3169bf82e566456367b233bbd0ca95d0a4af Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Fri, 3 Feb 2012 10:24:20 -0500 Subject: Revert "Add IO::Socket::IP 0.08 as dual-life module" This reverts commit 497f7de2d964167330f7260590736e9adb18899c. --- MANIFEST | 16 - Porting/Maintainers.pl | 8 - cpan/IO-Socket-IP/lib/IO/Socket/IP.pm | 826 --------------------- cpan/IO-Socket-IP/t/00use.t | 6 - cpan/IO-Socket-IP/t/01local-client-v4.t | 50 -- cpan/IO-Socket-IP/t/02local-server-v4.t | 54 -- cpan/IO-Socket-IP/t/03local-cross-v4.t | 36 - cpan/IO-Socket-IP/t/04local-client-v6.t | 60 -- cpan/IO-Socket-IP/t/05local-server-v6.t | 62 -- cpan/IO-Socket-IP/t/06local-cross-v6.t | 41 - cpan/IO-Socket-IP/t/10args.t | 52 -- cpan/IO-Socket-IP/t/11sockopts.t | 43 -- cpan/IO-Socket-IP/t/12port-fallback.t | 42 -- cpan/IO-Socket-IP/t/13addrinfo.t | 53 -- cpan/IO-Socket-IP/t/14fileno.t | 24 - cpan/IO-Socket-IP/t/15io-socket.t | 34 - cpan/IO-Socket-IP/t/20nonblocking-connect.t | 48 -- .../t/21nonblocking-connect-internet.t | 99 --- pod/perldelta.pod | 5 - t/porting/known_pod_issues.dat | 1 - 20 files changed, 1560 deletions(-) delete mode 100644 cpan/IO-Socket-IP/lib/IO/Socket/IP.pm delete mode 100644 cpan/IO-Socket-IP/t/00use.t delete mode 100644 cpan/IO-Socket-IP/t/01local-client-v4.t delete mode 100644 cpan/IO-Socket-IP/t/02local-server-v4.t delete mode 100644 cpan/IO-Socket-IP/t/03local-cross-v4.t delete mode 100644 cpan/IO-Socket-IP/t/04local-client-v6.t delete mode 100644 cpan/IO-Socket-IP/t/05local-server-v6.t delete mode 100644 cpan/IO-Socket-IP/t/06local-cross-v6.t delete mode 100644 cpan/IO-Socket-IP/t/10args.t delete mode 100644 cpan/IO-Socket-IP/t/11sockopts.t delete mode 100644 cpan/IO-Socket-IP/t/12port-fallback.t delete mode 100644 cpan/IO-Socket-IP/t/13addrinfo.t delete mode 100644 cpan/IO-Socket-IP/t/14fileno.t delete mode 100644 cpan/IO-Socket-IP/t/15io-socket.t delete mode 100644 cpan/IO-Socket-IP/t/20nonblocking-connect.t delete mode 100644 cpan/IO-Socket-IP/t/21nonblocking-connect-internet.t diff --git a/MANIFEST b/MANIFEST index ded2b0ae5b..0295b7c5ab 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1371,22 +1371,6 @@ cpan/IO-Compress/t/cz-06gzsetp.t IO::Compress cpan/IO-Compress/t/cz-08encoding.t IO::Compress cpan/IO-Compress/t/cz-14gzopen.t IO::Compress cpan/IO-Compress/t/globmapper.t IO::Compress -cpan/IO-Socket-IP/lib/IO/Socket/IP.pm -cpan/IO-Socket-IP/t/00use.t -cpan/IO-Socket-IP/t/01local-client-v4.t -cpan/IO-Socket-IP/t/02local-server-v4.t -cpan/IO-Socket-IP/t/03local-cross-v4.t -cpan/IO-Socket-IP/t/04local-client-v6.t -cpan/IO-Socket-IP/t/05local-server-v6.t -cpan/IO-Socket-IP/t/06local-cross-v6.t -cpan/IO-Socket-IP/t/10args.t -cpan/IO-Socket-IP/t/11sockopts.t -cpan/IO-Socket-IP/t/12port-fallback.t -cpan/IO-Socket-IP/t/13addrinfo.t -cpan/IO-Socket-IP/t/14fileno.t -cpan/IO-Socket-IP/t/15io-socket.t -cpan/IO-Socket-IP/t/20nonblocking-connect.t -cpan/IO-Socket-IP/t/21nonblocking-connect-internet.t cpan/IO-Zlib/t/basic.t Tests for IO::Zlib cpan/IO-Zlib/t/external.t Tests for IO::Zlib cpan/IO-Zlib/t/getc.t Tests for IO::Zlib diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 978b83901c..dcd262149d 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1011,14 +1011,6 @@ use File::Glob qw(:case); 'UPSTREAM' => 'cpan', }, - 'IO::Socket::IP' => { - 'MAINTAINER' => 'pevans', - 'DISTRIBUTION' => 'PEVANS/IO-Socket-IP-0.08.tar.gz', - 'FILES' => q[cpan/IO-Socket-IP], - 'EXCLUDED' => ['t/99pod.t'], - 'UPSTREAM' => 'cpan', - }, - 'IO::Zlib' => { 'MAINTAINER' => 'tomhughes', 'DISTRIBUTION' => 'TOMHUGHES/IO-Zlib-1.10.tar.gz', diff --git a/cpan/IO-Socket-IP/lib/IO/Socket/IP.pm b/cpan/IO-Socket-IP/lib/IO/Socket/IP.pm deleted file mode 100644 index ab457588b0..0000000000 --- a/cpan/IO-Socket-IP/lib/IO/Socket/IP.pm +++ /dev/null @@ -1,826 +0,0 @@ -# You may distribute under the terms of either the GNU General Public License -# or the Artistic License (the same terms as Perl itself) -# -# (C) Paul Evans, 2010-2011 -- leonerd@leonerd.org.uk - -package IO::Socket::IP; - -use strict; -use warnings; -use base qw( IO::Socket ); - -our $VERSION = '0.08'; - -use Carp; - -use Socket 1.95 qw( - getaddrinfo getnameinfo - AF_INET - AI_PASSIVE - IPPROTO_TCP IPPROTO_UDP - NI_DGRAM NI_NUMERICHOST NI_NUMERICSERV - SO_REUSEADDR SO_REUSEPORT SO_BROADCAST SO_ERROR - SOCK_DGRAM SOCK_STREAM - SOL_SOCKET -); -my $AF_INET6 = eval { Socket::AF_INET6() }; # may not be defined -my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0; -use POSIX qw( dup2 ); -use Errno qw( EINPROGRESS ); - -use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" ); - -my $IPv6_re = do { - # translation of RFC 3986 3.2.2 ABNF to re - my $IPv4address = do { - my $dec_octet = q<(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])>; - qq<$dec_octet(?: \\. $dec_octet){3}>; - }; - my $IPv6address = do { - my $h16 = qq<[0-9A-Fa-f]{1,4}>; - my $ls32 = qq<(?: $h16 : $h16 | $IPv4address)>; - qq<(?: - (?: $h16 : ){6} $ls32 - | :: (?: $h16 : ){5} $ls32 - | (?: $h16 )? :: (?: $h16 : ){4} $ls32 - | (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32 - | (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32 - | (?: (?: $h16 : ){0,3} $h16 )? :: $h16 : $ls32 - | (?: (?: $h16 : ){0,4} $h16 )? :: $ls32 - | (?: (?: $h16 : ){0,5} $h16 )? :: $h16 - | (?: (?: $h16 : ){0,6} $h16 )? :: - )> - }; - qr<$IPv6address>xo; -}; - -=head1 NAME - -C - A drop-in replacement for C supporting -both IPv4 and IPv6 - -=head1 SYNOPSIS - - use IO::Socket::IP; - - my $sock = IO::Socket::IP->new( - PeerHost => "www.google.com", - PeerPort => "http", - Type => SOCK_STREAM, - ) or die "Cannot construct socket - $@"; - - my $familyname = ( $sock->sockdomain == PF_INET6 ) ? "IPv6" : - ( $sock->sockdomain == PF_INET ) ? "IPv4" : - "unknown"; - - printf "Connected to google via %s\n", $familyname; - -=head1 DESCRIPTION - -This module provides a protocol-independent way to use IPv4 and IPv6 sockets, -as a drop-in replacement for L. Most constructor arguments -and methods are provided in a backward-compatible way. For a list of known -differences, see the C INCOMPATIBILITES section below. - -It uses the C function to convert hostnames and service names -or port numbers into sets of possible addresses to connect to or listen on. -This allows it to work for IPv6 where the system supports it, while still -falling back to IPv4-only on systems which don't. - -=head1 REPLACING C DEFAULT BEHAVIOUR - -By placing C<-register> in the import list, C uses -C rather than C as the class that handles -C. C will also use C rather than -C to handle C, provided that the C -constant is available. - -Changing C's default behaviour means that calling the -C constructor with either C or C as the -C parameter will yield an C object. - - use IO::Socket::IP -register; - - my $sock = IO::Socket->new( - Domain => PF_INET6, - LocalHost => "::1", - Listen => 1, - ) or die "Cannot create socket - $@\n"; - - print "Created a socket of type " . ref($sock) . "\n"; - -Note that C<-register> is a global setting that applies to the entire program; -it cannot be applied only for certain callers, removed, or limited by lexical -scope. - -=cut - -sub import -{ - my $pkg = shift; - my @symbols; - - foreach ( @_ ) { - if( $_ eq "-register" ) { - $pkg->register_domain( AF_INET ); - $pkg->register_domain( $AF_INET6 ) if defined $AF_INET6; - } - else { - push @symbols, $_; - } - } - - @_ = ( $pkg, @symbols ); - goto &IO::Socket::import; -} - -=head1 CONSTRUCTORS - -=cut - -=head2 $sock = IO::Socket::IP->new( %args ) - -Creates a new C object, containing a newly created socket -handle according to the named arguments passed. The recognised arguments are: - -=over 8 - -=item PeerHost => STRING - -=item PeerService => STRING - -Hostname and service name for the peer to C to. The service name -may be given as a port number, as a decimal string. - -=item PeerAddr => STRING - -=item PeerPort => STRING - -For symmetry with the accessor methods and compatibility with -C, these are accepted as synonyms for C and -C respectively. - -=item PeerAddrInfo => ARRAY - -Alternate form of specifying the peer to C to. This should be an -array of the form returned by C. - -This parameter takes precedence over the C, C, C and -C arguments. - -=item LocalHost => STRING - -=item LocalService => STRING - -Hostname and service name for the local address to C to. - -=item LocalAddr => STRING - -=item LocalPort => STRING - -For symmetry with the accessor methods and compatibility with -C, these are accepted as synonyms for C and -C respectively. - -=item LocalAddrInfo => ARRAY - -Alternate form of specifying the local address to C to. This should be -an array of the form returned by C. - -This parameter takes precedence over the C, C, C and -C arguments. - -=item Family => INT - -The address family to pass to C (e.g. C, C). -Normally this will be left undefined, and C will search using any -address family supported by the system. - -=item Type => INT - -The socket type to pass to C (e.g. C, -C). Normally defined by the caller; if left undefined -C may attempt to infer the type from the service name. - -=item Proto => STRING or INT - -The IP protocol to use for the socket (e.g. C<'tcp'>, C, -C<'udp'>,C). Normally this will be left undefined, and either -C or the kernel will choose an appropriate value. May be given -either in string name or numeric form. - -=item Listen => INT - -If defined, puts the socket into listening mode where new connections can be -accepted using the C method. The value given is used as the -C queue size. - -=item ReuseAddr => BOOL - -If true, set the C sockopt - -=item ReusePort => BOOL - -If true, set the C sockopt (not all OSes implement this sockopt) - -=item Broadcast => BOOL - -If true, set the C sockopt - -=item Timeout - -This C-style argument is not currently supported. See the -C INCOMPATIBILITES section below. - -=item MultiHomed - -This C-style argument is not currently supported. See the -C INCOMPATIBILITES section below. However, the behaviour it -enables is always performed by C. - -=item Blocking => BOOL - -If defined but false, the socket will be set to non-blocking mode. Otherwise -it will default to blocking mode. See the NON-BLOCKING section below for more -detail. - -=back - -If neither C nor C hints are provided, a default of -C and C respectively will be set, to maintain -compatibility with C. - -If the constructor fails, it will set C<$@> to an appropriate error message; -this may be from C<$!> or it may be some other string; not every failure -necessarily has an associated C value. - -=head2 $sock = IO::Socket::IP->new( $peeraddr ) - -As a special case, if the constructor is passed a single argument (as -opposed to an even-sized list of key/value pairs), it is taken to be the value -of the C parameter. This is parsed in the same way, according to the -behaviour given in the C AND C PARSING section below. - -=cut - -sub new -{ - my $class = shift; - my %arg = (@_ == 1) ? (PeerHost => $_[0]) : @_; - return $class->SUPER::new(%arg); -} - -# IO::Socket may call this one; neaten up the arguments from IO::Socket::INET -# before calling our real _configure method -sub configure -{ - my $self = shift; - my ( $arg ) = @_; - - $arg->{PeerHost} = delete $arg->{PeerAddr} - if exists $arg->{PeerAddr} && !exists $arg->{PeerHost}; - - $arg->{PeerService} = delete $arg->{PeerPort} - if exists $arg->{PeerPort} && !exists $arg->{PeerService}; - - $arg->{LocalHost} = delete $arg->{LocalAddr} - if exists $arg->{LocalAddr} && !exists $arg->{LocalHost}; - - $arg->{LocalService} = delete $arg->{LocalPort} - if exists $arg->{LocalPort} && !exists $arg->{LocalService}; - - for my $type (qw(Peer Local)) { - my $host = $type . 'Host'; - my $service = $type . 'Service'; - - if (exists $arg->{$host} && !exists $arg->{$service}) { - local $_ = $arg->{$host}; - defined or next; - local ( $1, $2 ); # Placate a taint-related bug; [perl #67962] - if (/\A\[($IPv6_re)\](?::([^\s:]*))?\z/o || /\A([^\s:]*):([^\s:]*)\z/) { - $arg->{$host} = $1; - $arg->{$service} = $2 if defined $2 && length $2; - } - } - } - - $self->_configure( $arg ); -} - -sub _configure -{ - my $self = shift; - my ( $arg ) = @_; - - my %hints; - my @localinfos; - my @peerinfos; - - my @sockopts_enabled; - - $hints{flags} = $AI_ADDRCONFIG; - - if( defined $arg->{Family} ) { - my $family = delete $arg->{Family}; - $hints{family} = $family; - } - - if( defined $arg->{Type} ) { - my $type = delete $arg->{Type}; - $hints{socktype} = $type; - } - - if( defined $arg->{Proto} ) { - my $proto = delete $arg->{Proto}; - - unless( $proto =~ m/^\d+$/ ) { - my $protonum = getprotobyname( $proto ); - defined $protonum or croak "Unrecognised protocol $proto"; - $proto = $protonum; - } - - $hints{protocol} = $proto; - } - - # To maintain compatibilty with IO::Socket::INET, imply a default of - # SOCK_STREAM + IPPROTO_TCP if neither hint is given - if( !defined $hints{socktype} and !defined $hints{protocol} ) { - $hints{socktype} = SOCK_STREAM; - $hints{protocol} = IPPROTO_TCP; - } - - # Some OSes (NetBSD) don't seem to like just a protocol hint without a - # socktype hint as well. We'll set a couple of common ones - if( !defined $hints{socktype} and defined $hints{protocol} ) { - $hints{socktype} = SOCK_STREAM if $hints{protocol} == IPPROTO_TCP; - $hints{socktype} = SOCK_DGRAM if $hints{protocol} == IPPROTO_UDP; - } - - if( my $info = delete $arg->{LocalAddrInfo} ) { - @localinfos = @$info; - } - elsif( defined $arg->{LocalHost} or defined $arg->{LocalService} ) { - # Either may be undef - my $host = delete $arg->{LocalHost}; - my $service = delete $arg->{LocalService}; - - local $1; # Placate a taint-related bug; [perl #67962] - defined $service and $service =~ s/\((\d+)\)$// and - my $fallback_port = $1; - - my %localhints = %hints; - $localhints{flags} |= AI_PASSIVE; - ( my $err, @localinfos ) = getaddrinfo( $host, $service, \%localhints ); - - if( $err and defined $fallback_port ) { - ( $err, @localinfos ) = getaddrinfo( $host, $fallback_port, \%localhints ); - } - - $err and ( $@ = "$err", return ); - } - - if( my $info = delete $arg->{PeerAddrInfo} ) { - @peerinfos = @$info; - } - elsif( defined $arg->{PeerHost} or defined $arg->{PeerService} ) { - defined( my $host = delete $arg->{PeerHost} ) or - croak "Expected 'PeerHost'"; - defined( my $service = delete $arg->{PeerService} ) or - croak "Expected 'PeerService'"; - - local $1; # Placate a taint-related bug; [perl #67962] - defined $service and $service =~ s/\((\d+)\)$// and - my $fallback_port = $1; - - ( my $err, @peerinfos ) = getaddrinfo( $host, $service, \%hints ); - - if( $err and defined $fallback_port ) { - ( $err, @peerinfos ) = getaddrinfo( $host, $fallback_port, \%hints ); - } - - $err and ( $@ = "$err", return ); - } - - push @sockopts_enabled, SO_REUSEADDR if delete $arg->{ReuseAddr}; - push @sockopts_enabled, SO_REUSEPORT if delete $arg->{ReusePort}; - push @sockopts_enabled, SO_BROADCAST if delete $arg->{Broadcast}; - - my $listenqueue = delete $arg->{Listen}; - - croak "Cannot Listen with a PeerHost" if defined $listenqueue and @peerinfos; - - my $blocking = delete $arg->{Blocking}; - defined $blocking or $blocking = 1; - - keys %$arg and croak "Unexpected keys - " . join( ", ", sort keys %$arg ); - - my @infos; - foreach my $local ( @localinfos ? @localinfos : {} ) { - foreach my $peer ( @peerinfos ? @peerinfos : {} ) { - next if defined $local->{family} and defined $peer->{family} and - $local->{family} != $peer->{family}; - next if defined $local->{socktype} and defined $peer->{socktype} and - $local->{socktype} != $peer->{socktype}; - next if defined $local->{protocol} and defined $peer->{protocol} and - $local->{protocol} != $peer->{protocol}; - - my $family = $local->{family} || $peer->{family} or next; - my $socktype = $local->{socktype} || $peer->{socktype} or next; - my $protocol = $local->{protocol} || $peer->{protocol} || 0; - - push @infos, { - family => $family, - socktype => $socktype, - protocol => $protocol, - localaddr => $local->{addr}, - peeraddr => $peer->{addr}, - }; - } - } - - # In the nonblocking case, caller will be calling ->setup multiple times. - # Store configuration in the object for the ->setup method - # Yes, these are messy. Sorry, I can't help that... - - ${*$self}{io_socket_ip_infos} = \@infos; - - ${*$self}{io_socket_ip_idx} = -1; - - ${*$self}{io_socket_ip_sockopts} = \@sockopts_enabled; - ${*$self}{io_socket_ip_listenqueue} = $listenqueue; - ${*$self}{io_socket_ip_blocking} = $blocking; - - ${*$self}{io_socket_ip_errors} = [ undef, undef, undef ]; - - if( $blocking ) { - $self->setup or return undef; - } - return $self; -} - -sub setup -{ - my $self = shift; - - while(1) { - ${*$self}{io_socket_ip_idx}++; - last if ${*$self}{io_socket_ip_idx} >= @{ ${*$self}{io_socket_ip_infos} }; - - my $info = ${*$self}{io_socket_ip_infos}->[${*$self}{io_socket_ip_idx}]; - - $self->socket( @{$info}{qw( family socktype protocol )} ) or - ( ${*$self}{io_socket_ip_errors}[2] = $!, next ); - - $self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking}; - - foreach my $sockopt ( @{ ${*$self}{io_socket_ip_sockopts} } ) { - $self->setsockopt( SOL_SOCKET, $sockopt, pack "i", 1 ) or ( $@ = "$!", return undef ); - } - - if( defined( my $addr = $info->{localaddr} ) ) { - $self->bind( $addr ) or - ( ${*$self}{io_socket_ip_errors}[1] = $!, next ); - } - - if( defined( my $listenqueue = ${*$self}{io_socket_ip_listenqueue} ) ) { - $self->listen( $listenqueue ) or ( $@ = "$!", return undef ); - } - - if( defined( my $addr = $info->{peeraddr} ) ) { - # It seems that IO::Socket hides EINPROGRESS errors, making them look - # like a success. This is annoying here. - # Instead of putting up with its frankly-irritating intentional - # breakage of useful APIs I'm just going to end-run around it and - # call CORE::connect() directly - if( CORE::connect( $self, $addr ) ) { - $! = 0; - return 1; - } - - return 0 if $! == EINPROGRESS or HAVE_MSWIN32 && $! == Errno::EWOULDBLOCK(); - - ${*$self}{io_socket_ip_errors}[0] = $!; - next; - } - - return 1; - } - - $self->close; - - # Pick the most appropriate error, stringified - $! = ( grep defined, @{ ${*$self}{io_socket_ip_errors}} )[0]; - $@ = "$!"; - return undef; -} - -sub connect -{ - my $self = shift; - return $self->SUPER::connect( @_ ) if @_; - - $! = 0, return 1 if $self->fileno and defined $self->peername; - - if( $self->fileno ) { - # A connect has just failed, get its error value - ${*$self}{io_socket_ip_errors}[0] = $self->getsockopt( SOL_SOCKET, SO_ERROR ); - } - - return $self->setup; -} - -=head1 METHODS - -As well as the following methods, this class inherits all the methods in -L and L. - -=cut - -sub _get_host_service -{ - my $self = shift; - my ( $addr, $numeric ) = @_; - - my $flags = 0; - - $flags |= NI_DGRAM if $self->socktype == SOCK_DGRAM; - $flags |= NI_NUMERICHOST|NI_NUMERICSERV if $numeric; - - my ( $err, $host, $service ) = getnameinfo( $addr, $flags ); - croak "getnameinfo - $err" if $err; - - return ( $host, $service ); -} - -=head2 ( $host, $service ) = $sock->sockhost_service( $numeric ) - -Returns the hostname and service name of the local address (that is, the -socket address given by the C method). - -If C<$numeric> is true, these will be given in numeric form rather than being -resolved into names. - -The following four convenience wrappers may be used to obtain one of the two -values returned here. If both host and service names are required, this method -is preferable to the following wrappers, because it will call -C only once. - -=cut - -sub sockhost_service -{ - my $self = shift; - my ( $numeric ) = @_; - - $self->_get_host_service( $self->sockname, $numeric ); -} - -=head2 $addr = $sock->sockhost - -Return the numeric form of the local address - -=head2 $port = $sock->sockport - -Return the numeric form of the local port number - -=head2 $host = $sock->sockhostname - -Return the resolved name of the local address - -=head2 $service = $sock->sockservice - -Return the resolved name of the local port number - -=cut - -sub sockhost { ( shift->sockhost_service(1) )[0] } -sub sockport { ( shift->sockhost_service(1) )[1] } - -sub sockhostname { ( shift->sockhost_service(0) )[0] } -sub sockservice { ( shift->sockhost_service(0) )[1] } - -=head2 ( $host, $service ) = $sock->peerhost_service( $numeric ) - -Returns the hostname and service name of the peer address (that is, the -socket address given by the C method), similar to the -C method. - -The following four convenience wrappers may be used to obtain one of the two -values returned here. If both host and service names are required, this method -is preferable to the following wrappers, because it will call -C only once. - -=cut - -sub peerhost_service -{ - my $self = shift; - my ( $numeric ) = @_; - - $self->_get_host_service( $self->peername, $numeric ); -} - -=head2 $addr = $sock->peerhost - -Return the numeric form of the peer address - -=head2 $port = $sock->peerport - -Return the numeric form of the peer port number - -=head2 $host = $sock->peerhostname - -Return the resolved name of the peer address - -=head2 $service = $sock->peerservice - -Return the resolved name of the peer port number - -=cut - -sub peerhost { ( shift->peerhost_service(1) )[0] } -sub peerport { ( shift->peerhost_service(1) )[1] } - -sub peerhostname { ( shift->peerhost_service(0) )[0] } -sub peerservice { ( shift->peerhost_service(0) )[1] } - -# This unbelievably dodgy hack works around the bug that IO::Socket doesn't do -# it -# https://rt.cpan.org/Ticket/Display.html?id=61577 -sub accept -{ - my $self = shift; - my ( $new, $peer ) = $self->SUPER::accept or return; - - ${*$new}{$_} = ${*$self}{$_} for qw( io_socket_domain io_socket_type io_socket_proto ); - - return wantarray ? ( $new, $peer ) - : $new; -} - -# This second unbelievably dodgy hack guarantees that $self->fileno doesn't -# change, which is useful during nonblocking connect -sub socket -{ - my $self = shift; - return $self->SUPER::socket(@_) if not defined $self->fileno; - - # I hate core prototypes sometimes... - CORE::socket( my $tmph, $_[0], $_[1], $_[2] ) or return undef; - - dup2( $tmph->fileno, $self->fileno ) or die "Unable to dup2 $tmph onto $self - $!"; -} - -=head1 NON-BLOCKING - -If the constructor is passed a defined but false value for the C -argument then the socket is put into non-blocking mode. When in non-blocking -mode, the socket will not be set up by the time the constructor returns, -because the underlying C syscall would otherwise have to block. - -The non-blocking behaviour is an extension of the C API, -unique to C, because the former does not support multi-homed -non-blocking connect. - -When using non-blocking mode, the caller must repeatedly check for -writeability on the filehandle (for instance using C