#!/usr/bin/perl
use strict;
use warnings;
use IO::Async::Test;
use Test::More;
use Test::Identity;
use Test::Refcount;
use IO::Async::Loop;
use IO::Socket::INET;
use IO::Async::Listener;
# Some odd locations like BSD jails might not like INADDR_ANY. We'll establish
# a baseline first to test against
my $INADDR_ANY = do {
my $anysock = IO::Socket::INET->new( LocalPort => 0, Listen => 1 );
$anysock->sockaddr;
};
my $INADDR_ANY_HOST = inet_ntoa( $INADDR_ANY );
if( $INADDR_ANY ne INADDR_ANY ) {
diag( "Testing with INADDR_ANY=$INADDR_ANY_HOST; this may be because of odd networking" );
}
my $loop = IO::Async::Loop->new_builtin;
testing_loop( $loop );
my $listensock;
$listensock = IO::Socket::INET->new(
LocalAddr => "localhost",
Type => SOCK_STREAM,
Listen => 1,
) or die "Cannot socket() - $!";
{
my $newclient;
my $listener = IO::Async::Listener->new(
handle => $listensock,
on_accept => sub { ( undef, $newclient ) = @_ },
);
ok( defined $listener, 'defined $listener' );
isa_ok( $listener, "IO::Async::Listener", '$listener isa IO::Async::Listener' );
isa_ok( $listener, "IO::Async::Notifier", '$listener isa IO::Async::Notifier' );
is_oneref( $listener, '$listener has refcount 1 initially' );
ok( $listener->is_listening, '$listener is_listening' );
is_deeply( [ unpack_sockaddr_in $listener->sockname ],
[ unpack_sockaddr_in $listensock->sockname ], '$listener->sockname' );
is( $listener->family, AF_INET, '$listener->family' );
is( $listener->socktype, SOCK_STREAM, '$listener->sockname' );
$loop->add( $listener );
is_refcount( $listener, 2, '$listener has refcount 2 after adding to Loop' );
my $clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listensock->sockname ) or die "Cannot connect() - $!";
ok( defined $clientsock->peername, '$clientsock is connected' );
wait_for { defined $newclient };
is_deeply( [ unpack_sockaddr_in $newclient->peername ],
[ unpack_sockaddr_in $clientsock->sockname ], '$newclient peer is correct' );
is_refcount( $listener, 2, '$listener has refcount 2 before removing from Loop' );
$loop->remove( $listener );
is_oneref( $listener, '$listener has refcount 1 after removing from Loop' );
}
# on_accept handle constructors
{
my $accepted;
my $listener = IO::Async::Listener->new(
handle => $listensock,
on_accept => sub { ( undef, $accepted ) = @_ },
);
$loop->add( $listener );
require IO::Async::Stream;
# handle_constructor
{
$listener->configure( handle_constructor => sub {
return IO::Async::Stream->new;
} );
my $clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listensock->sockname ) or die "Cannot connect() - $!";
wait_for { defined $accepted };
isa_ok( $accepted, "IO::Async::Stream", '$accepted with handle_constructor' );
undef $accepted;
}
# handle_class
{
$listener->configure( handle_class => "IO::Async::Stream" );
my $clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listensock->sockname ) or die "Cannot connect() - $!";
wait_for { defined $accepted };
isa_ok( $accepted, "IO::Async::Stream", '$accepted with handle_constructor' );
undef $accepted;
}
$loop->remove( $listener );
}
# on_stream
{
my $newstream;
my $listener = IO::Async::Listener->new(
handle => $listensock,
on_stream => sub { ( undef, $newstream ) = @_ },
);
$loop->add( $listener );
my $clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listensock->sockname ) or die "Cannot connect() - $!";
wait_for { defined $newstream };
isa_ok( $newstream, "IO::Async::Stream", 'on_stream $newstream isa IO::Async::Stream' );
is_deeply( [ unpack_sockaddr_in $newstream->read_handle->peername ],
[ unpack_sockaddr_in $clientsock->sockname ], '$newstream sock peer is correct' );
$loop->remove( $listener );
}
# on_socket
{
my $newsocket;
my $listener = IO::Async::Listener->new(
handle => $listensock,
on_socket => sub { ( undef, $newsocket ) = @_ },
);
$loop->add( $listener );
my $clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listensock->sockname ) or die "Cannot connect() - $!";
wait_for { defined $newsocket };
isa_ok( $newsocket, "IO::Async::Socket", 'on_socket $newsocket isa IO::Async::Socket' );
is_deeply( [ unpack_sockaddr_in $newsocket->read_handle->peername ],
[ unpack_sockaddr_in $clientsock->sockname ], '$newsocket sock peer is correct' );
$loop->remove( $listener );
}
# Subclass
my $sub_newclient;
{
my $listener = TestListener->new(
handle => $listensock,
);
ok( defined $listener, 'subclass defined $listener' );
isa_ok( $listener, "IO::Async::Listener", 'subclass $listener isa IO::Async::Listener' );
is_oneref( $listener, 'subclass $listener has refcount 1 initially' );
$loop->add( $listener );
is_refcount( $listener, 2, 'subclass $listener has refcount 2 after adding to Loop' );
my $clientsock = IO::Socket::INET->new( LocalAddr => "127.0.0.1", Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listensock->sockname ) or die "Cannot connect() - $!";
ok( defined $clientsock->peername, 'subclass $clientsock is connected' );
wait_for { defined $sub_newclient };
is_deeply( [ unpack_sockaddr_in $sub_newclient->peername ],
[ unpack_sockaddr_in $clientsock->sockname ], '$sub_newclient peer is correct' );
is_refcount( $listener, 2, 'subclass $listener has refcount 2 before removing from Loop' );
$loop->remove( $listener );
is_oneref( $listener, 'subclass $listener has refcount 1 after removing from Loop' );
}
{
my $newclient;
my $listener = IO::Async::Listener->new(
on_accept => sub { ( undef, $newclient ) = @_ },
);
ok( !$listener->is_listening, '$listener is_listening not yet' );
$loop->add( $listener );
my $listen_self;
$listener->listen(
addr => { family => "inet", socktype => "stream", addr => pack_sockaddr_in( 0, $INADDR_ANY ) },
on_listen => sub { $listen_self = shift },
on_listen_error => sub { die "Test died early - $_[0] - $_[-1]\n"; },
);
ok( $listener->is_listening, '$listener is_listening' );
my $sockname = $listener->sockname;
ok( defined $sockname, 'defined $sockname' );
my ( $port, $sinaddr ) = unpack_sockaddr_in( $sockname );
ok( $port > 0, 'socket listens on some defined port number' );
is( inet_ntoa( $sinaddr ), $INADDR_ANY_HOST, 'socket listens on INADDR_ANY' );
is( $listener->family, AF_INET, '$listener->family' );
is( $listener->socktype, SOCK_STREAM, '$listener->sockname' );
is( $listen_self, $listener, '$listen_self is $listener' );
undef $listen_self; # for refcount
my $clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( pack_sockaddr_in( $port, INADDR_LOOPBACK ) ) or die "Cannot connect() - $!";
ok( defined $clientsock->peername, '$clientsock is connected' );
wait_for { defined $newclient };
is_deeply( [ unpack_sockaddr_in $newclient->peername ],
[ unpack_sockaddr_in $clientsock->sockname ], '$newclient peer is correct' );
$loop->remove( $listener );
}
done_testing;
package TestListener;
use base qw( IO::Async::Listener );
sub on_accept { ( undef, $sub_newclient ) = @_ }