Codebase list libpoe-component-sslify-perl / 9700e8d
massive doc revamp Apocalypse 13 years ago
7 changed file(s) with 160 addition(s) and 478 deletion(s). Raw diff Collapse all Expand all
+2
-0
Changes less more
88 Add the ability to pass a subref to call on connection/negotiation success, thanks Zephaniah E. Loss-Cutler-Hull <warp-spam_perl@aehallh.com>
99 NOTE: This will not work if you do renegotiation or any other zany SSL stuff!
1010 Add the SSLify_GetStatus function to get the status of the connection
11 After staring at the Net::SSLeay/OpenSSL docs for a while I realized we were missing support for sslv23 version, added!
12 After some investigation, we now load all default ENGINEs for OpenSSL on startup, as it might provide a performance boost
1113
1214 1.003
1315 Released: 2011-02-28 15:52:24 UTC
+148
-132
lib/POE/Component/SSLify.pm less more
1919 # Taken from http://search.cpan.org/~flora/Net-SSLeay-1.36/lib/Net/SSLeay.pm#Low_level_API
2020 Net::SSLeay::load_error_strings();
2121 Net::SSLeay::SSLeay_add_ssl_algorithms();
22 # TODO do we need this?
23 #Net::SSLeay::ENGINE_load_builtin_engines(); # If you want built-in engines
24 #Net::SSLeay::ENGINE_register_all_complete(); # If you want built-in engines
22 Net::SSLeay::ENGINE_load_builtin_engines();
23 Net::SSLeay::ENGINE_register_all_complete();
2524 Net::SSLeay::randomize();
2625 }
2726 }
5352
5453 =func Client_SSLify
5554
56 Accepts a socket, returns a brand new socket SSLified. Optionally accepts SSL
57 context data. Also accepts a subref to call when connection/negotiation is done.
58
59 my $socket = shift; # get the socket from somewhere
60 $socket = Client_SSLify( $socket ); # the default
61 $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context
62 $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context
63 $socket = Client_SSLify( $socket, sub { warn "CONNECTED" } ); # call your connection function
64
65 If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify
66 will create it from the $version + $options parameters.
67
68 Known versions:
69 * sslv2
70 * sslv3
71 * tlsv1
72 * default
73
74 By default we use the version: default
75
76 By default we don't set any options
55 This function sslifies a client-side socket. You can pass several options to it:
56
57 my $socket = shift;
58 $socket = Client_SSLify( $socket, $version, $options, $ctx, $callback );
59 $socket is the non-ssl socket you got from somewhere ( probably SocketFactory )
60 $version is the SSL version you want to use, see SSLify_ContextCreate
61 $options is the SSL options you want to use, see SSLify_ContextCreate
62 $ctx is the custom SSL context you want to use, see SSLify_ContextCreate
63 $callback is the callback hook on success/failure of sslification
64
65 sub callback {
66 my( $socket, $status, $errval ) = @_;
67 # $socket is the original sslified socket in case you need to play with it
68 # $status is either 'OK' or 'ERR'
69 # $errval will be defined if $status eq 'ERR' - it's the numeric SSL error code
70 }
71
72 If $ctx is defined, SSLify will ignore $version and $options. Otherwise, it will be created from the $version and
73 $options parameters. If all of them are undefined, it will follow the defaults in L</SSLify_ContextCreate>.
74
75 BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the
76 socket is destroyed. This means you cannot reuse contexts!
7777
7878 NOTE: The way to have a client socket with proper certificates set up is:
7979
8181 my $ctx = SSLify_ContextCreate( 'server.key', 'server.crt' );
8282 $socket = Client_SSLify( $socket, undef, undef, $ctx );
8383
84 BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the
85 socket is destroyed. This means you cannot reuse contexts!
86
87 NOTE: You can pass the subref anywhere in the arguments, we'll figure it out for you! If you want to call a POE event, please look
88 into the postback/callback stuff in POE::Session. The subref will get the socket as the sole argument.
84 NOTE: You can pass the callback anywhere in the arguments, we'll figure it out for you! If you want to call a POE event, please look
85 into the postback/callback stuff in POE::Session.
8986
9087 $socket = Client_SSLify( $socket, $session->callback( 'got_connect' => @args ) );
88
9189 =cut
9290
9391 sub Client_SSLify {
94 # Get the socket + version + options + ctx
95 my( $socket, $version, $options, $ctx, $connref ) = @_;
92 # Get the socket + version + options + ctx + callback
93 my( $socket, $version, $options, $ctx, $callback ) = @_;
9694
9795 # Validation...
9896 if ( ! defined $socket ) {
9997 die "Did not get a defined socket";
10098 }
10199
102 # Mangle the connref stuff
100 # Mangle the callback stuff
103101 if ( defined $version and ref $version and ref( $version ) eq 'CODE' ) {
104 $connref = $version;
102 $callback = $version;
105103 $version = $options = $ctx = undef;
106104 } elsif ( defined $options and ref $options and ref( $options ) eq 'CODE' ) {
107 $connref = $options;
105 $callback = $options;
108106 $options = $ctx = undef;
109107 } elsif ( defined $ctx and ref $ctx and ref( $ctx ) eq 'CODE' ) {
110 $connref = $ctx;
108 $callback = $ctx;
111109 $ctx = undef;
112110 }
113111
119117
120118 # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle
121119 my $newsock = gensym();
122 tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx, $connref ) or die "Unable to tie to our subclass: $!";
123
124 # argh, store the newsock in the tied class to use for connref
125 if ( defined $connref ) {
120 tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx, $callback ) or die "Unable to tie to our subclass: $!";
121
122 # argh, store the newsock in the tied class to use for callback
123 if ( defined $callback ) {
126124 tied( *$newsock )->{'orig_socket'} = $newsock;
127125 weaken( tied( *$newsock )->{'orig_socket'} );
128126 }
133131
134132 =func Server_SSLify
135133
136 Accepts a socket, returns a brand new socket SSLified. Also accepts a custom context. Also accepts a subref
137 to call when connection/negotiation is done.
138
139 my $socket = shift; # get the socket from somewhere
140 $socket = Server_SSLify( $socket ); # the default
141 $socket = Server_SSLify( $socket, $ctx ); # use your custom context
142 $socket = Server_SSLify( $socket, sub { warn "CONNECTED" } ); # call your connection function
143
144 NOTE: SSLify_Options must be set first!
145
146 Furthermore, you can pass in your own $ctx object if you desire. This allows you to set custom parameters
147 per-connection, for example.
134 This function sslifies a server-side socket. You can pass several options to it:
135
136 my $socket = shift;
137 $socket = Server_SSLify( $socket, $ctx, $callback );
138 $socket is the non-ssl socket you got from somewhere ( probably SocketFactory )
139 $ctx is the custom SSL context you want to use, see SSLify_ContextCreate ( overrides the global set in SSLify_Options )
140 $callback is the callback hook on success/failure of sslification
141
142 sub callback {
143 my( $socket, $status, $errval ) = @_;
144 # $socket is the original sslified socket in case you need to play with it
145 # $status is either 'OK' or 'ERR'
146 # $errval will be defined if $status eq 'ERR' - it's the numeric SSL error code
147 }
148
149 NOTE: SSLify_Options must be set first if you aren't passing a $ctx. If you want to set some options per-connection, do this:
148150
149151 my $socket = shift; # get the socket from somewhere
150152 my $ctx = SSLify_ContextCreate();
154156 NOTE: You can use SSLify_GetCTX to modify the global, and avoid doing this on every connection if the
155157 options are the same...
156158
157 NOTE: You can pass the subref anywhere in the arguments, we'll figure it out for you! If you want to call a POE event, please look
158 into the postback/callback stuff in POE::Session. The subref will get the socket as the sole argument.
159 NOTE: You can pass the callback anywhere in the arguments, we'll figure it out for you! If you want to call a POE event, please look
160 into the postback/callback stuff in POE::Session.
159161
160162 $socket = Server_SSLify( $socket, $session->callback( 'got_connect' => @args ) );
161163 =cut
162164
163165 sub Server_SSLify {
164166 # Get the socket!
165 my( $socket, $custom_ctx, $connref ) = @_;
167 my( $socket, $custom_ctx, $callback ) = @_;
166168
167169 # Validation...
168170 if ( ! defined $socket ) {
174176 die 'Please do SSLify_Options() first ( or pass in a $ctx object )';
175177 }
176178
177 # mangle custom_ctx depending on connref
179 # mangle custom_ctx depending on callback
178180 if ( defined $custom_ctx and ref $custom_ctx and ref( $custom_ctx ) eq 'CODE' ) {
179 $connref = $custom_ctx;
181 $callback = $custom_ctx;
180182 $custom_ctx = undef;
181183 }
182184
188190
189191 # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle
190192 my $newsock = gensym();
191 tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, ( $custom_ctx || $ctx ), $connref ) or die "Unable to tie to our subclass: $!";
193 tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, ( $custom_ctx || $ctx ), $callback ) or die "Unable to tie to our subclass: $!";
192194
193195 # argh, store the newsock in the tied class to use for connref
194 if ( defined $connref ) {
196 if ( defined $callback ) {
195197 tied( *$newsock )->{'orig_socket'} = $newsock;
196198 weaken( tied( *$newsock )->{'orig_socket'} );
197199 }
202204
203205 =func SSLify_ContextCreate
204206
205 Accepts some options, and returns a brand-new Net::SSLeay context object ( $ctx )
206 my $ctx = SSLify_ContextCreate( $key, $cert, $version, $options );
207
208 You can then call various Net::SSLeay methods on the context
209 my $mode = Net::SSLeay::CTX_get_mode( $ctx );
210
211 By default we don't use the SSL key + certificate files
212
213 By default we use the version: default
214
215 Known versions:
216 * sslv2
217 * sslv3
218 * tlsv1
219 * default
220
221 By default we don't set any options
207 Accepts some options, and returns a brand-new Net::SSLeay context object ( $ctx )
208
209 my $ctx = SSLify_ContextCreate( $key, $cert, $version, $options );
210 $key is the certificate key file
211 $cert is the certificate file
212 $version is the SSL version to use
213 $options is the SSL options to use
214
215 You can then call various Net::SSLeay methods on the context
216
217 my $mode = Net::SSLeay::CTX_get_mode( $ctx );
218
219 By default we don't use the SSL key + certificate files
220
221 By default we use the version: default. Known versions of the SSL connection - look at
222 L<http://www.openssl.org/docs/ssl/SSL_CTX_new.html> for more info.
223
224 * sslv2
225 * sslv3
226 * tlsv1
227 * sslv23
228 * default ( sslv23 )
229
230 By default we don't set any options - look at L<http://www.openssl.org/docs/ssl/SSL_CTX_set_options.html> for more info.
222231 =cut
223232
224233 sub SSLify_ContextCreate {
230239
231240 =func SSLify_Options
232241
233 Call this function to initialize the global server-side CTX. Accepts the location of the
234 SSL key + certificate files, which is required.
235
236 Optionally accepts the SSL version + CTX options
237 SSLify_Options( $key, $cert, $version, $options );
238
239 By default we use the version: default
240
241 Known versions:
242 * sslv2
243 * sslv3
244 * tlsv1
245 * default
246
247 By default we use the options: &Net::SSLeay::OP_ALL
242 Call this function to initialize the global server-side context object. This will be the default context whenever you call
243 L</Server_SSLify> without passing a custom context to it.
244
245 SSLify_Options( $key, $cert, $version, $options );
246 $key is the certificate key file ( required )
247 $cert is the certificate file ( required )
248 $version is the SSL version to use
249 $options is the SSL options to use
250
251 By default we use the version: default
252
253 By default we use the options: &Net::SSLeay::OP_ALL
254
255 Please look at L</SSLify_ContextCreate> for more info on the available versions/options.
248256 =cut
249257
250258 sub SSLify_Options {
283291 $context = Net::SSLeay::CTX_v3_new();
284292 } elsif ( $version eq 'tlsv1' ) {
285293 $context = Net::SSLeay::CTX_tlsv1_new();
294 } elsif ( $version eq 'sslv23' ) {
295 $context = Net::SSLeay::CTX_v23_new();
286296 } elsif ( $version eq 'default' ) {
287297 $context = Net::SSLeay::CTX_new();
288298 } else {
321331
322332 =func SSLify_GetCTX
323333
324 Returns the actual Net::SSLeay context object in case you wanted to play with it :)
325
326 If passed in a socket, it will return that socket's $ctx instead of the global.
327 my $ctx = SSLify_GetCTX(); # get the one set via SSLify_Options
328 my $ctx = SSLify_GetCTX( $sslified_sock ); # get the one in the object
334 Returns the actual Net::SSLeay context object in case you wanted to play with it :)
335
336 If passed in a socket, it will return that socket's $ctx instead of the global.
337
338 my $ctx = SSLify_GetCTX(); # get the one set via SSLify_Options
339 my $ctx = SSLify_GetCTX( $sslified_sock ); # get the one in the object
329340 =cut
330341
331342 sub SSLify_GetCTX {
339350
340351 =func SSLify_GetCipher
341352
342 Returns the cipher used by the SSLified socket
343
344 Example:
345 print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n";
346
347 NOTE: Doing this immediately after Client_SSLify or Server_SSLify will result in "(NONE)" because the SSL handshake
348 is not done yet. The socket is nonblocking, so you will have to wait a little bit for it to get ready.
349 apoc@blackhole:~/mygit/perl-poe-sslify/examples$ perl serverclient.pl
350 got connection from: 127.0.0.1 - commencing Server_SSLify()
351 SSLified: 127.0.0.1 cipher type: ((NONE))
352 Connected to server, commencing Client_SSLify()
353 SSLified the connection to the server
354 Connected to SSL server
355 Input: hola
356 got input from: 127.0.0.1 cipher type: (AES256-SHA) input: 'hola'
357 Got Reply: hola
358 Input: ^C
359 stopped at serverclient.pl line 126.
353 Returns the cipher used by the SSLified socket
354
355 print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n";
356
357 NOTE: Doing this immediately after Client_SSLify or Server_SSLify will result in "(NONE)" because the SSL handshake
358 is not done yet. The socket is nonblocking, so you will have to wait a little bit for it to get ready.
359
360 apoc@blackhole:~/mygit/perl-poe-sslify/examples$ perl serverclient.pl
361 got connection from: 127.0.0.1 - commencing Server_SSLify()
362 SSLified: 127.0.0.1 cipher type: ((NONE))
363 Connected to server, commencing Client_SSLify()
364 SSLified the connection to the server
365 Connected to SSL server
366 Input: hola
367 got input from: 127.0.0.1 cipher type: (AES256-SHA) input: 'hola'
368 Got Reply: hola
369 Input: ^C
370 stopped at serverclient.pl line 126.
360371 =cut
361372
362373 sub SSLify_GetCipher {
366377
367378 =func SSLify_GetSocket
368379
369 Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname()
370
371 Example:
372 print "Remote IP is: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[1] ) . "\n";
380 Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname()
381
382 print "Remote IP is: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[1] ) . "\n";
373383 =cut
374384
375385 sub SSLify_GetSocket {
379389
380390 =func SSLify_GetSSL
381391
382 Returns the actual Net::SSLeay object so you can call methods on it
383
384 Example:
385 print Net::SSLeay::dump_peer_certificate( SSLify_GetSSL( $sslified_sock ) );
392 Returns the actual Net::SSLeay object so you can call methods on it
393
394 print Net::SSLeay::dump_peer_certificate( SSLify_GetSSL( $sslified_sock ) );
386395 =cut
387396
388397 sub SSLify_GetSSL {
392401
393402 =func SSLify_GetStatus
394403
395 Returns the status of the SSL negotiation/handshake/connection.
396
397 -1 == still in negotiation stage
398 0 == internal SSL error, connection will be dead
399 1 == negotiation successful
404 Returns the status of the SSL negotiation/handshake/connection.
405
406 my $status = SSLify_GetStatus( $socket );
407 -1 = still in negotiation stage
408 0 = internal SSL error, connection will be dead
409 1 = negotiation successful
400410 =cut
401411
402412 sub SSLify_GetStatus {
473483
474484 =head2 Socket methods doesn't work
475485
476 The new socket this module gives you actually is some tied socket magic, so you cannot do stuff like
486 The new socket this module gives you actually is tied socket magic, so you cannot do stuff like
477487 getpeername() or getsockname(). The only way to do it is to use L</SSLify_GetSocket> and then operate on
478488 the socket it returns.
479489
520530 L<http://security.freebsd.org/advisories/FreeBSD-SA-09:15.ssl.asc> which explains it in detail. The test will skip this function
521531 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.
522532
523 NOTE: Calling this means the connection function you passed in L</Client_SSLify> or L</Server_SSLify> will not fire! If you need this
533 NOTE: Calling this means the callback function you passed in L</Client_SSLify> or L</Server_SSLify> will not fire! If you need this
524534 please let me know and we can come up with a way to make it work.
525535
526 =head2 In-Situ sslification
536 =head2 Upgrading a non-ssl socket to SSL
527537
528538 You can have a normal plaintext socket, and convert it to SSL anytime. Just keep in mind that the client and the server must agree to sslify
529 at the same time, or they will be waiting on each other forever! See C<t/3_insitu.t> for an example of how this works.
539 at the same time, or they will be waiting on each other forever! See C<t/3_upgrade.t> for an example of how this works.
540
541 =head2 Downgrading a SSL socket to non-ssl
542
543 As of now this is unsupported. If you need this feature please let us know and we'll work on it together!
530544
531545 =head2 MSWin32 is not supported
532546
535549
536550 =head1 EXPORT
537551
538 Stuffs all of the above functions in @EXPORT_OK so you have to request them directly
552 Stuffs all of the functions in @EXPORT_OK so you have to request them directly.
539553
540554 =head1 SEE ALSO
541555 POE
555569 ASCENT also helped a lot with the nonblocking mode, without his hard work this
556570 module would still be stuck in the stone age :)
557571
558 =cut
572 A lot of people helped add various features/functions - please look at the changelog for more detail.
573
574 =cut
+2
-2
t/1_simple.t less more
00 #!/usr/bin/perl
1 use strict; use warnings;
12
23 # Thanks to ASCENT for this test!
3
4 use strict; use warnings;
4 # This tests the basic functionality of sslify on client/server side
55
66 my $numtests;
77 BEGIN {
+4
-6
t/2_renegotiate.t less more
00 #!/usr/bin/perl
1 use strict; use warnings;
12
23 # Thanks to ASCENT for this test!
3
4 # This test adds renegotiation to the connection
4 # This test adds renegotiation to the connection from client-side
55 # Since this is not supported on all platforms, it's marked TODO and adds custom logic
66 # to make sure it doesn't FAIL if it's not supported.
7
8 use strict; use warnings;
97
108 my $numtests;
119 BEGIN {
2321 use POE 1.267;
2422 use POE::Component::Client::TCP;
2523 use POE::Component::Server::TCP;
26 use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate SSLify_GetSocket/;
24 use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate SSLify_GetSocket SSLify_GetSSL/;
2725 use Net::SSLeay qw/ERROR_WANT_READ ERROR_WANT_WRITE/;
2826
2927 # TODO rewrite this to use Test::POE::Server::TCP and stuff :)
146144 local $TODO = "Net::SSLeay::renegotiate() does not work on all platforms";
147145
148146 ## Force SSL renegotiation
149 my $ssl = tied(*{$heap->{server}->get_output_handle})->{ssl};
147 my $ssl = SSLify_GetSSL( $heap->{server}->get_output_handle );
150148 my $reneg_num = Net::SSLeay::num_renegotiations($ssl);
151149
152150 ok(1 == Net::SSLeay::renegotiate($ssl), 'CLIENT: SSL renegotiation');
+0
-184
t/3_insitu.t less more
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 = 18;
9
10 eval "use Test::NoWarnings";
11 if ( ! $@ ) {
12 # increment by one
13 $numtests++;
14 }
15 }
16
17 use Test::More tests => $numtests;
18
19 use POE 1.267;
20 use POE::Component::Client::TCP;
21 use POE::Component::Server::TCP;
22 use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate SSLify_GetSocket/;
23
24 # TODO rewrite this to use Test::POE::Server::TCP and stuff :)
25
26 my $port;
27
28 POE::Component::Server::TCP->new
29 (
30 Alias => 'myserver',
31 Address => '127.0.0.1',
32 Port => 0,
33
34 Started => sub
35 {
36 use Socket qw/sockaddr_in/;
37 $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0];
38 },
39 ClientConnected => sub
40 {
41 ok(1, 'SERVER: accepted');
42 },
43 ClientDisconnected => sub
44 {
45 ok(1, 'SERVER: client disconnected');
46 $_[KERNEL]->post(myserver => 'shutdown');
47 },
48 ClientInput => sub
49 {
50 my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
51
52 if ( $line eq 'plaintext_ping' ) {
53 ok(1, "SERVER: recv: $line");
54 $heap->{client}->put('plaintext_pong');
55 $heap->{client}->flush; # make sure we sent the pong
56
57 # sslify it in-situ!
58 eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') };
59 eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@);
60 ok(!$@, "SERVER: SSLify_Options $@");
61 my $socket = eval { Server_SSLify($heap->{client}->get_output_handle) };
62 ok(!$@, "SERVER: Server_SSLify $@");
63 ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket));
64
65 # We pray that IO::Handle is sane...
66 ok( SSLify_GetSocket( $socket )->blocking == 0, 'SERVER: SSLified socket is non-blocking?');
67
68 # TODO evil code here, ha!
69 # Should I ask rcaputo to add a $rw->replace_handle($socket) method?
70 # if you don't do the undef and just replace it - you'll get a bad file descriptor error from POE!
71 # <fh> select error: Bad file descriptor (hits=-1)
72 undef $heap->{client};
73 $heap->{client} = POE::Wheel::ReadWrite->new(
74 Handle => $socket,
75 InputEvent => 'tcp_server_got_input',
76 ErrorEvent => 'tcp_server_got_error',
77 FlushedEvent => 'tcp_server_got_flush',
78 );
79 } elsif ( $line eq 'ssl_ping' ) {
80 ok(1, "SERVER: recv: $line");
81
82 ## At this point, connection MUST be encrypted.
83 my $cipher = SSLify_GetCipher($heap->{client}->get_output_handle);
84 ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher");
85
86 $heap->{client}->put('ssl_pong');
87 } else {
88 die "Unknown line from CLIENT: $line";
89 }
90 },
91 ClientError => sub
92 {
93 # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0!
94 # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :(
95 my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ];
96
97 # TODO are there other "errors" that is harmless?
98 $error = "Normal disconnection" unless $error;
99 my $msg = "Got SERVER $syscall error $errno: $error";
100 unless ( $syscall eq 'read' and $errno == 0 ) {
101 fail( $msg );
102 } else {
103 diag( $msg ) if $ENV{TEST_VERBOSE};
104 }
105 },
106 );
107
108 POE::Component::Client::TCP->new
109 (
110 Alias => 'myclient',
111 RemoteAddress => '127.0.0.1',
112 RemotePort => $port,
113 Connected => sub
114 {
115 ok(1, 'CLIENT: connected');
116
117 $_[HEAP]->{server}->put("plaintext_ping");
118 },
119 ServerInput => sub
120 {
121 my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
122
123 if ( $line eq 'plaintext_pong' ) {
124 ok(1, "CLIENT: recv: $line");
125
126 # sslify it in-situ!
127 my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') };
128 ok(!$@, "CLIENT: SSLify_ContextCreate $@");
129 my $socket = eval { Client_SSLify($heap->{server}->get_output_handle, undef, undef, $ctx) };
130 ok(!$@, "CLIENT: Client_SSLify $@");
131 ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket));
132
133 # We pray that IO::Handle is sane...
134 ok( SSLify_GetSocket( $socket )->blocking == 0, 'CLIENT: SSLified socket is non-blocking?');
135
136 # TODO evil code here, ha!
137 # Should I ask rcaputo to add a $rw->replace_handle($socket) method?
138 # if you don't do the undef and just replace it - you'll get a bad file descriptor error from POE!
139 # <fh> select error: Bad file descriptor (hits=-1)
140 undef $heap->{server};
141 $heap->{server} = POE::Wheel::ReadWrite->new(
142 Handle => $socket,
143 InputEvent => 'got_server_input',
144 ErrorEvent => 'got_server_error',
145 FlushedEvent => 'got_server_flush',
146 );
147
148 # Send the ssl ping!
149 $heap->{server}->put('ssl_ping');
150 } elsif ( $line eq 'ssl_pong' ) {
151 ok(1, "CLIENT: recv: $line");
152
153 ## At this point, connection MUST be encrypted.
154 my $cipher = SSLify_GetCipher($heap->{server}->get_output_handle);
155 ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher");
156
157 $kernel->yield('shutdown');
158 } else {
159 die "Unknown line from SERVER: $line";
160 }
161 },
162 ServerError => sub
163 {
164 # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0!
165 # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :(
166 my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ];
167
168 # TODO are there other "errors" that is harmless?
169 $error = "Normal disconnection" unless $error;
170 my $msg = "Got CLIENT $syscall error $errno: $error";
171 unless ( $syscall eq 'read' and $errno == 0 ) {
172 fail( $msg );
173 } else {
174 diag( $msg ) if $ENV{TEST_VERBOSE};
175 }
176 },
177 );
178
179 $poe_kernel->run();
180
181 pass( 'shut down sanely' );
182
183 exit 0;
+0
-150
t/4_connref.t less more
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 = 17;
9
10 eval "use Test::NoWarnings";
11 if ( ! $@ ) {
12 # increment by one
13 $numtests++;
14 }
15 }
16
17 use Test::More tests => $numtests;
18
19 use POE 1.267;
20 use POE::Component::Client::TCP;
21 use POE::Component::Server::TCP;
22 use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_GetSocket SSLify_GetStatus/;
23
24 # TODO rewrite this to use Test::POE::Server::TCP and stuff :)
25
26 my $port;
27
28 POE::Component::Server::TCP->new
29 (
30 Alias => 'myserver',
31 Address => '127.0.0.1',
32 Port => 0,
33
34 Started => sub
35 {
36 use Socket qw/sockaddr_in/;
37 $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0];
38 },
39 ClientConnected => sub
40 {
41 ok(1, 'SERVER: accepted');
42 },
43 ClientDisconnected => sub
44 {
45 ok(1, 'SERVER: client disconnected');
46 $_[KERNEL]->post( 'myserver' => 'shutdown');
47 },
48 ClientPreConnect => sub
49 {
50 eval { SSLify_Options('mylib/example.key', 'mylib/example.crt') };
51 eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt') } if ($@);
52 ok(!$@, "SERVER: SSLify_Options $@");
53
54 my $socket = eval { Server_SSLify( $_[ARG0], sub {
55 my( $socket, $status, $errval ) = @_;
56
57 pass( "SERVER: Got connect hook" );
58 is( $status, 'OK', "SERVER: Status received from callback is OK" );
59
60 ## At this point, connection MUST be encrypted.
61 my $cipher = SSLify_GetCipher($socket);
62 ok($cipher ne '(NONE)', "SERVER: SSLify_GetCipher: $cipher");
63 ok( SSLify_GetStatus($socket) == 1, "SERVER: SSLify_GetStatus is done" );
64 } ) };
65 ok(!$@, "SERVER: Server_SSLify $@");
66 ok( SSLify_GetStatus($socket) == -1, "SERVER: SSLify_GetStatus is pending" );
67
68 return ($socket);
69 },
70 ClientInput => sub
71 {
72 my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
73
74 die "Unknown line from CLIENT: $line";
75 },
76 ClientError => sub
77 {
78 # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0!
79 # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :(
80 my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ];
81
82 # TODO are there other "errors" that is harmless?
83 $error = "Normal disconnection" unless $error;
84 my $msg = "Got SERVER $syscall error $errno: $error";
85 unless ( $syscall eq 'read' and $errno == 0 ) {
86 fail( $msg );
87 } else {
88 diag( $msg ) if $ENV{TEST_VERBOSE};
89 }
90 },
91 );
92
93 POE::Component::Client::TCP->new
94 (
95 Alias => 'myclient',
96 RemoteAddress => '127.0.0.1',
97 RemotePort => $port,
98 Connected => sub
99 {
100 ok(1, 'CLIENT: connected');
101 },
102 PreConnect => sub
103 {
104 my $socket = eval { Client_SSLify($_[ARG0], sub {
105 my( $socket, $status, $errval ) = @_;
106
107 pass( "CLIENT: Got connect hook" );
108 is( $status, 'OK', "CLIENT: Status received from callback is OK" );
109
110 ## At this point, connection MUST be encrypted.
111 my $cipher = SSLify_GetCipher($socket);
112 ok($cipher ne '(NONE)', "CLIENT: SSLify_GetCipher: $cipher");
113 ok( SSLify_GetStatus($socket) == 1, "CLIENT: SSLify_GetStatus is done" );
114
115 $poe_kernel->post( 'myclient' => 'shutdown' );
116 }) };
117 ok(!$@, "CLIENT: Client_SSLify $@");
118 ok( SSLify_GetStatus($socket) == -1, "CLIENT: SSLify_GetStatus is pending" );
119
120 return ($socket);
121 },
122 ServerInput => sub
123 {
124 my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
125
126 die "Should have never got any input from the server!";
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 );
144
145 $poe_kernel->run();
146
147 pass( 'shut down sanely' );
148
149 exit 0;
+4
-4
t/5_connfail_client.t less more
00 #!/usr/bin/perl
1 use strict; use warnings;
12
2 # Thanks to ASCENT for this test!
3
4 use strict; use warnings;
3 # this tests the connection fail hook on the client-side
54
65 my $numtests;
76 BEGIN {
8887
8988 pass( "CLIENT: Got connect hook" );
9089 is( $status, 'ERR', "CLIENT: Status received from callback is ERR - $errval" );
90 is( SSLify_GetStatus( $socket ), 0, "CLIENT: SSLify_GetStatus is error" );
9191
9292 $poe_kernel->post( 'myclient' => 'shutdown' );
9393 }) };
9494 ok(!$@, "CLIENT: Client_SSLify $@");
95 ok( SSLify_GetStatus($socket) == -1, "CLIENT: SSLify_GetStatus is pending" );
95 is( SSLify_GetStatus( $socket ), -1, "CLIENT: SSLify_GetStatus is pending" );
9696
9797 return ($socket);
9898 },