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
|
#!/usr/bin/perl -w
use strict;
use IO::Async::Test;
use Test::More tests => 14;
use Test::Exception;
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;
$loop->listen(
family => AF_INET,
socktype => 'stream',
service => 0, # 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( $listen_inaddr, "\x7f\0\0\1", '$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;
foreach my $port ( 22, 80 ) {
IO::Socket::INET->new( Type => SOCK_STREAM, LocalPort => $port, Listen => 1, ReuseAddr => 1 ) and next;
$badport = $port;
last;
}
SKIP: {
skip "No bind()-failing ports found", 1 unless defined $badport;
my ( $failcall, @failargs, $failbang );
my $errored = 0;
$loop->listen(
family => AF_INET,
socktype => 'stream',
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 { $failbang = pop; ( $failcall, @failargs ) = @_; },
on_listen_error => sub { $errored = 1 },
);
wait_for { $errored };
# We hope it's the bind() call that failed. Not quite sure what bang might
# be. EPERM or EADDRINUSE or various things. Best not to be sensitive on it
is( $failcall, "bind", "bind() to bad port $badport fails ($failbang)" );
}
|
