[svn-upgrade] Integrating new upstream version, libpoe-component-sslify-perl (0.20)
Jonathan Yu
13 years ago
17 | 17 | 'sign' => 0, |
18 | 18 | |
19 | 19 | 'test_files' => 't/*.t', |
20 | ||
21 | 'add_to_cleanup' => [ 'META.yml', 'Makefile.PL', 'README', 'Makefile', 'LICENSE' ], # automatically generated | |
22 | 20 | |
23 | 21 | 'requires' => { |
24 | 22 | # Networking |
0 | 0 | Revision history for Perl extension POE::Component::SSLify. |
1 | ||
2 | * 0.20 | |
3 | ||
4 | Split up the simple.t test into 2 tests for clarity, and added more diag messages for renegotiate, thanks HMBRAND! | |
1 | 5 | |
2 | 6 | * 0.19 |
3 | 7 |
18 | 18 | mylib/example.key |
19 | 19 | |
20 | 20 | t/1_load.t |
21 | t/2_simple.t | |
22 | t/3_renegotiate.t | |
21 | 23 | t/apocalypse.t |
22 | t/simple.t |
17 | 17 | provides: |
18 | 18 | POE::Component::SSLify: |
19 | 19 | file: lib/POE/Component/SSLify.pm |
20 | version: 0.19 | |
20 | version: 0.20 | |
21 | 21 | POE::Component::SSLify::ClientHandle: |
22 | 22 | file: lib/POE/Component/SSLify/ClientHandle.pm |
23 | version: 0.19 | |
23 | version: 0.20 | |
24 | 24 | POE::Component::SSLify::ServerHandle: |
25 | 25 | file: lib/POE/Component/SSLify/ServerHandle.pm |
26 | version: 0.19 | |
26 | version: 0.20 | |
27 | 27 | requires: |
28 | 28 | Net::SSLeay: 1.36 |
29 | 29 | perl: 5.006 |
32 | 32 | homepage: http://search.cpan.org/dist/POE-Component-SSLify |
33 | 33 | license: http://dev.perl.org/licenses/ |
34 | 34 | repository: http://github.com/apocalypse/perl-poe-sslify |
35 | version: 0.19 | |
35 | version: 0.20 |
102 | 102 | please report back to me so I can update this doc! |
103 | 103 | |
104 | 104 | Net::SSLeay::renegotiate |
105 | This function has been tested ( it's in t/simple.t ) but it doesn't work | |
106 | on FreeBSD! I tracked it down to this security advisory: | |
105 | This function has been tested ( it's in t/3_renegotiate.t ) but it | |
106 | doesn't work on FreeBSD! I tracked it down to this security advisory: | |
107 | 107 | <http://security.freebsd.org/advisories/FreeBSD-SA-09:15.ssl.asc> which |
108 | 108 | explains it in detail. The test will skip this function if it detects |
109 | that you're on a FreeBSD system. However, if you have the updated | |
110 | OpenSSL library that fixes this you can use it. | |
109 | that you're on a broken system. However, if you have the updated OpenSSL | |
110 | library that fixes this you can use it. | |
111 | 111 | |
112 | 112 | FUNCTIONS |
113 | 113 | Client_SSLify |
229 | 229 | SUPPORT |
230 | 230 | You can find documentation for this module with the perldoc command. |
231 | 231 | |
232 | perldoc POE::Component::SSLify | |
232 | perldoc POE::Component::SSLify | |
233 | 233 | |
234 | 234 | Websites |
235 | 235 | * Search CPAN |
2 | 2 | |
3 | 3 | # Initialize our version |
4 | 4 | use vars qw( $VERSION ); |
5 | $VERSION = '0.19'; | |
5 | $VERSION = '0.20'; | |
6 | 6 | |
7 | 7 | # Import the SSL death routines |
8 | 8 | use Net::SSLeay qw( die_now die_if_ssl_error ); |
2 | 2 | |
3 | 3 | # Initialize our version |
4 | 4 | use vars qw( $VERSION ); |
5 | $VERSION = '0.19'; | |
5 | $VERSION = '0.20'; | |
6 | 6 | |
7 | 7 | # Import the SSL death routines |
8 | 8 | use Net::SSLeay qw( die_now die_if_ssl_error ); |
2 | 2 | |
3 | 3 | # Initialize our version |
4 | 4 | use vars qw( $VERSION ); |
5 | $VERSION = '0.19'; | |
5 | $VERSION = '0.20'; | |
6 | 6 | |
7 | 7 | # We need Net::SSLeay or all's a failure! |
8 | 8 | BEGIN { |
9 | eval { require Net::SSLeay }; | |
9 | eval { | |
10 | require Net::SSLeay; | |
11 | ||
12 | # We need >= 1.36 because it contains a lot of important fixes | |
13 | Net::SSLeay->import( 1.36 ); | |
14 | }; | |
10 | 15 | |
11 | 16 | # Check for errors... |
12 | 17 | if ( $@ ) { |
13 | 18 | # Oh boy! |
14 | 19 | die $@; |
15 | 20 | } else { |
16 | # Check to make sure the versions are what we want | |
17 | # TODO what if Net::SSLeay is upgraded to 1.4? :( | |
18 | if ( ! ( defined $Net::SSLeay::VERSION and | |
19 | $Net::SSLeay::VERSION =~ /^1\.3/ ) ) { | |
20 | warn 'Please upgrade Net::SSLeay to v1.30+ installed: v' . $Net::SSLeay::VERSION; | |
21 | } | |
22 | ||
23 | 21 | # Finally, load our subclass :) |
24 | 22 | # ClientHandle isa ServerHandle so it will get loaded automatically |
25 | 23 | require POE::Component::SSLify::ClientHandle; |
367 | 365 | |
368 | 366 | =head3 Net::SSLeay::renegotiate |
369 | 367 | |
370 | This function has been tested ( it's in t/simple.t ) but it doesn't work on FreeBSD! I tracked it down to this security advisory: | |
368 | This function has been tested ( it's in t/3_renegotiate.t ) but it doesn't work on FreeBSD! I tracked it down to this security advisory: | |
371 | 369 | L<http://security.freebsd.org/advisories/FreeBSD-SA-09:15.ssl.asc> which explains it in detail. The test will skip this function |
372 | if it detects that you're on a FreeBSD system. However, if you have the updated OpenSSL library that fixes this you can use it. | |
370 | if it detects that you're on a broken system. However, if you have the updated OpenSSL library that fixes this you can use it. | |
373 | 371 | |
374 | 372 | =head1 FUNCTIONS |
375 | 373 | |
501 | 499 | |
502 | 500 | You can find documentation for this module with the perldoc command. |
503 | 501 | |
504 | perldoc POE::Component::SSLify | |
502 | perldoc POE::Component::SSLify | |
505 | 503 | |
506 | 504 | =head2 Websites |
507 | 505 |
0 | #!/usr/bin/perl | |
1 | ||
2 | # Thanks to ASCENT for this test! | |
3 | ||
4 | use strict; use warnings; | |
5 | ||
6 | my $numtests; | |
7 | BEGIN { | |
8 | $numtests = 16; | |
9 | ||
10 | eval "use Test::NoWarnings"; | |
11 | if ( ! $@ ) { | |
12 | # increment by one | |
13 | $numtests++; | |
14 | ||
15 | } | |
16 | } | |
17 | ||
18 | use Test::More tests => $numtests; | |
19 | ||
20 | use POE; | |
21 | use POE::Component::Client::TCP; | |
22 | use POE::Component::Server::TCP; | |
23 | use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate/; | |
24 | use Net::SSLeay qw/ERROR_WANT_READ ERROR_WANT_WRITE/; | |
25 | use POSIX qw/F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK/; | |
26 | ||
27 | # TODO rewrite this to use Test::POE::Server::TCP and stuff :) | |
28 | ||
29 | my $port; | |
30 | ||
31 | POE::Component::Server::TCP->new | |
32 | ( | |
33 | Alias => 'myserver', | |
34 | Address => '127.0.0.1', | |
35 | Port => 0, | |
36 | ||
37 | Started => sub | |
38 | { | |
39 | use Socket qw/sockaddr_in/; | |
40 | $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0]; | |
41 | }, | |
42 | ClientConnected => sub | |
43 | { | |
44 | ok(1, 'SERVER: accepted'); | |
45 | }, | |
46 | ClientDisconnected => sub | |
47 | { | |
48 | ok(1, 'SERVER: client disconnected'); | |
49 | $_[KERNEL]->post(myserver => 'shutdown'); | |
50 | }, | |
51 | ClientPreConnect => sub | |
52 | { | |
53 | eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') }; | |
54 | eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@); | |
55 | ok(!$@, "SERVER: SSLify_Options $@"); | |
56 | ||
57 | my $socket = eval { Server_SSLify($_[ARG0]) }; | |
58 | ok(!$@, "SERVER: Server_SSLify $@"); | |
59 | ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
60 | ||
61 | my $flags = fcntl($_[ARG0], F_GETFL, 0); | |
62 | ok($flags & O_NONBLOCK, 'SERVER: SSLified socket is non-blocking?'); | |
63 | ||
64 | return ($socket); | |
65 | }, | |
66 | ClientInput => sub | |
67 | { | |
68 | my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; | |
69 | ||
70 | ## At this point, connection MUST be encrypted. | |
71 | my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle); | |
72 | ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher"); | |
73 | ||
74 | if ($request eq 'ping') | |
75 | { | |
76 | ok(1, "SERVER: recv: $request"); | |
77 | $heap->{client}->put("pong"); | |
78 | } | |
79 | }, | |
80 | ClientError => sub | |
81 | { | |
82 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
83 | # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
84 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
85 | ||
86 | # TODO are there other "errors" that is harmless? | |
87 | $error = "Normal disconnection" unless $error; | |
88 | my $msg = "Got SERVER $syscall error $errno: $error"; | |
89 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
90 | fail( $msg ); | |
91 | } else { | |
92 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
93 | } | |
94 | }, | |
95 | ); | |
96 | ||
97 | POE::Component::Client::TCP->new | |
98 | ( | |
99 | Alias => 'myclient', | |
100 | RemoteAddress => '127.0.0.1', | |
101 | RemotePort => $port, | |
102 | Connected => sub | |
103 | { | |
104 | ok(1, 'CLIENT: connected'); | |
105 | ||
106 | $_[HEAP]->{server}->put("ping"); | |
107 | }, | |
108 | PreConnect => sub | |
109 | { | |
110 | my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') }; | |
111 | ok(!$@, "CLIENT: SSLify_ContextCreate $@"); | |
112 | my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) }; | |
113 | ok(!$@, "CLIENT: Client_SSLify $@"); | |
114 | ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
115 | ||
116 | my $flags = fcntl($_[ARG0], F_GETFL, 0); | |
117 | ok($flags & O_NONBLOCK, 'CLIENT: SSLified socket is non-blocking?'); | |
118 | ||
119 | return ($socket); | |
120 | }, | |
121 | ServerInput => sub | |
122 | { | |
123 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
124 | ||
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 | ||
129 | if ($line eq 'pong') | |
130 | { | |
131 | ok(1, "CLIENT: recv: $line"); | |
132 | $kernel->yield('shutdown'); | |
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 | ); | |
151 | ||
152 | $poe_kernel->run(); | |
153 | ||
154 | pass( 'shut down sanely' ); | |
155 | ||
156 | exit 0; |
0 | #!/usr/bin/perl | |
1 | ||
2 | # Thanks to ASCENT for this test! | |
3 | ||
4 | # This test adds renegotiation to the connection | |
5 | # Since this is not supported on all platforms, it's marked TODO and adds custom logic | |
6 | # to make sure it doesn't FAIL if it's not supported. | |
7 | ||
8 | use strict; use warnings; | |
9 | ||
10 | my $numtests; | |
11 | BEGIN { | |
12 | $numtests = 23; | |
13 | ||
14 | eval "use Test::NoWarnings"; | |
15 | if ( ! $@ ) { | |
16 | # increment by one | |
17 | $numtests++; | |
18 | ||
19 | } | |
20 | } | |
21 | ||
22 | use Test::More tests => $numtests; | |
23 | ||
24 | use POE; | |
25 | use POE::Component::Client::TCP; | |
26 | use POE::Component::Server::TCP; | |
27 | use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate/; | |
28 | use Net::SSLeay qw/ERROR_WANT_READ ERROR_WANT_WRITE/; | |
29 | use POSIX qw/F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK/; | |
30 | ||
31 | # TODO rewrite this to use Test::POE::Server::TCP and stuff :) | |
32 | ||
33 | my $port; | |
34 | my $server_ping2; | |
35 | my $client_ping2; | |
36 | ||
37 | POE::Component::Server::TCP->new | |
38 | ( | |
39 | Alias => 'myserver', | |
40 | Address => '127.0.0.1', | |
41 | Port => 0, | |
42 | ||
43 | Started => sub | |
44 | { | |
45 | use Socket qw/sockaddr_in/; | |
46 | $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0]; | |
47 | }, | |
48 | ClientConnected => sub | |
49 | { | |
50 | ok(1, 'SERVER: accepted'); | |
51 | }, | |
52 | ClientDisconnected => sub | |
53 | { | |
54 | ok(1, 'SERVER: client disconnected'); | |
55 | $_[KERNEL]->post(myserver => 'shutdown'); | |
56 | }, | |
57 | ClientPreConnect => sub | |
58 | { | |
59 | eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') }; | |
60 | eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@); | |
61 | ok(!$@, "SERVER: SSLify_Options $@"); | |
62 | ||
63 | my $socket = eval { Server_SSLify($_[ARG0]) }; | |
64 | ok(!$@, "SERVER: Server_SSLify $@"); | |
65 | ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
66 | ||
67 | my $flags = fcntl($_[ARG0], F_GETFL, 0); | |
68 | ok($flags & O_NONBLOCK, 'SERVER: SSLified socket is non-blocking?'); | |
69 | ||
70 | return ($socket); | |
71 | }, | |
72 | ClientInput => sub | |
73 | { | |
74 | my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; | |
75 | ||
76 | ## At this point, connection MUST be encrypted. | |
77 | my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle); | |
78 | ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher"); | |
79 | ||
80 | if ($request eq 'ping') | |
81 | { | |
82 | ok(1, "SERVER: recv: $request"); | |
83 | $heap->{client}->put("pong"); | |
84 | } | |
85 | elsif ($request eq 'ping2') | |
86 | { | |
87 | ok(1, "SERVER: recv: $request"); | |
88 | $server_ping2++; | |
89 | $heap->{client}->put("pong2"); | |
90 | } | |
91 | }, | |
92 | ClientError => sub | |
93 | { | |
94 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
95 | # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
96 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
97 | ||
98 | # TODO are there other "errors" that is harmless? | |
99 | $error = "Normal disconnection" unless $error; | |
100 | my $msg = "Got SERVER $syscall error $errno: $error"; | |
101 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
102 | fail( $msg ); | |
103 | } else { | |
104 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
105 | } | |
106 | }, | |
107 | ); | |
108 | ||
109 | POE::Component::Client::TCP->new | |
110 | ( | |
111 | Alias => 'myclient', | |
112 | RemoteAddress => '127.0.0.1', | |
113 | RemotePort => $port, | |
114 | Connected => sub | |
115 | { | |
116 | ok(1, 'CLIENT: connected'); | |
117 | ||
118 | $_[HEAP]->{server}->put("ping"); | |
119 | }, | |
120 | PreConnect => sub | |
121 | { | |
122 | my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') }; | |
123 | ok(!$@, "CLIENT: SSLify_ContextCreate $@"); | |
124 | my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) }; | |
125 | ok(!$@, "CLIENT: Client_SSLify $@"); | |
126 | ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
127 | ||
128 | my $flags = fcntl($_[ARG0], F_GETFL, 0); | |
129 | ok($flags & O_NONBLOCK, 'CLIENT: SSLified socket is non-blocking?'); | |
130 | ||
131 | return ($socket); | |
132 | }, | |
133 | ServerInput => sub | |
134 | { | |
135 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
136 | ||
137 | ## At this point, connection MUST be encrypted. | |
138 | my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle); | |
139 | ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher"); | |
140 | ||
141 | if ($line eq 'pong') | |
142 | { | |
143 | ok(1, "CLIENT: recv: $line"); | |
144 | ||
145 | # Skip 2 Net::SSLeay::renegotiate() tests on FreeBSD because of | |
146 | # http://security.freebsd.org/advisories/FreeBSD-SA-09:15.ssl.asc | |
147 | TODO: { | |
148 | local $TODO = "Net::SSLeay::renegotiate() does not work on all platforms"; | |
149 | ||
150 | ## Force SSL renegotiation | |
151 | my $ssl = tied(*{$heap->{server}->get_output_handle})->{ssl}; | |
152 | my $reneg_num = Net::SSLeay::num_renegotiations($ssl); | |
153 | ||
154 | ok(1 == Net::SSLeay::renegotiate($ssl), 'CLIENT: SSL renegotiation'); | |
155 | my $handshake = Net::SSLeay::do_handshake($ssl); | |
156 | my $err = Net::SSLeay::get_error($ssl, $handshake); | |
157 | ||
158 | ## 1 == Successful handshake, ERROR_WANT_(READ|WRITE) == non-blocking. | |
159 | ok($handshake == 1 || $err == ERROR_WANT_READ || $err == ERROR_WANT_WRITE, 'CLIENT: SSL handshake'); | |
160 | ok($reneg_num < Net::SSLeay::num_renegotiations($ssl), 'CLIENT: Increased number of negotiations'); | |
161 | } | |
162 | ||
163 | $heap->{server}->put('ping2'); | |
164 | } | |
165 | ||
166 | elsif ($line eq 'pong2') | |
167 | { | |
168 | ok(1, "CLIENT: recv: $line"); | |
169 | $client_ping2++; | |
170 | $kernel->yield('shutdown'); | |
171 | } | |
172 | }, | |
173 | ServerError => sub | |
174 | { | |
175 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
176 | # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
177 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
178 | ||
179 | # TODO are there other "errors" that is harmless? | |
180 | $error = "Normal disconnection" unless $error; | |
181 | my $msg = "Got CLIENT $syscall error $errno: $error"; | |
182 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
183 | fail( $msg ); | |
184 | } else { | |
185 | diag( $msg ) if $ENV{TEST_VERBOSE}; | |
186 | } | |
187 | }, | |
188 | ); | |
189 | ||
190 | $poe_kernel->run(); | |
191 | ||
192 | # Add extra pass() to make the test harness happy if renegotiate did not work | |
193 | if ( ! $server_ping2 ) { | |
194 | local $TODO = "Net::SSLeay::renegotiate() does not work on all platforms"; | |
195 | fail( "SERVER: Failed SSL renegotiation" ); | |
196 | } | |
197 | if ( ! $client_ping2 ) { | |
198 | local $TODO = "Net::SSLeay::renegotiate() does not work on all platforms"; | |
199 | fail( "CLIENT: Failed SSL renegotiation" ); | |
200 | } | |
201 | if ( ! $server_ping2 or ! $client_ping2 ) { | |
202 | diag( "WARNING: Your platform/SSL library does not support renegotiation of the SSL socket." ); | |
203 | diag( "This test harness detected that trying to renegotiate resulted in a disconnected socket." ); | |
204 | diag( "POE::Component::SSLify will work on your system, but please do not attempt a SSL renegotiate." ); | |
205 | diag( "Please talk with the author to figure out if this issue can be worked around, thank you!" ); | |
206 | } | |
207 | ||
208 | pass( 'shut down sanely' ); | |
209 | ||
210 | exit 0; |
0 | #!/usr/bin/perl | |
1 | ||
2 | # Thanks to ASCENT for this test! | |
3 | ||
4 | use strict; use warnings; | |
5 | ||
6 | my $numtests; | |
7 | BEGIN { | |
8 | $numtests = 22; | |
9 | ||
10 | eval "use Test::NoWarnings"; | |
11 | if ( ! $@ ) { | |
12 | # increment by one | |
13 | $numtests++; | |
14 | ||
15 | } | |
16 | } | |
17 | ||
18 | use Test::More tests => $numtests; | |
19 | ||
20 | use POE; | |
21 | use POE::Component::Client::TCP; | |
22 | use POE::Component::Server::TCP; | |
23 | use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate/; | |
24 | use Net::SSLeay qw/ERROR_WANT_READ ERROR_WANT_WRITE/; | |
25 | use POSIX qw/F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK/; | |
26 | ||
27 | # TODO rewrite this to use Test::POE::Server::TCP and stuff :) | |
28 | ||
29 | my $port; | |
30 | ||
31 | POE::Component::Server::TCP->new | |
32 | ( | |
33 | Alias => 'myserver', | |
34 | Address => '127.0.0.1', | |
35 | Port => 0, | |
36 | ||
37 | Started => sub | |
38 | { | |
39 | use Socket qw/sockaddr_in/; | |
40 | $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0]; | |
41 | }, | |
42 | ClientConnected => sub | |
43 | { | |
44 | ok(1, 'SERVER: accepted'); | |
45 | }, | |
46 | ClientDisconnected => sub | |
47 | { | |
48 | ok(1, 'SERVER: client disconnected'); | |
49 | $_[KERNEL]->post(myserver => 'shutdown'); | |
50 | }, | |
51 | ClientPreConnect => sub | |
52 | { | |
53 | eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') }; | |
54 | eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@); | |
55 | ok(!$@, "SERVER: SSLify_Options $@"); | |
56 | ||
57 | my $socket = eval { Server_SSLify($_[ARG0]) }; | |
58 | ok(!$@, "SERVER: Server_SSLify $@"); | |
59 | ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
60 | ||
61 | my $flags = fcntl($_[ARG0], F_GETFL, 0); | |
62 | ok($flags & O_NONBLOCK, 'SERVER: SSLified socket is non-blocking?'); | |
63 | ||
64 | return ($socket); | |
65 | }, | |
66 | ClientInput => sub | |
67 | { | |
68 | my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; | |
69 | ||
70 | ## At this point, connection MUST be encrypted. | |
71 | my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle); | |
72 | ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher"); | |
73 | ||
74 | if ($request eq 'ping') | |
75 | { | |
76 | ok(1, "SERVER: recv: $request"); | |
77 | $heap->{client}->put("pong"); | |
78 | } | |
79 | elsif ($request eq 'ping2') | |
80 | { | |
81 | ok(1, "SERVER: recv: $request"); | |
82 | $heap->{client}->put("pong2"); | |
83 | } | |
84 | }, | |
85 | ClientError => sub | |
86 | { | |
87 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
88 | # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
89 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
90 | ||
91 | # TODO are there other "errors" that is harmless? | |
92 | $error = "Normal disconnection" unless $error; | |
93 | my $msg = "Got SERVER $syscall error $errno: $error"; | |
94 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
95 | fail( $msg ); | |
96 | } else { | |
97 | diag( $msg ); | |
98 | } | |
99 | }, | |
100 | ); | |
101 | ||
102 | POE::Component::Client::TCP->new | |
103 | ( | |
104 | Alias => 'myclient', | |
105 | RemoteAddress => '127.0.0.1', | |
106 | RemotePort => $port, | |
107 | Connected => sub | |
108 | { | |
109 | ok(1, 'CLIENT: connected'); | |
110 | ||
111 | $_[HEAP]->{server}->put("ping"); | |
112 | }, | |
113 | PreConnect => sub | |
114 | { | |
115 | my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') }; | |
116 | ok(!$@, "CLIENT: SSLify_ContextCreate $@"); | |
117 | my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx) }; | |
118 | ok(!$@, "CLIENT: Client_SSLify $@"); | |
119 | ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket)); | |
120 | ||
121 | my $flags = fcntl($_[ARG0], F_GETFL, 0); | |
122 | ok($flags & O_NONBLOCK, 'CLIENT: SSLified socket is non-blocking?'); | |
123 | ||
124 | return ($socket); | |
125 | }, | |
126 | ServerInput => sub | |
127 | { | |
128 | my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0]; | |
129 | ||
130 | ## At this point, connection MUST be encrypted. | |
131 | my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle); | |
132 | ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher"); | |
133 | ||
134 | if ($line eq 'pong') | |
135 | { | |
136 | ok(1, "CLIENT: recv: $line"); | |
137 | ||
138 | # Skip 2 Net::SSLeay::renegotiate() tests on FreeBSD because of | |
139 | # http://security.freebsd.org/advisories/FreeBSD-SA-09:15.ssl.asc | |
140 | TODO: { | |
141 | local $TODO = "Net::SSLeay::renegotiate() does not work on all platforms"; | |
142 | ||
143 | ## Force SSL renegotiation | |
144 | my $ssl = tied(*{$heap->{server}->get_output_handle})->{ssl}; | |
145 | my $reneg_num = Net::SSLeay::num_renegotiations($ssl); | |
146 | ||
147 | ok(1 == Net::SSLeay::renegotiate($ssl), 'CLIENT: SSL renegotiation'); | |
148 | my $handshake = Net::SSLeay::do_handshake($ssl); | |
149 | my $err = Net::SSLeay::get_error($ssl, $handshake); | |
150 | ||
151 | ## 1 == Successful handshake, ERROR_WANT_(READ|WRITE) == non-blocking. | |
152 | ok($handshake == 1 || $err == ERROR_WANT_READ || $err == ERROR_WANT_WRITE, 'CLIENT: SSL handshake'); | |
153 | ok($reneg_num < Net::SSLeay::num_renegotiations($ssl), 'CLIENT: Increased number of negotiations'); | |
154 | } | |
155 | ||
156 | $heap->{server}->put('ping2'); | |
157 | } | |
158 | ||
159 | elsif ($line eq 'pong2') | |
160 | { | |
161 | ok(1, "CLIENT: recv: $line"); | |
162 | $kernel->yield('shutdown'); | |
163 | } | |
164 | }, | |
165 | ServerError => sub | |
166 | { | |
167 | # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0! | |
168 | # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :( | |
169 | my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ]; | |
170 | ||
171 | # TODO are there other "errors" that is harmless? | |
172 | $error = "Normal disconnection" unless $error; | |
173 | my $msg = "Got CLIENT $syscall error $errno: $error"; | |
174 | unless ( $syscall eq 'read' and $errno == 0 ) { | |
175 | fail( $msg ); | |
176 | } else { | |
177 | diag( $msg ); | |
178 | } | |
179 | }, | |
180 | ); | |
181 | ||
182 | $poe_kernel->run(); | |
183 | exit 0; |