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
'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',
--- /dev/null
+# 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;
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 1;
+
+use_ok( "IO::Socket::IP" );
--- /dev/null
+#!/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"
+}
--- /dev/null
+#!/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" );
+}
--- /dev/null
+#!/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" );
+}
--- /dev/null
+#!/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"
+}
--- /dev/null
+#!/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" );
+}
--- /dev/null
+#!/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" );
+}
--- /dev/null
+#!/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;
--- /dev/null
+#!/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' );
+}
--- /dev/null
+#!/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)"' );
--- /dev/null
+#!/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' );
+}
--- /dev/null
+#!/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' );
--- /dev/null
+#!/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 $@" );
+}
--- /dev/null
+#!/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' );
--- /dev/null
+#!/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' );
+}
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
getpriority(2)
HTTP::Lite
inetd(8)
+IO::Socket::IP
IPC::Run
kill(3)
langinfo(3)
projects / platform / upstream / perl.git / commitdiff