1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
#!/usr/bin/perl -w
use strict;
use IO::Async::Test;
use Test::More tests => 19;
use IO::Socket::INET;
use Socket qw( unpack_sockaddr_in );
use IO::Async::Loop::Poll;
my $loop = IO::Async::Loop::Poll->new;
testing_loop( $loop );
my $listensock;
my $notifier;
$listensock = IO::Socket::INET->new(
LocalAddr => "localhost",
Type => SOCK_STREAM,
Listen => 1,
) or die "Cannot socket() - $!";
my $newclient;
$loop->listen(
handle => $listensock,
on_notifier => sub { $notifier = $_[0]; },
on_accept => sub { $newclient = $_[0]; },
);
ok( defined $notifier, 'on_notifier fired synchronously' );
isa_ok( $notifier, "IO::Async::Notifier", 'synchronous on_notifier given a Notifier' );
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' );
undef $listensock;
undef $clientsock;
undef $newclient;
undef $notifier;
# Some odd locations like BSD jails might not like INADDR_LOOPBACK. We'll
# establish a baseline first to test against
my $INADDR_LOOPBACK = do {
my $localsock = IO::Socket::INET->new( LocalAddr => "localhost", Listen => 1 );
$localsock->sockaddr;
};
if( $INADDR_LOOPBACK ne INADDR_LOOPBACK ) {
diag( sprintf "Testing with INADDR_LOOPBACK=%vd; this may be because of odd networking", $INADDR_LOOPBACK );
}
$loop->listen(
family => "inet",
socktype => "stream",
service => "", # Ask the kernel to allocate a port for us
host => "localhost",
on_resolve_error => sub { die "Test died early - resolve error $_[0]\n"; },
on_listen => sub { $listensock = $_[0]; },
on_notifier => sub { $notifier = $_[0]; },
on_accept => sub { $newclient = $_[0]; },
on_listen_error => sub { die "Test died early - $_[0] - $_[-1]\n"; },
);
wait_for { defined $listensock };
ok( defined $listensock->fileno, '$listensock has a fileno' );
isa_ok( $listensock, "IO::Socket::INET", '$listenaddr isa IO::Socket::INET' );
wait_for { defined $notifier };
ok( defined $notifier, 'on_notifier fired asynchronously' );
isa_ok( $notifier, "IO::Async::Notifier", 'asynchronous on_notifier given a Notifier' );
my $listenaddr = $listensock->sockname;
ok( defined $listenaddr, '$listensock has address' );
my ( $listenport, $listen_inaddr ) = unpack_sockaddr_in( $listenaddr );
is( sprintf("%vd",$listen_inaddr),
sprintf("%vd",$INADDR_LOOPBACK),
'$listenaddr is INADDR_LOOPBACK' );
$clientsock = IO::Socket::INET->new( Type => SOCK_STREAM )
or die "Cannot socket() - $!";
$clientsock->connect( $listenaddr ) or die "Cannot connect() - $!";
is( (unpack_sockaddr_in( $clientsock->peername ))[0], $listenport, '$clientsock on the correct port' );
wait_for { defined $newclient };
isa_ok( $newclient, "IO::Socket::INET", '$newclient isa IO::Socket::INET' );
is_deeply( [ unpack_sockaddr_in $newclient->peername ],
[ unpack_sockaddr_in $clientsock->sockname ], '$newclient peer is correct' );
# Now we want to test failure. It's hard to know in a test script what will
# definitely fail, but it's likely we're either running as non-root, or the
# machine has at least one of an SSH or a webserver running. In this case,
# it's likely we'll fail to bind TCP port 22 or 80.
my $badport;
my $failure;
foreach my $port ( 22, 80 ) {
IO::Socket::INET->new(
Type => SOCK_STREAM,
LocalHost => "localhost",
LocalPort => $port,
Listen => 1,
) and next;
$badport = $port;
$failure = $!;
last;
}
SKIP: {
skip "No bind()-failing ports found", 6 unless defined $badport;
my $failop;
my $failerr;
my @error;
# Undocumented API, returning the Listener object
my $listener = $loop->listen(
family => "inet",
socktype => "stream",
host => "localhost",
service => $badport,
on_resolve_error => sub { die "Test died early - resolve error $_[0]\n"; },
on_listen => sub { die "Test died early - listen on port $badport actually succeeded\n"; },
on_accept => sub { "DUMMY" }, # really hope this doesn't happen ;)
on_fail => sub { $failop = shift; $failerr = pop; },
on_listen_error => sub { @error = @_; },
);
wait_for { @error };
is( $failop, "bind", '$failop is bind' );
is( "$failerr", $failure, "\$failerr is '$failure'" );
is( $error[0], "bind", '$error[0] is bind' );
is( "$error[1]", $failure, "\$error[1] is '$failure'" );
ok( defined $listener, '$listener defined after bind failure' );
ok( !$listener->loop, '$listener not in loop after bind failure' );
}
|
