Codebase list libpoe-component-sslify-perl / def0826
add GetStatus and finalize connref stuff Apocalypse 11 years ago
5 changed file(s) with 56 addition(s) and 171 deletion(s). Raw diff Collapse all Expand all
+4
-0
Changes less more
44 We now load certificate files via CTX_use_certificate_chain_file(), thanks Zephaniah E. Loss-Cutler-Hull <warp-spam_perl@aehallh.com>
55 OpenSSL docs suggest it - http://www.openssl.org/docs/ssl/SSL_CTX_use_certificate.html#NOTES
66 PLEASE yell at me if you need the old functionality - the docs suggest this is the "better" way to do it...
7
8 Add the ability to pass a subref to call on connection/negotiation success, thanks Zephaniah E. Loss-Cutler-Hull <warp-spam_perl@aehallh.com>
9 NOTE: This will not work if you do a renegotiation or any other zany SSL stuff!
10 Add the SSLify_GetStatus function to get the status of the connection
711
812 1.003
913 Released: 2011-02-28 15:52:24 UTC
+1
-1
lib/POE/Component/SSLify/ClientHandle.pm less more
2828 # again, because OpenSSL I/O functions (read, write, ...) can handle that entirely
2929 # by self (it's needed to connect() once to determine connection type).
3030 my $res = Net::SSLeay::connect( $ssl ) or die_if_ssl_error( 'ssl connect' );
31 #warn "Net::SSLeay::connect(TIEHANDLE) -> $res";
31
3232 my $self = bless {
3333 'ssl' => $ssl,
3434 'ctx' => $ctx,
+14
-23
lib/POE/Component/SSLify/ServerHandle.pm less more
1919 # again, because OpenSSL I/O functions (read, write, ...) can handle that entirely
2020 # by self (it's needed to accept() once to determine connection type).
2121 my $res = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' );
22 #warn "Net::SSLeay::accept(TIEHANDLE) -> $res";
22
2323 my $self = bless {
2424 'ssl' => $ssl,
2525 'ctx' => $ctx,
3434
3535 sub _check_status {
3636 my $self = shift;
37 my $method = shift;
3837
3938 # Okay, is negotiation done?
4039 # http://www.openssl.org/docs/ssl/SSL_connect.html#RETURN_VALUES
41 if ( $self->{'status'} == -1 ) {
42 # client or server?
43 my $res;
44 if ( exists $self->{'client'} ) {
45 $res = Net::SSLeay::connect( $self->{'ssl'} );
46 # warn "Net::SSLeay::connect($method) -> $res";
47 } else {
48 $res = Net::SSLeay::accept( $self->{'ssl'} );
49 # warn "Net::SSLeay::accept($method) -> $res";
50 }
51
52 if ( $res == 0 ) {
53 # TODO error?
54 } elsif ( $res == 1 ) {
55 $self->{'status'} = 1;
56
57 # call the hook function for successful connect
58 $self->{'on_connect'}->( $self ) if defined $self->{'on_connect'};
59 }
40 if ( exists $self->{'client'} ) {
41 $self->{'status'} = Net::SSLeay::connect( $self->{'ssl'} );
42 } else {
43 $self->{'status'} = Net::SSLeay::accept( $self->{'ssl'} );
44 }
45
46 if ( $self->{'status'} == 0 ) {
47 # TODO error?
48 } elsif ( $self->{'status'} == 1 ) {
49 # call the hook function for successful connect
50 $self->{'on_connect'}->( $self->{'orig_socket'} ) if defined $self->{'on_connect'};
6051 }
6152 }
6253
6960 my( $buf, $len, $offset ) = \( @_ );
7061
7162 # Check connection status
72 $self->_check_status( 'READ' );
63 $self->_check_status if $self->{'status'} == -1;
7364
7465 # If we have no offset, replace the buffer with some input
7566 if ( ! defined $$offset ) {
109100 my( $self, $buf, $len, $offset ) = @_;
110101
111102 # Check connection status
112 $self->_check_status( 'WRITE' );
103 $self->_check_status if $self->{'status'} == -1;
113104
114105 # If we have nothing to offset, then start from the beginning
115106 if ( ! defined $offset ) {
+37
-4
lib/POE/Component/SSLify.pm less more
2929 # Do the exporting magic...
3030 require Exporter;
3131 our @ISA = qw( Exporter );
32 our @EXPORT_OK = qw( Client_SSLify Server_SSLify SSLify_Options SSLify_GetCTX SSLify_GetCipher SSLify_GetSocket SSLify_GetSSL SSLify_ContextCreate );
32 our @EXPORT_OK = qw(
33 Client_SSLify Server_SSLify
34 SSLify_Options SSLify_GetCTX SSLify_GetCipher SSLify_GetSocket SSLify_GetSSL SSLify_ContextCreate SSLify_GetStatus
35 );
3336
3437 # Bring in some socket-related stuff
3538 use Symbol qw( gensym );
3740 # we need IO 1.24 for it's win32 fixes but it includes IO::Handle 1.27_02 which is dev...
3841 # unfortunately we have to jump to IO 1.25 which includes IO::Handle 1.28... argh!
3942 use IO::Handle 1.28;
43
44 # Use Scalar::Util's weaken() for the connref stuff
45 use Scalar::Util qw( weaken );
46 use Task::Weaken 1.03; # to make sure it actually works!
4047
4148 # The server-side CTX stuff
4249 my $ctx = undef;
5360 $socket = Client_SSLify( $socket ); # the default
5461 $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context
5562 $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context
56 $socket = Client_SSLify( $socket, sub { print "CONNECTED" } ); # call your connection function
63 $socket = Client_SSLify( $socket, sub { warn "CONNECTED" } ); # call your connection function
5764
5865 If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify
5966 will create it from the $version + $options parameters.
114121 my $newsock = gensym();
115122 tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx, $connref ) or die "Unable to tie to our subclass: $!";
116123
124 # argh, store the newsock in the tied class to use for connref
125 if ( defined $connref ) {
126 tied( *$newsock )->{'orig_socket'} = $newsock;
127 weaken( tied( *$newsock )->{'orig_socket'} );
128 }
129
117130 # All done!
118131 return $newsock;
119132 }
124137 to call when connection/negotiation is done.
125138
126139 my $socket = shift; # get the socket from somewhere
127 $socket = Server_SSLify( $socket );
140 $socket = Server_SSLify( $socket ); # the default
128141 $socket = Server_SSLify( $socket, $ctx ); # use your custom context
129 $socket = Server_SSLify( $socket, sub { print "CONNECTED" } ); # call your connection function
142 $socket = Server_SSLify( $socket, sub { warn "CONNECTED" } ); # call your connection function
130143
131144 NOTE: SSLify_Options must be set first!
132145
176189 # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle
177190 my $newsock = gensym();
178191 tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, ( $custom_ctx || $ctx ), $connref ) or die "Unable to tie to our subclass: $!";
192
193 # argh, store the newsock in the tied class to use for connref
194 if ( defined $connref ) {
195 tied( *$newsock )->{'orig_socket'} = $newsock;
196 weaken( tied( *$newsock )->{'orig_socket'} );
197 }
179198
180199 # All done!
181200 return $newsock;
371390 return tied( *$sock )->{'ssl'};
372391 }
373392
393 =func SSLify_GetStatus
394
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
400 =cut
401
402 sub SSLify_GetStatus {
403 my $sock = shift;
404 return tied( *$sock )->{'status'};
405 }
406
374407 1;
375408
376409 =pod
+0
-143
t/4_hooks.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 = 14;
9
10 # disabled for testing now...
11 # eval "use Test::NoWarnings";
12 # if ( ! $@ ) {
13 # # increment by one
14 # $numtests++;
15 #
16 # }
17 }
18
19 use Test::More tests => $numtests;
20
21 use POE 1.267;
22 use POE::Component::Client::TCP;
23 use POE::Component::Server::TCP;
24 use POE::Component::SSLify qw/Client_SSLify Server_SSLify SSLify_Options SSLify_GetCipher SSLify_ContextCreate SSLify_GetSocket SSLify_GetSSL/;
25
26 # TODO rewrite this to use Test::POE::Server::TCP and stuff :)
27
28 my $port;
29
30 POE::Component::Server::TCP->new
31 (
32 Alias => 'myserver',
33 Address => '127.0.0.1',
34 Port => 0,
35
36 Started => sub
37 {
38 use Socket qw/sockaddr_in/;
39 $port = (sockaddr_in($_[HEAP]->{listener}->getsockname))[0];
40 },
41 ClientConnected => sub
42 {
43 ok(1, 'SERVER: accepted');
44 },
45 ClientDisconnected => sub
46 {
47 ok(1, 'SERVER: client disconnected');
48 $_[KERNEL]->post( 'myserver' => 'shutdown');
49 },
50 ClientPreConnect => sub
51 {
52 eval { SSLify_Options('mylib/example.key', 'mylib/example.crt', 'sslv3') };
53 eval { SSLify_Options('../mylib/example.key', '../mylib/example.crt', 'sslv3') } if ($@);
54 ok(!$@, "SERVER: SSLify_Options $@");
55
56 my $socket = eval { Server_SSLify( $_[ARG0], sub {
57 pass( "Got connect hook for server" );
58 } ) };
59 ok(!$@, "SERVER: Server_SSLify $@");
60 ok(1, 'SERVER: SSLify_GetCipher: '. SSLify_GetCipher($socket));
61
62 # We pray that IO::Handle is sane...
63 ok( SSLify_GetSocket( $socket )->blocking == 0, 'SERVER: SSLified socket is non-blocking?');
64
65 return ($socket);
66 },
67 ClientInput => sub
68 {
69 my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
70
71 die "Unknown line from CLIENT: $line";
72 },
73 ClientError => sub
74 {
75 # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0!
76 # The default PoCo::Server::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :(
77 my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ];
78
79 # TODO are there other "errors" that is harmless?
80 $error = "Normal disconnection" unless $error;
81 my $msg = "Got SERVER $syscall error $errno: $error";
82 unless ( $syscall eq 'read' and $errno == 0 ) {
83 fail( $msg );
84 } else {
85 diag( $msg ) if $ENV{TEST_VERBOSE};
86 }
87 },
88 );
89
90 POE::Component::Client::TCP->new
91 (
92 Alias => 'myclient',
93 RemoteAddress => '127.0.0.1',
94 RemotePort => $port,
95 Connected => sub
96 {
97 ok(1, 'CLIENT: connected');
98 },
99 PreConnect => sub
100 {
101 my $ctx = eval { SSLify_ContextCreate(undef, undef, 'sslv3') };
102 ok(!$@, "CLIENT: SSLify_ContextCreate $@");
103 my $socket = eval { Client_SSLify($_[ARG0], undef, undef, $ctx, sub {
104 pass( "Got connect hook for client" );
105 $poe_kernel->post( 'myclient' => 'shutdown' );
106 }) };
107 ok(!$@, "CLIENT: Client_SSLify $@");
108 ok(1, 'CLIENT: SSLify_GetCipher: '. SSLify_GetCipher($socket));
109
110 # We pray that IO::Handle is sane...
111 ok( SSLify_GetSocket( $socket )->blocking == 0, 'CLIENT: SSLified socket is non-blocking?');
112
113 return ($socket);
114 },
115 ServerInput => sub
116 {
117 my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
118
119 $kernel->yield('shutdown');
120 },
121 ServerError => sub
122 {
123 # Thanks to H. Merijn Brand for spotting this FAIL in 5.12.0!
124 # The default PoCo::Client::TCP handler will throw a warning, which causes Test::NoWarnings to FAIL :(
125 my ($syscall, $errno, $error) = @_[ ARG0..ARG2 ];
126
127 # TODO are there other "errors" that is harmless?
128 $error = "Normal disconnection" unless $error;
129 my $msg = "Got CLIENT $syscall error $errno: $error";
130 unless ( $syscall eq 'read' and $errno == 0 ) {
131 fail( $msg );
132 } else {
133 diag( $msg ) if $ENV{TEST_VERBOSE};
134 }
135 },
136 );
137
138 $poe_kernel->run();
139
140 pass( 'shut down sanely' );
141
142 exit 0;