tweak tests and add more large size tests
Apocalypse
9 years ago
4 | 4 | Tweaked the testsuite to use done_testing() for sanity, RT#66741 (thanks RCAPUTO!) |
5 | 5 | Use Test::FailWarnings in the testsuite in place of Test::NoWarnings (DAGOLDEN++) |
6 | 6 | Add t/simple_large.t to try and track down RT#58243 (thanks Johan!) |
7 | Added a boatload of tests to try and track down RT#95071 (thanks Joe!) | |
7 | 8 | |
8 | 9 | 1.008 2011-05-04 21:55:27 UTC |
9 | 10 |
14 | 14 | |
15 | 15 | my $port; |
16 | 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 ); | |
17 | # length $bigpacket = 2079998 ( just need to go over 42643B as reported in RT#58243 but... =) | |
18 | my $bigpacket = join( '-', ('a' .. 'z') x 10000, ('A' .. 'Z') x 10000 ) x 2; | |
19 | 19 | |
20 | 20 | POE::Component::Server::TCP->new |
21 | 21 | ( |
0 | #!/usr/bin/perl | |
1 | use strict; use warnings; | |
2 | ||
3 | # This is an extension of the simple.t to test requests in parallel | |
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 | my $replies = 0; | |
17 | ||
18 | POE::Component::Server::TCP->new | |
19 | ( | |
20 | Alias => 'myserver', | |
21 | Address => '127.0.0.1', | |
22 | Port => 0, | |
23 | ||
24 | Started => sub | |
25 | { | |
26 | use Socket qw/sockaddr_in/; | |
27 | $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0]; | |
28 | }, | |
29 | ClientConnected => sub | |
30 | { | |
31 | ok(1, 'SERVER: accepted'); | |
32 | }, | |
33 | ClientDisconnected => sub | |
34 | { | |
35 | ok(1, 'SERVER: client disconnected'); | |
36 | $_[KERNEL]->post(myserver => 'shutdown') if $replies == 10; | |
37 | }, | |
38 | ClientPreConnect => sub | |
39 | { | |
40 | eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') }; | |
41 | eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@); | |
42 | ok(!$@, "SERVER: SSLify_Options $@"); | |
43 | ||
44 | my $socket = eval { Server_SSLify($_[ARG0]) }; | |
45 | ok(!$@, "SERVER: Server_SSLify $@"); | |
46 | ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
47 | ||
48 | # We pray that IO::Handle is sane... | |
49 | ok( SSLify_GetSocket( $socket )->blocking == 0, 'SERVER: SSLified socket is non-blocking?'); | |
50 | ||
51 | return ($socket); | |
52 | }, | |
53 | ClientInput => sub | |
54 | { | |
55 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
56 | ||
57 | if ( $line eq 'ping' ) { | |
58 | ok(1, "SERVER: recv: $line"); | |
59 | ||
60 | ## At this point, connection MUST be encrypted. | |
61 | my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle); | |
62 | ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher"); | |
63 | ||
64 | $heap->{client}->put('pong'); | |
65 | } else { | |
66 | die "Unknown line from CLIENT: $line"; | |
67 | } | |
68 | }, | |
69 | ClientError => sub | |
70 | { | |
71 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
72 | # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
73 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
74 | ||
75 | # TODO are there other "errors" that is harmless? | |
76 | $error = "Normal disconnection" unless $error; | |
77 | my $msg = "Got SERVER $syscall error $errno: $error"; | |
78 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
79 | fail( $msg ); | |
80 | } else { | |
81 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
82 | } | |
83 | }, | |
84 | ); | |
85 | ||
86 | POE::Component::Client::TCP->new | |
87 | ( | |
88 | Alias => 'myclient', | |
89 | RemoteAddress => '127.0.0.1', | |
90 | RemotePort => $port, | |
91 | ||
92 | Connected => sub | |
93 | { | |
94 | ok(1, 'CLIENT: connected'); | |
95 | ||
96 | $_[HEAP]->{server}->put('ping'); | |
97 | }, | |
98 | PreConnect => sub | |
99 | { | |
100 | my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') }; | |
101 | ok(!$@, "CLIENT: SSLify_ContextCreate $@"); | |
102 | my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) }; | |
103 | ok(!$@, "CLIENT: Client_SSLify $@"); | |
104 | ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
105 | ||
106 | # We pray that IO::Handle is sane... | |
107 | ok( SSLify_GetSocket( $socket )->blocking == 0, 'CLIENT: SSLified socket is non-blocking?'); | |
108 | ||
109 | return ($socket); | |
110 | }, | |
111 | ServerInput => sub | |
112 | { | |
113 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
114 | ||
115 | if ($line eq 'pong') { | |
116 | ok(1, "CLIENT: recv: $line"); | |
117 | ||
118 | ## At this point, connection MUST be encrypted. | |
119 | my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle); | |
120 | ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher"); | |
121 | diag( Net::SSLeay::dump_peer_certificate( SSLify_GetSSL( $heap->{server}->get_output_handle ) ) ) if $ENV{TEST_VERBOSE}; | |
122 | $replies++; | |
123 | $kernel->yield('shutdown'); | |
124 | } else { | |
125 | die "Unknown line from SERVER: $line"; | |
126 | } | |
127 | }, | |
128 | ServerError => sub | |
129 | { | |
130 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
131 | # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
132 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
133 | ||
134 | # TODO are there other "errors" that is harmless? | |
135 | $error = "Normal disconnection" unless $error; | |
136 | my $msg = "Got CLIENT $syscall error $errno: $error"; | |
137 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
138 | fail( $msg ); | |
139 | } else { | |
140 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
141 | } | |
142 | }, | |
143 | ) for 1 .. 10; | |
144 | ||
145 | $poe_kernel->run(); | |
146 | ||
147 | is( $replies, 10, "Make sure we got 10 replies back!" ); | |
148 | ||
149 | done_testing; |
0 | #!/usr/bin/perl | |
1 | use strict; use warnings; | |
2 | ||
3 | # This is an extension of the simple_parallel.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 | my $replies = 0; | |
17 | ||
18 | my $bigpacket = join( '-', ('a' .. 'z') x 10000, ('A' .. 'Z') x 10000 ) x 2; | |
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') if $replies == 10; | |
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 | ## At this point, connection MUST be encrypted. | |
61 | my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle); | |
62 | ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher"); | |
63 | ||
64 | $heap->{client}->put($bigpacket); | |
65 | } else { | |
66 | die "Unknown line from CLIENT: $line"; | |
67 | } | |
68 | }, | |
69 | ClientError => sub | |
70 | { | |
71 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
72 | # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
73 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
74 | ||
75 | # TODO are there other "errors" that is harmless? | |
76 | $error = "Normal disconnection" unless $error; | |
77 | my $msg = "Got SERVER $syscall error $errno: $error"; | |
78 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
79 | fail( $msg ); | |
80 | } else { | |
81 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
82 | } | |
83 | }, | |
84 | ); | |
85 | ||
86 | POE::Component::Client::TCP->new | |
87 | ( | |
88 | Alias => 'myclient', | |
89 | RemoteAddress => '127.0.0.1', | |
90 | RemotePort => $port, | |
91 | ||
92 | Connected => sub | |
93 | { | |
94 | ok(1, 'CLIENT: connected'); | |
95 | ||
96 | $_[HEAP]->{server}->put($bigpacket); | |
97 | }, | |
98 | PreConnect => sub | |
99 | { | |
100 | my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') }; | |
101 | ok(!$@, "CLIENT: SSLify_ContextCreate $@"); | |
102 | my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) }; | |
103 | ok(!$@, "CLIENT: Client_SSLify $@"); | |
104 | ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
105 | ||
106 | # We pray that IO::Handle is sane... | |
107 | ok( SSLify_GetSocket( $socket )->blocking == 0, 'CLIENT: SSLified socket is non-blocking?'); | |
108 | ||
109 | return ($socket); | |
110 | }, | |
111 | ServerInput => sub | |
112 | { | |
113 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
114 | ||
115 | if ($line eq $bigpacket) { | |
116 | ## At this point, connection MUST be encrypted. | |
117 | my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle); | |
118 | ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher"); | |
119 | diag( Net::SSLeay::dump_peer_certificate( SSLify_GetSSL( $heap->{server}->get_output_handle ) ) ) if $ENV{TEST_VERBOSE}; | |
120 | $replies++; | |
121 | $kernel->yield('shutdown'); | |
122 | } else { | |
123 | die "Unknown line from SERVER: $line"; | |
124 | } | |
125 | }, | |
126 | ServerError => sub | |
127 | { | |
128 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
129 | # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
130 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
131 | ||
132 | # TODO are there other "errors" that is harmless? | |
133 | $error = "Normal disconnection" unless $error; | |
134 | my $msg = "Got CLIENT $syscall error $errno: $error"; | |
135 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
136 | fail( $msg ); | |
137 | } else { | |
138 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
139 | } | |
140 | }, | |
141 | ) for 1 .. 10; | |
142 | ||
143 | $poe_kernel->run(); | |
144 | ||
145 | is( $replies, 10, "Make sure we got 10 replies back!" ); | |
146 | ||
147 | done_testing; |
0 | #!/usr/bin/perl | |
1 | use strict; use warnings; | |
2 | ||
3 | # This is an extension of the simple_parallel_large.t test for even LARGER message sizes! | |
4 | # and thus is marked as TODO and a watchdog timer of 2m is set in case we lock up - see RT#95071 | |
5 | ||
6 | use Test::FailWarnings; | |
7 | use Test::More 1.001002; # new enough for sanity in done_testing() | |
8 | ||
9 | BEGIN { | |
10 | plan skip_all => "AUTHOR TEST" unless $ENV{AUTHOR_TESTING}; | |
11 | } | |
12 | ||
13 | local $TODO = "locks up SSLify"; | |
14 | ||
15 | use POE 1.267; | |
16 | use POE::Component::Client::TCP; | |
17 | use POE::Component::Server::TCP; | |
18 | use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate SSLify_GetSocket SSLify_GetSSL/; | |
19 | ||
20 | # TODO rewrite this to use Test::POE::Server::TCP and stuff :) | |
21 | ||
22 | my $port; | |
23 | my $replies = 0; | |
24 | ||
25 | # TODO interestingly, x3 goes over some sort of buffer size and this explodes! | |
26 | my $bigpacket = join( '-', ('a' .. 'z') x 10000, ('A' .. 'Z') x 10000 ) x 3; | |
27 | ||
28 | ||
29 | POE::Component::Server::TCP->new | |
30 | ( | |
31 | Alias => 'myserver', | |
32 | Address => '127.0.0.1', | |
33 | Port => 0, | |
34 | ||
35 | Started => sub | |
36 | { | |
37 | use Socket qw/sockaddr_in/; | |
38 | $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0]; | |
39 | }, | |
40 | ClientConnected => sub | |
41 | { | |
42 | ok(1, 'SERVER: accepted'); | |
43 | }, | |
44 | ClientDisconnected => sub | |
45 | { | |
46 | ok(1, 'SERVER: client disconnected'); | |
47 | $_[KERNEL]->post(myserver => 'shutdown') if $replies == 10; | |
48 | }, | |
49 | ClientPreConnect => sub | |
50 | { | |
51 | eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') }; | |
52 | eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@); | |
53 | ok(!$@, "SERVER: SSLify_Options $@"); | |
54 | ||
55 | my $socket = eval { Server_SSLify($_[ARG0]) }; | |
56 | ok(!$@, "SERVER: Server_SSLify $@"); | |
57 | ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
58 | ||
59 | # We pray that IO::Handle is sane... | |
60 | ok( SSLify_GetSocket( $socket )->blocking == 0, 'SERVER: SSLified socket is non-blocking?'); | |
61 | ||
62 | return ($socket); | |
63 | }, | |
64 | ClientInput => sub | |
65 | { | |
66 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
67 | ||
68 | if ( $line eq $bigpacket ) { | |
69 | ## At this point, connection MUST be encrypted. | |
70 | my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle); | |
71 | ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher"); | |
72 | ||
73 | $heap->{client}->put($bigpacket); | |
74 | } else { | |
75 | die "Unknown line from CLIENT: $line"; | |
76 | } | |
77 | }, | |
78 | ClientError => sub | |
79 | { | |
80 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
81 | # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
82 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
83 | ||
84 | # TODO are there other "errors" that is harmless? | |
85 | $error = "Normal disconnection" unless $error; | |
86 | my $msg = "Got SERVER $syscall error $errno: $error"; | |
87 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
88 | fail( $msg ); | |
89 | } else { | |
90 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
91 | } | |
92 | }, | |
93 | ); | |
94 | ||
95 | POE::Component::Client::TCP->new | |
96 | ( | |
97 | Alias => 'myclient', | |
98 | RemoteAddress => '127.0.0.1', | |
99 | RemotePort => $port, | |
100 | ||
101 | Connected => sub | |
102 | { | |
103 | ok(1, 'CLIENT: connected'); | |
104 | ||
105 | $_[HEAP]->{server}->put($bigpacket); | |
106 | }, | |
107 | PreConnect => sub | |
108 | { | |
109 | my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') }; | |
110 | ok(!$@, "CLIENT: SSLify_ContextCreate $@"); | |
111 | my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) }; | |
112 | ok(!$@, "CLIENT: Client_SSLify $@"); | |
113 | ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
114 | ||
115 | # We pray that IO::Handle is sane... | |
116 | ok( SSLify_GetSocket( $socket )->blocking == 0, 'CLIENT: SSLified socket is non-blocking?'); | |
117 | ||
118 | return ($socket); | |
119 | }, | |
120 | ServerInput => sub | |
121 | { | |
122 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
123 | ||
124 | if ($line eq $bigpacket) { | |
125 | ## At this point, connection MUST be encrypted. | |
126 | my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle); | |
127 | ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher"); | |
128 | diag( Net::SSLeay::dump_peer_certificate( SSLify_GetSSL( $heap->{server}->get_output_handle ) ) ) if $ENV{TEST_VERBOSE}; | |
129 | $replies++; | |
130 | $kernel->yield('shutdown'); | |
131 | } else { | |
132 | die "Unknown line from SERVER: $line"; | |
133 | } | |
134 | }, | |
135 | ServerError => sub | |
136 | { | |
137 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
138 | # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
139 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
140 | ||
141 | # TODO are there other "errors" that is harmless? | |
142 | $error = "Normal disconnection" unless $error; | |
143 | my $msg = "Got CLIENT $syscall error $errno: $error"; | |
144 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
145 | fail( $msg ); | |
146 | } else { | |
147 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
148 | } | |
149 | }, | |
150 | ) for 1 .. 10; | |
151 | ||
152 | # the watchdog session | |
153 | POE::Session->create( | |
154 | inline_states => { | |
155 | _start => sub { $_[KERNEL]->delay( 'dog' => 300 ); $_[KERNEL]->yield( 'check' ); }, | |
156 | dog => sub { fail "WATCHDOG TRIGGERED"; done_testing; exit; }, | |
157 | check => sub { $_[KERNEL]->delay( 'check' => 1 ); $_[KERNEL]->alarm_remove_all if $replies == 10; }, | |
158 | }, | |
159 | ); | |
160 | ||
161 | $poe_kernel->run(); | |
162 | ||
163 | is( $replies, 10, "Make sure we got 10 replies back!" ); | |
164 | ||
165 | done_testing; |
0 | #!/usr/bin/perl | |
1 | use strict; use warnings; | |
2 | ||
3 | # This is an extension of the simple_large.t test for even LARGER message sizes! | |
4 | # and thus is marked as TODO and a watchdog timer is set in case we lock up - see RT#95071 | |
5 | ||
6 | use Test::FailWarnings; | |
7 | use Test::More 1.001002; # new enough for sanity in done_testing() | |
8 | ||
9 | BEGIN { | |
10 | plan skip_all => "AUTHOR TEST" unless $ENV{AUTHOR_TESTING}; | |
11 | } | |
12 | ||
13 | local $TODO = "locks up SSLify"; | |
14 | ||
15 | use POE 1.267; | |
16 | use POE::Component::Client::TCP; | |
17 | use POE::Component::Server::TCP; | |
18 | use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate SSLify_GetSocket SSLify_GetSSL/; | |
19 | ||
20 | # TODO rewrite this to use Test::POE::Server::TCP and stuff :) | |
21 | ||
22 | my $port; | |
23 | ||
24 | # TODO interestingly, x3 goes over some sort of buffer size and this explodes! | |
25 | my $bigpacket = join( '-', ('a' .. 'z') x 10000, ('A' .. 'Z') x 10000 ) x 3; | |
26 | ||
27 | POE::Component::Server::TCP->new | |
28 | ( | |
29 | Alias => 'myserver', | |
30 | Address => '127.0.0.1', | |
31 | Port => 0, | |
32 | ||
33 | Started => sub | |
34 | { | |
35 | use Socket qw/sockaddr_in/; | |
36 | $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0]; | |
37 | }, | |
38 | ClientConnected => sub | |
39 | { | |
40 | ok(1, 'SERVER: accepted'); | |
41 | }, | |
42 | ClientDisconnected => sub | |
43 | { | |
44 | ok(1, 'SERVER: client disconnected'); | |
45 | $_[KERNEL]->post(myserver => 'shutdown'); | |
46 | }, | |
47 | ClientPreConnect => sub | |
48 | { | |
49 | eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') }; | |
50 | eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@); | |
51 | ok(!$@, "SERVER: SSLify_Options $@"); | |
52 | ||
53 | my $socket = eval { Server_SSLify($_[ARG0]) }; | |
54 | ok(!$@, "SERVER: Server_SSLify $@"); | |
55 | ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
56 | ||
57 | # We pray that IO::Handle is sane... | |
58 | ok( SSLify_GetSocket( $socket )->blocking == 0, 'SERVER: SSLified socket is non-blocking?'); | |
59 | ||
60 | return ($socket); | |
61 | }, | |
62 | ClientInput => sub | |
63 | { | |
64 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
65 | ||
66 | if ( $line eq $bigpacket ) { | |
67 | ok(1, "SERVER: recv BIGPACKET"); | |
68 | ||
69 | ## At this point, connection MUST be encrypted. | |
70 | my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle); | |
71 | ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher"); | |
72 | ||
73 | $heap->{client}->put($bigpacket); | |
74 | } else { | |
75 | die "Unknown line from CLIENT: $line"; | |
76 | } | |
77 | }, | |
78 | ClientError => sub | |
79 | { | |
80 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
81 | # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
82 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
83 | ||
84 | # TODO are there other "errors" that is harmless? | |
85 | $error = "Normal disconnection" unless $error; | |
86 | my $msg = "Got SERVER $syscall error $errno: $error"; | |
87 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
88 | fail( $msg ); | |
89 | } else { | |
90 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
91 | } | |
92 | }, | |
93 | ); | |
94 | ||
95 | my $replies = 0; | |
96 | ||
97 | POE::Component::Client::TCP->new | |
98 | ( | |
99 | Alias => 'myclient', | |
100 | RemoteAddress => '127.0.0.1', | |
101 | RemotePort => $port, | |
102 | ||
103 | Connected => sub | |
104 | { | |
105 | ok(1, 'CLIENT: connected'); | |
106 | ||
107 | $_[HEAP]->{server}->put($bigpacket); | |
108 | }, | |
109 | PreConnect => sub | |
110 | { | |
111 | my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') }; | |
112 | ok(!$@, "CLIENT: SSLify_ContextCreate $@"); | |
113 | my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) }; | |
114 | ok(!$@, "CLIENT: Client_SSLify $@"); | |
115 | ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
116 | ||
117 | # We pray that IO::Handle is sane... | |
118 | ok( SSLify_GetSocket( $socket )->blocking == 0, 'CLIENT: SSLified socket is non-blocking?'); | |
119 | ||
120 | return ($socket); | |
121 | }, | |
122 | ServerInput => sub | |
123 | { | |
124 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
125 | ||
126 | if ($line eq $bigpacket) { | |
127 | ok(1, "CLIENT: recv BIGPACKET"); | |
128 | ||
129 | ## At this point, connection MUST be encrypted. | |
130 | my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle); | |
131 | ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher"); | |
132 | diag( Net::SSLeay::dump_peer_certificate( SSLify_GetSSL( $heap->{server}->get_output_handle ) ) ) if $ENV{TEST_VERBOSE}; | |
133 | $replies++; | |
134 | $kernel->yield('shutdown'); | |
135 | } else { | |
136 | die "Unknown line from SERVER: $line"; | |
137 | } | |
138 | }, | |
139 | ServerError => sub | |
140 | { | |
141 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
142 | # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
143 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
144 | ||
145 | # TODO are there other "errors" that is harmless? | |
146 | $error = "Normal disconnection" unless $error; | |
147 | my $msg = "Got CLIENT $syscall error $errno: $error"; | |
148 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
149 | fail( $msg ); | |
150 | } else { | |
151 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
152 | } | |
153 | }, | |
154 | ); | |
155 | ||
156 | # the watchdog session | |
157 | POE::Session->create( | |
158 | inline_states => { | |
159 | _start => sub { $_[KERNEL]->delay( 'dog' => 300 ); $_[KERNEL]->yield( 'check' ); }, | |
160 | dog => sub { fail "WATCHDOG TRIGGERED"; done_testing; exit; }, | |
161 | check => sub { $_[KERNEL]->delay( 'check' => 1 ); $_[KERNEL]->alarm_remove_all if $replies == 1 }, | |
162 | }, | |
163 | ); | |
164 | ||
165 | $poe_kernel->run(); | |
166 | ||
167 | done_testing; |