diff options
author | Ricardo Signes <rjbs@cpan.org> | 2012-02-03 10:24:20 -0500 |
---|---|---|
committer | Ricardo Signes <rjbs@cpan.org> | 2012-02-03 10:24:20 -0500 |
commit | 790d3169bf82e566456367b233bbd0ca95d0a4af (patch) | |
tree | fd0ebb35200b9464b3a368c1952e9a45b868fb46 | |
parent | 7fcfdadc7c89351fe82d3ca4b913cf6773408225 (diff) | |
download | perl-790d3169bf82e566456367b233bbd0ca95d0a4af.tar.gz |
Revert "Add IO::Socket::IP 0.08 as dual-life module"
This reverts commit 497f7de2d964167330f7260590736e9adb18899c.
-rw-r--r-- | MANIFEST | 16 | ||||
-rwxr-xr-x | Porting/Maintainers.pl | 8 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/lib/IO/Socket/IP.pm | 826 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/00use.t | 6 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/01local-client-v4.t | 50 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/02local-server-v4.t | 54 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/03local-cross-v4.t | 36 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/04local-client-v6.t | 60 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/05local-server-v6.t | 62 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/06local-cross-v6.t | 41 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/10args.t | 52 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/11sockopts.t | 43 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/12port-fallback.t | 42 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/13addrinfo.t | 53 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/14fileno.t | 24 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/15io-socket.t | 34 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/20nonblocking-connect.t | 48 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/21nonblocking-connect-internet.t | 99 | ||||
-rw-r--r-- | pod/perldelta.pod | 5 | ||||
-rw-r--r-- | t/porting/known_pod_issues.dat | 1 |
20 files changed, 0 insertions, 1560 deletions
@@ -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<IO::Socket::IP> - A drop-in replacement for C<IO::Socket::INET> 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<IO::Socket::INET>. Most constructor arguments -and methods are provided in a backward-compatible way. For a list of known -differences, see the C<IO::Socket::INET> INCOMPATIBILITES section below. - -It uses the C<getaddrinfo(3)> 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<IO::Socket> DEFAULT BEHAVIOUR - -By placing C<-register> in the import list, C<IO::Socket> uses -C<IO::Socket::IP> rather than C<IO::Socket::INET> as the class that handles -C<PF_INET>. C<IO::Socket> will also use C<IO::Socket::IP> rather than -C<IO::Socket::INET6> to handle C<PF_INET6>, provided that the C<AF_INET6> -constant is available. - -Changing C<IO::Socket>'s default behaviour means that calling the -C<IO::Socket> constructor with either C<PF_INET> or C<PF_INET6> as the -C<Domain> parameter will yield an C<IO::Socket::IP> 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<IO::Socket::IP> 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<connect()> 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<IO::Socket::INET>, these are accepted as synonyms for C<PeerHost> and -C<PeerService> respectively. - -=item PeerAddrInfo => ARRAY - -Alternate form of specifying the peer to C<connect()> to. This should be an -array of the form returned by C<Socket::getaddrinfo>. - -This parameter takes precedence over the C<Peer*>, C<Family>, C<Type> and -C<Proto> arguments. - -=item LocalHost => STRING - -=item LocalService => STRING - -Hostname and service name for the local address to C<bind()> to. - -=item LocalAddr => STRING - -=item LocalPort => STRING - -For symmetry with the accessor methods and compatibility with -C<IO::Socket::INET>, these are accepted as synonyms for C<LocalHost> and -C<LocalService> respectively. - -=item LocalAddrInfo => ARRAY - -Alternate form of specifying the local address to C<bind()> to. This should be -an array of the form returned by C<Socket::getaddrinfo>. - -This parameter takes precedence over the C<Local*>, C<Family>, C<Type> and -C<Proto> arguments. - -=item Family => INT - -The address family to pass to C<getaddrinfo> (e.g. C<AF_INET>, C<AF_INET6>). -Normally this will be left undefined, and C<getaddrinfo> will search using any -address family supported by the system. - -=item Type => INT - -The socket type to pass to C<getaddrinfo> (e.g. C<SOCK_STREAM>, -C<SOCK_DGRAM>). Normally defined by the caller; if left undefined -C<getaddrinfo> 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<IPPROTO_TCP>, -C<'udp'>,C<IPPROTO_UDP>). Normally this will be left undefined, and either -C<getaddrinfo> 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<accept> method. The value given is used as the -C<listen(2)> queue size. - -=item ReuseAddr => BOOL - -If true, set the C<SO_REUSEADDR> sockopt - -=item ReusePort => BOOL - -If true, set the C<SO_REUSEPORT> sockopt (not all OSes implement this sockopt) - -=item Broadcast => BOOL - -If true, set the C<SO_BROADCAST> sockopt - -=item Timeout - -This C<IO::Socket::INET>-style argument is not currently supported. See the -C<IO::Socket::INET> INCOMPATIBILITES section below. - -=item MultiHomed - -This C<IO::Socket::INET>-style argument is not currently supported. See the -C<IO::Socket::INET> INCOMPATIBILITES section below. However, the behaviour it -enables is always performed by C<IO::Socket::IP>. - -=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<Type> nor C<Proto> hints are provided, a default of -C<SOCK_STREAM> and C<IPPROTO_TCP> respectively will be set, to maintain -compatibility with C<IO::Socket::INET>. - -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<errno> 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<PeerAddr> parameter. This is parsed in the same way, according to the -behaviour given in the C<PeerHost> AND C<LocalHost> 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<IO::Socket> and L<IO::Handle>. - -=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<sockname> 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<getnameinfo(3)> 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<peername> method), similar to the -C<sockhost_service> 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<getnameinfo(3)> 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<Blocking> -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<connect(2)> syscall would otherwise have to block. - -The non-blocking behaviour is an extension of the C<IO::Socket::INET> API, -unique to C<IO::Socket::IP>, 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<select> or C<IO::Poll>). -Each time the filehandle is ready to write, the C<connect> method must be -called, with no arguments. Note that some operating systems, most notably -C<MSWin32> do not report a C<connect()> failure using write-ready; so you must -also C<select()> for exceptional status. - -While C<connect> returns false, the value of C<$!> indicates whether it should -be tried again (by being set to the value C<EINPROGRESS>, or C<EWOULDBLOCK> on -MSWin32), or whether a permanent error has occurred (e.g. C<ECONNREFUSED>). - -Once the socket has been connected to the peer, C<connect> will return true -and the socket will now be ready to use. - -Note that calls to the platform's underlying C<getaddrinfo(3)> function may -block. If C<IO::Socket::IP> has to perform this lookup, the constructor will -block even when in non-blocking mode. - -To avoid this blocking behaviour, the caller should pass in the result of such -a lookup using the C<PeerAddrInfo> or C<LocalAddrInfo> arguments. This can be -achieved by using L<Net::LibAsyncNS>, or the C<getaddrinfo(3)> function can be -called in a child process. - - use IO::Socket::IP; - use Errno qw( EINPROGRESS EWOULDBLOCK ); - - my @peeraddrinfo = ... # Caller must obtain the getaddinfo result here - - my $socket = IO::Socket::IP->new( - PeerAddrInfo => \@peeraddrinfo, - Blocking => 0, - ) or die "Cannot construct socket - $@"; - - while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) { - my $wvec = ''; - vec( $wvec, fileno $socket, 1 ) = 1; - my $evec = ''; - vec( $evec, fileno $socket, 1 ) = 1; - - select( undef, $wvec, $evec, undef ) or die "Cannot select - $!"; - } - - die "Cannot connect - $!" if $!; - - ... - -The example above uses C<select()>, but any similar mechanism should work -analogously. C<IO::Socket::IP> takes care when creating new socket filehandles -to preserve the actual file descriptor number, so such techniques as C<poll> -or C<epoll> should be transparent to its reallocation of a different socket -underneath, perhaps in order to switch protocol family between C<PF_INET> and -C<PF_INET6>. - -For another example using C<IO::Poll> and C<Net::LibAsyncNS>, see the -F<examples/nonblocking_libasyncns.pl> file in the module distribution. - -=head1 C<PeerHost> AND C<LocalHost> PARSING - -To support the C<IO::Socket::INET> API, the host and port information may be -passed in a single string rather than as two separate arguments. - -If either C<LocalHost> or C<PeerHost> (or their C<...Addr> synonyms) have any -of the following special forms, and C<LocalService> or C<PeerService> (or -their C<...Port> synonyms) are absent, special parsing is applied. - -The value of the C<...Host> argument will be split to give both the hostname -and port (or service name): - - hostname.example.org:http # Host name - 192.0.2.1:80 # IPv4 address - [2001:db8::1]:80 # IPv6 address - -In each case, the port or service name (e.g. C<80>) is passed as the -C<LocalService> or C<PeerService> argument. - -Either of C<LocalService> or C<PeerService> (or their C<...Port> synonyms) can -be either a service name, a decimal number, or a string containing both a -service name and number, in a form such as - - http(80) - -In this case, the name (C<http>) will be tried first, but if the resolver does -not understand it then the port number (C<80>) will be used instead. - -=head1 C<IO::Socket::INET> INCOMPATIBILITES - -=over 4 - -=item * - -The C<Timeout> and C<MultiHomed> constructor arguments are currently not -recognised. - -The behaviour enabled by C<MultiHomed> is in fact implemented by -C<IO::Socket::IP> as it is required to correctly support searching for a -useable address from the results of the C<getaddrinfo(3)> call. - -=back - -=cut - -=head1 TODO - -=over 4 - -=item * - -Cache the returns from C<sockhost_service> and C<peerhost_service> to avoid -double-lookup overhead in such code as - - printf "Peer is %s:%d\n", $sock->peerhost, $sock->peerport; - -=item * - -Investigate whether C<POSIX::dup2> upsets BSD's C<kqueue> watchers, and if so, -consider what possible workarounds might be applied. - -=back - -=head1 BUGS - -=over 4 - -=item * - -Nonblocking connect fails unit tests on MSWin32 smoke-testing machines. The -specifics of the failure are that C<connect()> seems to block anyway despite -being asked not to, and that failure to connect is not detected properly. I am -as yet unsure why this is. - -Blocking connect on MSWin32, and both blocking and nonblocking connect on -other platforms, all test OK on smoke testing. - -=back - -=head1 AUTHOR - -Paul Evans <leonerd@leonerd.org.uk> - -=cut - -0x55AA; diff --git a/cpan/IO-Socket-IP/t/00use.t b/cpan/IO-Socket-IP/t/00use.t deleted file mode 100644 index 5cb6310503..0000000000 --- a/cpan/IO-Socket-IP/t/00use.t +++ /dev/null @@ -1,6 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 1; - -use_ok( "IO::Socket::IP" ); diff --git a/cpan/IO-Socket-IP/t/01local-client-v4.t b/cpan/IO-Socket-IP/t/01local-client-v4.t deleted file mode 100644 index 7e9980c8d7..0000000000 --- a/cpan/IO-Socket-IP/t/01local-client-v4.t +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 16; - -use IO::Socket::IP; - -use IO::Socket::INET; -use Socket qw( unpack_sockaddr_in ); - -foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { - my $testserver = IO::Socket::INET->new( - ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), - LocalHost => "127.0.0.1", - Type => Socket->$socktype, - Proto => ( $socktype eq "SOCK_STREAM" ? "tcp" : "udp" ), # Because IO::Socket::INET is stupid and always presumes tcp - ) or die "Cannot listen on PF_INET - $@"; - - my $socket = IO::Socket::IP->new( - PeerHost => "127.0.0.1", - PeerService => $testserver->sockport, - Type => Socket->$socktype, - ); - - ok( defined $socket, "IO::Socket::IP->new constructs a $socktype socket" ) or - diag( " error was $@" ); - - is( $socket->sockdomain, AF_INET, "\$socket->sockdomain for $socktype" ); - is( $socket->socktype, Socket->$socktype, "\$socket->socktype for $socktype" ); - - my $testclient = ( $socktype eq "SOCK_STREAM" ) ? - $testserver->accept : - do { $testserver->connect( $socket->sockname ); $testserver }; - - ok( defined $testclient, "accepted test $socktype client" ); - - is_deeply( [ unpack_sockaddr_in $socket->sockname ], - [ unpack_sockaddr_in $testclient->peername ], - "\$socket->sockname for $socktype" ); - - is_deeply( [ unpack_sockaddr_in $socket->peername ], - [ unpack_sockaddr_in $testclient->sockname ], - "\$socket->peername for $socktype" ); - - is( $socket->peerhost, "127.0.0.1", "\$socket->peerhost for $socktype" ); - is( $socket->peerport, $testserver->sockport, "\$socket->peerport for $socktype" ); - - # Can't easily test the non-numeric versions without relying on the system's - # ability to resolve the name "localhost" -} diff --git a/cpan/IO-Socket-IP/t/02local-server-v4.t b/cpan/IO-Socket-IP/t/02local-server-v4.t deleted file mode 100644 index 2a0d1310cc..0000000000 --- a/cpan/IO-Socket-IP/t/02local-server-v4.t +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 26; - -use IO::Socket::IP; - -use IO::Socket::INET; -use Socket qw( unpack_sockaddr_in ); - -foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { - my $testserver = IO::Socket::IP->new( - ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), - LocalHost => "127.0.0.1", - Type => Socket->$socktype, - ); - - ok( defined $testserver, "IO::Socket::IP->new constructs a $socktype socket" ) or - diag( " error was $@" ); - - is( $testserver->sockdomain, AF_INET, "\$testserver->sockdomain for $socktype" ); - is( $testserver->socktype, Socket->$socktype, "\$testserver->socktype for $socktype" ); - - is( $testserver->sockhost, "127.0.0.1", "\$testserver->sockhost for $socktype" ); - like( $testserver->sockport, qr/^\d+$/, "\$testserver->sockport for $socktype" ); - - my $socket = IO::Socket::INET->new( - PeerHost => "127.0.0.1", - PeerPort => $testserver->sockport, - Type => Socket->$socktype, - Proto => ( $socktype eq "SOCK_STREAM" ? "tcp" : "udp" ), # Because IO::Socket::INET is stupid and always presumes tcp - ) or die "Cannot connect to PF_INET - $@"; - - my $testclient = ( $socktype eq "SOCK_STREAM" ) ? - $testserver->accept : - do { $testserver->connect( $socket->sockname ); $testserver }; - - ok( defined $testclient, "accepted test $socktype client" ); - isa_ok( $testclient, "IO::Socket::IP", "\$testclient for $socktype" ); - - is( $testclient->sockdomain, AF_INET, "\$testclient->sockdomain for $socktype" ); - is( $testclient->socktype, Socket->$socktype, "\$testclient->socktype for $socktype" ); - - is_deeply( [ unpack_sockaddr_in $socket->sockname ], - [ unpack_sockaddr_in $testclient->peername ], - "\$socket->sockname for $socktype" ); - - is_deeply( [ unpack_sockaddr_in $socket->peername ], - [ unpack_sockaddr_in $testclient->sockname ], - "\$socket->peername for $socktype" ); - - is( $testclient->sockport, $socket->peerport, "\$testclient->sockport for $socktype" ); - is( $testclient->peerport, $socket->sockport, "\$testclient->peerport for $socktype" ); -} diff --git a/cpan/IO-Socket-IP/t/03local-cross-v4.t b/cpan/IO-Socket-IP/t/03local-cross-v4.t deleted file mode 100644 index 5eacd1dd04..0000000000 --- a/cpan/IO-Socket-IP/t/03local-cross-v4.t +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 12; - -use IO::Socket::IP; - -foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { - my $testserver = IO::Socket::IP->new( - ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), - LocalHost => "127.0.0.1", - Type => Socket->$socktype, - ) or die "Cannot listen on PF_INET - $@"; - - my $socket = IO::Socket::IP->new( - PeerHost => "127.0.0.1", - PeerService => $testserver->sockport, - Type => Socket->$socktype, - ) or die "Cannot connect on PF_INET - $@"; - - my $testclient = ( $socktype eq "SOCK_STREAM" ) ? - $testserver->accept : - do { $testserver->connect( $socket->sockname ); $testserver }; - - is( $testclient->sockport, $socket->peerport, "\$testclient->sockport for $socktype" ); - is( $testclient->peerport, $socket->sockport, "\$testclient->peerport for $socktype" ); - - is( $testclient->sockhost, $socket->peerhost, "\$testclient->sockhost for $socktype" ); - is( $testclient->peerhost, $socket->sockhost, "\$testclient->peerhost for $socktype" ); - - $socket->write( "Request\n" ); - is( $testclient->getline, "Request\n", "\$socket to \$testclient for $socktype" ); - - $testclient->write( "Response\n" ); - is( $socket->getline, "Response\n", "\$testclient to \$socket for $socktype" ); -} diff --git a/cpan/IO-Socket-IP/t/04local-client-v6.t b/cpan/IO-Socket-IP/t/04local-client-v6.t deleted file mode 100644 index 575cb30969..0000000000 --- a/cpan/IO-Socket-IP/t/04local-client-v6.t +++ /dev/null @@ -1,60 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More; - -use IO::Socket::IP; -use Socket; - -my $AF_INET6 = eval { require Socket and Socket::AF_INET6() } or - plan skip_all => "No AF_INET6"; - -eval { IO::Socket::IP->new( LocalHost => "::1" ) } or - plan skip_all => "Unable to bind to ::1"; - -plan tests => 16; - -foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { - my $testserver = IO::Socket->new; - $testserver->socket( $AF_INET6, Socket->$socktype, 0 ) - or die "Cannot socket() - $!"; - $testserver->bind( Socket::pack_sockaddr_in6( 0, Socket::inet_pton( $AF_INET6, "::1" ) ) ) or - die "Cannot bind() - $!"; - if( $socktype eq "SOCK_STREAM" ) { - $testserver->listen( 1 ) or die "Cannot listen() - $!"; - } - - my $testport = ( Socket::unpack_sockaddr_in6 $testserver->sockname )[0]; - - my $socket = IO::Socket::IP->new( - PeerHost => "::1", - PeerService => $testport, - Type => Socket->$socktype, - ); - - ok( defined $socket, "IO::Socket::IP->new constructs a $socktype socket" ) or - diag( " error was $@" ); - - is( $socket->sockdomain, $AF_INET6, "\$socket->sockdomain for $socktype" ); - is( $socket->socktype, Socket->$socktype, "\$socket->socktype for $socktype" ); - - my $testclient = ( $socktype eq "SOCK_STREAM" ) ? - $testserver->accept : - do { $testserver->connect( $socket->sockname ); $testserver }; - - ok( defined $testclient, "accepted test $socktype client" ); - - is_deeply( [ Socket::unpack_sockaddr_in6( $socket->sockname ) ], - [ Socket::unpack_sockaddr_in6( $testclient->peername ) ], - "\$socket->sockname for $socktype" ); - - is_deeply( [ Socket::unpack_sockaddr_in6( $socket->peername ) ], - [ Socket::unpack_sockaddr_in6( $testclient->sockname ) ], - "\$socket->peername for $socktype" ); - - is( $socket->peerhost, "::1", "\$socket->peerhost for $socktype" ); - is( $socket->peerport, $testport, "\$socket->peerport for $socktype" ); - - # Can't easily test the non-numeric versions without relying on the system's - # ability to resolve the name "localhost" -} diff --git a/cpan/IO-Socket-IP/t/05local-server-v6.t b/cpan/IO-Socket-IP/t/05local-server-v6.t deleted file mode 100644 index 46777b3e11..0000000000 --- a/cpan/IO-Socket-IP/t/05local-server-v6.t +++ /dev/null @@ -1,62 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More; - -use IO::Socket::IP; -use Socket; - -my $AF_INET6 = eval { require Socket and Socket::AF_INET6() } or - plan skip_all => "No AF_INET6"; - -eval { IO::Socket::IP->new( LocalHost => "::1" ) } or - plan skip_all => "Unable to bind to ::1"; - -plan tests => 26; - -foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { - my $testserver = IO::Socket::IP->new( - ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), - LocalHost => "::1", - Type => Socket->$socktype, - ); - - ok( defined $testserver, "IO::Socket::IP->new constructs a $socktype socket" ) or - diag( " error was $@" ); - - is( $testserver->sockdomain, $AF_INET6, "\$testserver->sockdomain for $socktype" ); - is( $testserver->socktype, Socket->$socktype, "\$testserver->socktype for $socktype" ); - - is( $testserver->sockhost, "::1", "\$testserver->sockhost for $socktype" ); - like( $testserver->sockport, qr/^\d+$/, "\$testserver->sockport for $socktype" ); - - my $socket = IO::Socket->new; - $socket->socket( $AF_INET6, Socket->$socktype, 0 ) - or die "Cannot socket() - $!"; - $socket->connect( Socket::pack_sockaddr_in6( $testserver->sockport, Socket::inet_pton( $AF_INET6, "::1" ) ) ) - or die "Cannot connect() - $!"; - - my $testclient = ( $socktype eq "SOCK_STREAM" ) ? - $testserver->accept : - do { $testserver->connect( $socket->sockname ); $testserver }; - - ok( defined $testclient, "accepted test $socktype client" ); - isa_ok( $testclient, "IO::Socket::IP", "\$testclient for $socktype" ); - - is( $testclient->sockdomain, $AF_INET6, "\$testclient->sockdomain for $socktype" ); - is( $testclient->socktype, Socket->$socktype, "\$testclient->socktype for $socktype" ); - - is_deeply( [ Socket::unpack_sockaddr_in6( $socket->sockname ) ], - [ Socket::unpack_sockaddr_in6( $testclient->peername ) ], - "\$socket->sockname for $socktype" ); - - is_deeply( [ Socket::unpack_sockaddr_in6( $socket->peername ) ], - [ Socket::unpack_sockaddr_in6( $testclient->sockname ) ], - "\$socket->peername for $socktype" ); - - my $peerport = ( Socket::unpack_sockaddr_in6 $socket->peername )[0]; - my $sockport = ( Socket::unpack_sockaddr_in6 $socket->sockname )[0]; - - is( $testclient->sockport, $peerport, "\$testclient->sockport for $socktype" ); - is( $testclient->peerport, $sockport, "\$testclient->peerport for $socktype" ); -} diff --git a/cpan/IO-Socket-IP/t/06local-cross-v6.t b/cpan/IO-Socket-IP/t/06local-cross-v6.t deleted file mode 100644 index 9cd1e94a3f..0000000000 --- a/cpan/IO-Socket-IP/t/06local-cross-v6.t +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More; - -use IO::Socket::IP; - -eval { IO::Socket::IP->new( LocalHost => "::1" ) } or - plan skip_all => "Unable to bind to ::1"; - -plan tests => 12; - -foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { - my $testserver = IO::Socket::IP->new( - ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), - LocalHost => "::1", - Type => Socket->$socktype, - ) or die "Cannot listen on PF_INET6 - $@"; - - my $socket = IO::Socket::IP->new( - PeerHost => "::1", - PeerService => $testserver->sockport, - Type => Socket->$socktype, - ) or die "Cannot connect on PF_INET6 - $@"; - - my $testclient = ( $socktype eq "SOCK_STREAM" ) ? - $testserver->accept : - do { $testserver->connect( $socket->sockname ); $testserver }; - - is( $testclient->sockport, $socket->peerport, "\$testclient->sockport for $socktype" ); - is( $testclient->peerport, $socket->sockport, "\$testclient->peerport for $socktype" ); - - is( $testclient->sockhost, $socket->peerhost, "\$testclient->sockhost for $socktype" ); - is( $testclient->peerhost, $socket->sockhost, "\$testclient->peerhost for $socktype" ); - - $socket->write( "Request\n" ); - is( $testclient->getline, "Request\n", "\$socket to \$testclient for $socktype" ); - - $testclient->write( "Response\n" ); - is( $socket->getline, "Response\n", "\$testclient to \$socket for $socktype" ); -} diff --git a/cpan/IO-Socket-IP/t/10args.t b/cpan/IO-Socket-IP/t/10args.t deleted file mode 100644 index 75a5ca0e4d..0000000000 --- a/cpan/IO-Socket-IP/t/10args.t +++ /dev/null @@ -1,52 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More; - -use IO::Socket::IP; - -sub arguments_is { - my ($arg, $exp, $name) = @_; - - $arg = [$arg] - unless ref $arg; - - $name ||= join ' ', map { defined $_ ? $_ : 'undef' } @$arg; - - my $got = do { - no warnings 'redefine'; - my $args; - - local *IO::Socket::IP::_configure = sub { - $args = $_[1]; - return $_[0]; - }; - - IO::Socket::IP->new(@$arg); - - $args; - }; - - is_deeply($got, $exp, $name); -} - -my @tests = ( - [ [ '[::1]:80' ], { PeerHost => '::1', PeerService => '80' } ], - [ [ '[::1]:http' ], { PeerHost => '::1', PeerService => 'http' } ], - [ [ '[::1]' ], { PeerHost => '::1', } ], - [ [ '[::1]:' ], { PeerHost => '::1', } ], - [ [ '127.0.0.1:80' ], { PeerHost => '127.0.0.1', PeerService => '80' } ], - [ [ '127.0.0.1:http' ], { PeerHost => '127.0.0.1', PeerService => 'http' } ], - [ [ '127.0.0.1' ], { PeerHost => '127.0.0.1', } ], - [ [ '127.0.0.1:' ], { PeerHost => '127.0.0.1', } ], - [ [ 'localhost:80' ], { PeerHost => 'localhost', PeerService => '80' } ], - [ [ 'localhost:http' ], { PeerHost => 'localhost', PeerService => 'http' } ], - [ [ PeerHost => '[::1]:80' ], { PeerHost => '::1', PeerService => '80' } ], - [ [ PeerHost => '[::1]' ], { PeerHost => '::1' } ], - [ [ LocalHost => '[::1]:80' ], { LocalHost => '::1', LocalService => '80' } ], - [ [ LocalHost => undef ], { LocalHost => undef } ], -); - -plan tests => scalar(@tests); - -arguments_is(@$_) for @tests; diff --git a/cpan/IO-Socket-IP/t/11sockopts.t b/cpan/IO-Socket-IP/t/11sockopts.t deleted file mode 100644 index a0828c2b73..0000000000 --- a/cpan/IO-Socket-IP/t/11sockopts.t +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 3; - -use IO::Socket::IP; - -use Socket qw( SOL_SOCKET SO_REUSEADDR SO_REUSEPORT SO_BROADCAST ); - -{ - my $sock = IO::Socket::IP->new( - LocalHost => "127.0.0.1", - Type => SOCK_STREAM, - Listen => 1, - ReuseAddr => 1, - ) or die "Cannot socket() - $@"; - - ok( $sock->getsockopt( SOL_SOCKET, SO_REUSEADDR ), 'SO_REUSEADDR set' ); -} - -SKIP: { - # Some OSes don't implement SO_REUSEPORT - skip "No SO_REUSEPORT", 1 unless defined eval { SO_REUSEPORT }; - - my $sock = IO::Socket::IP->new( - LocalHost => "127.0.0.1", - Type => SOCK_STREAM, - Listen => 1, - ReusePort => 1, - ) or die "Cannot socket() - $@"; - - ok( $sock->getsockopt( SOL_SOCKET, SO_REUSEPORT ), 'SO_REUSEPORT set' ); -} - -{ - my $sock = IO::Socket::IP->new( - LocalHost => "127.0.0.1", - Type => SOCK_DGRAM, - Broadcast => 1, - ) or die "Cannot socket() - $@"; - - ok( $sock->getsockopt( SOL_SOCKET, SO_BROADCAST ), 'SO_BROADCAST set' ); -} diff --git a/cpan/IO-Socket-IP/t/12port-fallback.t b/cpan/IO-Socket-IP/t/12port-fallback.t deleted file mode 100644 index 732d20eea1..0000000000 --- a/cpan/IO-Socket-IP/t/12port-fallback.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 1; - -use IO::Socket::IP; -use Socket 1.95 qw( - PF_INET SOCK_STREAM IPPROTO_TCP pack_sockaddr_in INADDR_ANY - AI_PASSIVE -); - -my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0; - -my @gai_args; -my @gai_rets; - -no strict 'refs'; -no warnings 'redefine'; - -*{"IO::Socket::IP::getaddrinfo"} = sub { - push @gai_args, [ @_ ]; - return @{ shift @gai_rets }; -}; - -@gai_rets = ( - [ "Service unknown" ], - [ "", { - family => PF_INET, - socktype => SOCK_STREAM, - protocol => IPPROTO_TCP, - addr => pack_sockaddr_in( 80, INADDR_ANY ) - } ], -); - -IO::Socket::IP->new( LocalPort => "zyxxyblarg(80)" ); - -is_deeply( \@gai_args, - [ - [ undef, "zyxxyblarg", { flags => AI_PASSIVE|$AI_ADDRCONFIG, socktype => SOCK_STREAM, protocol => IPPROTO_TCP } ], - [ undef, "80", { flags => AI_PASSIVE|$AI_ADDRCONFIG, socktype => SOCK_STREAM, protocol => IPPROTO_TCP } ], - ], - '@gai_args for LocalPort => "zyxxyblarg(80)"' ); diff --git a/cpan/IO-Socket-IP/t/13addrinfo.t b/cpan/IO-Socket-IP/t/13addrinfo.t deleted file mode 100644 index b293101f1b..0000000000 --- a/cpan/IO-Socket-IP/t/13addrinfo.t +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 4; - -use IO::Socket::IP; - -use IO::Socket::INET; -use Socket qw( SOCK_STREAM unpack_sockaddr_in getaddrinfo ); - -{ - my $testserver = IO::Socket::INET->new( - Listen => 1, - LocalHost => "127.0.0.1", - Type => SOCK_STREAM, - ) or die "Cannot listen on PF_INET - $@"; - - my ( $err, @peeraddrinfo ) = getaddrinfo( "127.0.0.1", $testserver->sockport, { socktype => SOCK_STREAM } ); - $err and die "Cannot getaddrinfo 127.0.0.1 - $err"; - - my $socket = IO::Socket::IP->new( - PeerAddrInfo => \@peeraddrinfo, - ); - - ok( defined $socket, 'IO::Socket::IP->new( PeerAddrInfo => ... ) constructs a new socket' ) or - diag( " error was $@" ); - - is_deeply( [ unpack_sockaddr_in $socket->peername ], - [ unpack_sockaddr_in $testserver->sockname ], - '$socket->peername' ); -} - -{ - my ( $err, @localaddrinfo ) = getaddrinfo( "127.0.0.1", 0, { socktype => SOCK_STREAM } ); - $err and die "Cannot getaddrinfo 127.0.0.1 - $err"; - - my $socket = IO::Socket::IP->new( - Listen => 1, - LocalAddrInfo => \@localaddrinfo, - ); - - ok( defined $socket, 'IO::Socket::IP->new( LocalAddrInfo => ... ) constructs a new socket' ) or - diag( " error was $@" ); - - my $testclient = IO::Socket::INET->new( - PeerHost => "127.0.0.1", - PeerPort => $socket->sockport, - ) or die "Cannot connect to localhost - $@"; - - is_deeply( [ unpack_sockaddr_in $socket->sockname ], - [ unpack_sockaddr_in $testclient->peername ], - '$socket->sockname' ); -} diff --git a/cpan/IO-Socket-IP/t/14fileno.t b/cpan/IO-Socket-IP/t/14fileno.t deleted file mode 100644 index cc3f895a66..0000000000 --- a/cpan/IO-Socket-IP/t/14fileno.t +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 2; - -use IO::Socket::IP; -use Socket qw( AF_INET SOCK_STREAM ); - -socket( my $tmph, AF_INET, SOCK_STREAM, 0 ) or die "Cannot socket() - $!"; - -my $socket = IO::Socket::IP->new or die "Cannot create IO::Socket::IP - $@"; - -$socket->socket( AF_INET, SOCK_STREAM, 0 ) or die "Cannot socket() - $!"; -my $fileno = $socket->fileno; - -$socket->socket( AF_INET, SOCK_STREAM, 0 ) or die "Cannot socket() - $!"; - -is( $socket->fileno, $fileno, '$socket->fileno preserved after ->socket' ); - -close $tmph; - -$socket->socket( AF_INET, SOCK_STREAM, 0 ) or die "Cannot socket() - $!"; - -is( $socket->fileno, $fileno, '$socket->fileno preserved after ->socket with free handle' ); diff --git a/cpan/IO-Socket-IP/t/15io-socket.t b/cpan/IO-Socket-IP/t/15io-socket.t deleted file mode 100644 index e8cecda3af..0000000000 --- a/cpan/IO-Socket-IP/t/15io-socket.t +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 2; - -use IO::Socket; -use IO::Socket::IP -register; - -my $sock = IO::Socket->new( - Domain => AF_INET, - Type => SOCK_STREAM, - LocalHost => "127.0.0.1", - LocalPort => 0, -); - -isa_ok( $sock, "IO::Socket::IP", 'IO::Socket->new( Domain => AF_INET )' ); - -SKIP: { - my $AF_INET6 = eval { Socket::AF_INET6() } || - eval { require Socket6; Socket6::AF_INET6() }; - $AF_INET6 or skip "No AF_INET6", 1; - eval { IO::Socket::IP->new( LocalHost => "::1" ) } or - skip "Unable to bind to ::1", 1; - - my $sock = IO::Socket->new( - Domain => $AF_INET6, - Type => SOCK_STREAM, - LocalHost => "::1", - LocalPort => 0, - ); - - isa_ok( $sock, "IO::Socket::IP", 'IO::Socket->new( Domain => AF_INET6 )' ) or - diag( " error was $@" ); -} diff --git a/cpan/IO-Socket-IP/t/20nonblocking-connect.t b/cpan/IO-Socket-IP/t/20nonblocking-connect.t deleted file mode 100644 index 2566c06269..0000000000 --- a/cpan/IO-Socket-IP/t/20nonblocking-connect.t +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 8; - -use IO::Socket::IP; - -use IO::Socket::INET; -use Errno qw( EINPROGRESS EWOULDBLOCK ); - -my $testserver = IO::Socket::INET->new( - Listen => 1, - LocalHost => "127.0.0.1", - Type => SOCK_STREAM, -) or die "Cannot listen on PF_INET - $@"; - -my $socket = IO::Socket::IP->new( - PeerHost => "127.0.0.1", - PeerService => $testserver->sockport, - Type => SOCK_STREAM, - Blocking => 0, -); - -ok( defined $socket, 'IO::Socket::IP->new( Blocking => 0 ) constructs a socket' ) or - diag( " error was $@" ); - -while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) { - my $wvec = ''; - vec( $wvec, fileno $socket, 1 ) = 1; - my $evec = ''; - vec( $evec, fileno $socket, 1 ) = 1; - - select( undef, $wvec, $evec, undef ) or die "Cannot select() - $!"; -} - -ok( !$!, 'Repeated ->connect eventually succeeds' ); - -is( $socket->sockdomain, AF_INET, '$socket->sockdomain' ); -is( $socket->socktype, SOCK_STREAM, '$socket->socktype' ); - -is_deeply( [ unpack_sockaddr_in $socket->peername ], - [ unpack_sockaddr_in $testserver->sockname ], - '$socket->peername' ); - -is( $socket->peerhost, "127.0.0.1", '$socket->peerhost' ); -is( $socket->peerport, $testserver->sockport, '$socket->peerport' ); - -ok( !$socket->blocking, '$socket->blocking' ); diff --git a/cpan/IO-Socket-IP/t/21nonblocking-connect-internet.t b/cpan/IO-Socket-IP/t/21nonblocking-connect-internet.t deleted file mode 100644 index e946221dfe..0000000000 --- a/cpan/IO-Socket-IP/t/21nonblocking-connect-internet.t +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use Test::More tests => 10; - -use IO::Socket::IP; - -use IO::Socket::INET; -use Errno qw( EINPROGRESS EWOULDBLOCK ECONNREFUSED ); - -# Chris Williams (BINGOS) has offered cpanidx.org as a TCP testing server here -my $test_host = "cpanidx.org"; -my $test_good_port = 80; -my $test_bad_port = 6666; - -SKIP: { - IO::Socket::INET->new( - PeerHost => $test_host, - PeerPort => $test_good_port, - Type => SOCK_STREAM, - ) or skip "Can't connect to $test_host:$test_good_port", 5; - - my $socket = IO::Socket::IP->new( - PeerHost => $test_host, - PeerService => $test_good_port, - Type => SOCK_STREAM, - Blocking => 0, - ); - - ok( defined $socket, "defined \$socket for $test_host:$test_good_port" ) or - diag( " error was $@" ); - - # This and test is required to placate a warning IO::Socket would otherwise - # throw; https://rt.cpan.org/Ticket/Display.html?id=63052 - ok( not( $socket->opened and $socket->connected ), '$socket not yet connected' ); - - my $selectcount = 0; - - while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) { - my $wvec = ''; - vec( $wvec, fileno $socket, 1 ) = 1; - my $evec = ''; - vec( $evec, fileno $socket, 1 ) = 1; - - $selectcount++; - my $ret = select( undef, $wvec, $evec, 60 ); - defined $ret or die "Cannot select() - $!"; - $ret or die "select() timed out"; - } - - ok( !$!, '->connect eventually succeeds' ); - ok( $selectcount > 0, '->connect had to select() at least once' ); - - ok( $socket->connected, '$socket now connected' ); -} - -SKIP: { - IO::Socket::INET->new( - PeerHost => $test_host, - PeerPort => $test_bad_port, - Type => SOCK_STREAM, - ) and skip "Connecting to $test_host:$test_bad_port succeeds", 5; - $! == ECONNREFUSED or skip "Connecting to $test_host:$test_bad_port doesn't give ECONNREFUSED", 5; - - my $socket = IO::Socket::IP->new( - PeerHost => $test_host, - PeerService => $test_bad_port, - Type => SOCK_STREAM, - Blocking => 0, - ); - - ok( defined $socket, "defined \$socket for $test_host:$test_bad_port" ) or - diag( " error was $@" ); - - ok( not( $socket->opened and $socket->connected ), '$socket not yet connected' ); - - my $selectcount = 0; - - while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) { - my $wvec = ''; - vec( $wvec, fileno $socket, 1 ) = 1; - my $evec = ''; - vec( $evec, fileno $socket, 1 ) = 1; - - $selectcount++; - my $ret = select( undef, $wvec, $evec, 60 ); - defined $ret or die "Cannot select() - $!"; - $ret or die "select() timed out"; - } - - my $dollarbang = $!; - - ok( $dollarbang == ECONNREFUSED, '->connect eventually fails with ECONNREFUSED' ) or - diag( " dollarbang = $dollarbang" ); - - ok( $selectcount > 0, '->connect had to select() at least once' ); - - ok( !$socket->opened, '$socket is not even opened' ); -} diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 9408b3bc1c..67247ca2d9 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -147,11 +147,6 @@ cribbed. The C<mmap> PerlIO layer is no longer implemented by perl itself, but has been moved out into the new L<PerlIO::mmap> module. -=item * - -L<IO::Socket::IP>, a drop-in replacement for L<IO::Socket::INET> that -supports both C<IPv4> and C<IPv6>, has been added as a dual-life module. - =back =head2 Updated Modules and Pragmata diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 15af7b0ca4..a036c380a5 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -54,7 +54,6 @@ gcc(1) getpriority(2) HTTP::Lite inetd(8) -IO::Socket::IP IPC::Run kill(3) langinfo(3) |