|
0 |
#!/usr/bin/perl
|
|
1 |
use strict; use warnings;
|
|
2 |
|
|
3 |
# This is an extension of the simple.t test to test for large responses
|
|
4 |
|
|
5 |
use Test::FailWarnings;
|
|
6 |
use Test::More 1.001002; # new enough for sanity in done_testing()
|
|
7 |
|
|
8 |
use POE 1.267;
|
|
9 |
use POE::Component::Client::TCP;
|
|
10 |
use POE::Component::Server::TCP;
|
|
11 |
use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate SSLify_GetSocket SSLify_GetSSL/;
|
|
12 |
|
|
13 |
# TODO rewrite this to use Test::POE::Server::TCP and stuff :)
|
|
14 |
|
|
15 |
my $port;
|
|
16 |
|
|
17 |
# length $bigpacket = 1039999 ( just need to go over 42643B as reported in RT#58243 but... =)
|
|
18 |
my $bigpacket = join( '-', ('a' .. 'z') x 10000, ('A' .. 'Z') x 10000 );
|
|
19 |
|
|
20 |
POE::Component::Server::TCP->new
|
|
21 |
(
|
|
22 |
Alias => 'myserver',
|
|
23 |
Address => '127.0.0.1',
|
|
24 |
Port => 0,
|
|
25 |
|
|
26 |
Started => sub
|
|
27 |
{
|
|
28 |
use Socket qw/sockaddr_in/;
|
|
29 |
$port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0];
|
|
30 |
},
|
|
31 |
ClientConnected => sub
|
|
32 |
{
|
|
33 |
ok(1, 'SERVER: accepted');
|
|
34 |
},
|
|
35 |
ClientDisconnected => sub
|
|
36 |
{
|
|
37 |
ok(1, 'SERVER: client disconnected');
|
|
38 |
$_[KERNEL]->post(myserver => 'shutdown');
|
|
39 |
},
|
|
40 |
ClientPreConnect => sub
|
|
41 |
{
|
|
42 |
eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') };
|
|
43 |
eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@);
|
|
44 |
ok(!$@, "SERVER: SSLify_Options $@");
|
|
45 |
|
|
46 |
my $socket = eval { Server_SSLify($_[ARG0]) };
|
|
47 |
ok(!$@, "SERVER: Server_SSLify $@");
|
|
48 |
ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket));
|
|
49 |
|
|
50 |
# We pray that IO::Handle is sane...
|
|
51 |
ok( SSLify_GetSocket( $socket )->blocking == 0, 'SERVER: SSLified socket is non-blocking?');
|
|
52 |
|
|
53 |
return ($socket);
|
|
54 |
},
|
|
55 |
ClientInput => sub
|
|
56 |
{
|
|
57 |
my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
|
|
58 |
|
|
59 |
if ( $line eq $bigpacket ) {
|
|
60 |
ok(1, "SERVER: recv BIGPACKET");
|
|
61 |
|
|
62 |
## At this point, connection MUST be encrypted.
|
|
63 |
my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle);
|
|
64 |
ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher");
|
|
65 |
|
|
66 |
$heap->{client}->put($bigpacket);
|
|
67 |
} else {
|
|
68 |
die "Unknown line from CLIENT: $line";
|
|
69 |
}
|
|
70 |
},
|
|
71 |
ClientError => sub
|
|
72 |
{
|
|
73 |
# Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0!
|
|
74 |
# The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :(
|
|
75 |
my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ];
|
|
76 |
|
|
77 |
# TODO are there other "errors" that is harmless?
|
|
78 |
$error = "Normal disconnection" unless $error;
|
|
79 |
my $msg = "Got SERVER $syscall error $errno: $error";
|
|
80 |
unless ( $syscall eq 'read' and $errno == 0 ) {
|
|
81 |
fail( $msg );
|
|
82 |
} else {
|
|
83 |
diag( $msg ) if $ENV{TEST_VERBOSE};
|
|
84 |
}
|
|
85 |
},
|
|
86 |
);
|
|
87 |
|
|
88 |
POE::Component::Client::TCP->new
|
|
89 |
(
|
|
90 |
Alias => 'myclient',
|
|
91 |
RemoteAddress => '127.0.0.1',
|
|
92 |
RemotePort => $port,
|
|
93 |
|
|
94 |
Connected => sub
|
|
95 |
{
|
|
96 |
ok(1, 'CLIENT: connected');
|
|
97 |
|
|
98 |
$_[HEAP]->{server}->put($bigpacket);
|
|
99 |
},
|
|
100 |
PreConnect => sub
|
|
101 |
{
|
|
102 |
my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') };
|
|
103 |
ok(!$@, "CLIENT: SSLify_ContextCreate $@");
|
|
104 |
my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) };
|
|
105 |
ok(!$@, "CLIENT: Client_SSLify $@");
|
|
106 |
ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket));
|
|
107 |
|
|
108 |
# We pray that IO::Handle is sane...
|
|
109 |
ok( SSLify_GetSocket( $socket )->blocking == 0, 'CLIENT: SSLified socket is non-blocking?');
|
|
110 |
|
|
111 |
return ($socket);
|
|
112 |
},
|
|
113 |
ServerInput => sub
|
|
114 |
{
|
|
115 |
my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
|
|
116 |
|
|
117 |
if ($line eq $bigpacket) {
|
|
118 |
ok(1, "CLIENT: recv BIGPACKET");
|
|
119 |
|
|
120 |
## At this point, connection MUST be encrypted.
|
|
121 |
my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle);
|
|
122 |
ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher");
|
|
123 |
diag( Net::SSLeay::dump_peer_certificate( SSLify_GetSSL( $heap->{server}->get_output_handle ) ) ) if $ENV{TEST_VERBOSE};
|
|
124 |
|
|
125 |
$kernel->yield('shutdown');
|
|
126 |
} else {
|
|
127 |
die "Unknown line from SERVER: $line";
|
|
128 |
}
|
|
129 |
},
|
|
130 |
ServerError => sub
|
|
131 |
{
|
|
132 |
# Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0!
|
|
133 |
# The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :(
|
|
134 |
my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ];
|
|
135 |
|
|
136 |
# TODO are there other "errors" that is harmless?
|
|
137 |
$error = "Normal disconnection" unless $error;
|
|
138 |
my $msg = "Got CLIENT $syscall error $errno: $error";
|
|
139 |
unless ( $syscall eq 'read' and $errno == 0 ) {
|
|
140 |
fail( $msg );
|
|
141 |
} else {
|
|
142 |
diag( $msg ) if $ENV{TEST_VERBOSE};
|
|
143 |
}
|
|
144 |
},
|
|
145 |
);
|
|
146 |
|
|
147 |
$poe_kernel->run();
|
|
148 |
|
|
149 |
done_testing;
|