[svn-inject] Installing original source of libpoe-component-sslify-perl
Kees Cook
15 years ago
0 | Revision history for Perl extension POE::Component::SSLify. | |
1 | ||
2 | * 0.08 | |
3 | ||
4 | Added support for BINMODE - thanks RT #27117 | |
5 | ||
6 | * 0.07 | |
7 | ||
8 | Fixed undefined $info - thanks RT #22372 | |
9 | ||
10 | * 0.06 | |
11 | ||
12 | Kwalitee-related fixes | |
13 | ||
14 | * 0.05 | |
15 | ||
16 | Finally use a Changes file - thanks RT #18981 | |
17 | Documentation tweaks | |
18 | Upgraded Net::SSLeay requirement to 1.30 to help Win32 problems | |
19 | ||
20 | * 0.04 | |
21 | ||
22 | Added new functions to extract data from the SSL socket -> GetCipher and GetSocket | |
23 | In the case somebody knows Net::SSLeay more than me, added GetCTX to return the server-side CTX object | |
24 | Removed the dependency on Net::SSLeay::Handle | |
25 | ||
26 | * 0.03 | |
27 | ||
28 | First stab at the server-side code, help me test it out! | |
29 | Refactored SSLify() into client/server side, so update your program accordingly! | |
30 | ||
31 | * 0.02 | |
32 | ||
33 | Made sure the IO::Handle way was used only on MSWin32 | |
34 | ||
35 | * SSLify::ServerHandle | |
36 | Removed _CIPHER and moved it to the main SSLify.pm code | |
37 | Oops, forgot to override _get_self and _get_ssl | |
38 | Fixed a nasty leak issue | |
39 | ||
40 | * 0.01 | |
41 | ||
42 | Initial release |
0 | Makefile.PL | |
1 | MANIFEST | |
2 | README | |
3 | t/1_load.t | |
4 | t/2_pod.t | |
5 | lib/POE/Component/SSLify.pm | |
6 | lib/POE/Component/SSLify/ClientHandle.pm | |
7 | lib/POE/Component/SSLify/ServerHandle.pm | |
8 | META.yml | |
9 | Changes | |
10 | examples/server.pl |
0 | --- #YAML:1.0 | |
1 | name: POE-Component-SSLify | |
2 | version: 0.08 | |
3 | abstract: Makes using SSL in the world of POE easy! | |
4 | license: perl | |
5 | generated_by: ExtUtils::MakeMaker version 6.31 | |
6 | distribution_type: module | |
7 | requires: | |
8 | Net::SSLeay: 1.30 | |
9 | meta-spec: | |
10 | url: http://module-build.sourceforge.net/META-spec-v1.2.html | |
11 | version: 1.2 | |
12 | author: | |
13 | - Apocalypse <APOCAL@cpan.org> |
0 | use ExtUtils::MakeMaker; | |
1 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence | |
2 | # the contents of the Makefile that is written. | |
3 | WriteMakefile( | |
4 | 'NAME' => 'POE::Component::SSLify', | |
5 | 'VERSION_FROM' => 'lib/POE/Component/SSLify.pm', | |
6 | 'PREREQ_PM' => { | |
7 | 'Net::SSLeay' => '1.30', | |
8 | }, | |
9 | ( $] >= 5.005 ? # Add new keywords | |
10 | ( | |
11 | 'ABSTRACT_FROM' => 'lib/POE/Component/SSLify.pm', # retrieve abstract from module | |
12 | 'AUTHOR' => 'Apocalypse <APOCAL@cpan.org>', | |
13 | 'LICENSE' => 'perl', | |
14 | ) : () | |
15 | ), | |
16 | ); |
0 | POE-Component-SSLify | |
1 | ==================== | |
2 | ||
3 | This module makes Net::SSLeay's SSL sockets behave with POE :) | |
4 | ||
5 | INSTALLATION | |
6 | ||
7 | To install this module type the following: | |
8 | ||
9 | perl Makefile.PL | |
10 | make | |
11 | make test | |
12 | make install | |
13 | ||
14 | MORE INFO | |
15 | ||
16 | # After installing: | |
17 | perldoc POE::Component::SSLify |
0 | use POE; | |
1 | use POE::Component::SSLify qw( Server_SSLify SSLify_Options ); | |
2 | use POE::Wheel::ReadWrite; | |
3 | use POE::Wheel::SocketFactory; | |
4 | use POE::Driver::SysRW; | |
5 | use POE::Filter::Line; | |
6 | ||
7 | # Needs to generate the SSL certs before running this! | |
8 | ||
9 | POE::Session->new( | |
10 | 'inline_states' => { | |
11 | '_start' => sub { | |
12 | # Okay, set the SSL options | |
13 | SSLify_Options( 'public-key.pem', 'public-cert.pem' ); | |
14 | ||
15 | # Create the socketfactory wheel to listen for requests | |
16 | $_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new( | |
17 | 'BindPort' => 5432, | |
18 | 'BindAddress' => localhost, | |
19 | 'Reuse' => 'yes', | |
20 | 'SuccessEvent' => 'Got_Connection', | |
21 | 'FailureEvent' => 'ListenerError', | |
22 | ); | |
23 | return; | |
24 | }, | |
25 | 'Got_Connection' => sub { | |
26 | # ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port | |
27 | my $socket = $_[ ARG0 ]; | |
28 | ||
29 | # SSLify it! | |
30 | $socket = Server_SSLify( $socket ); | |
31 | ||
32 | # Hand it off to ReadWrite | |
33 | my $wheel = POE::Wheel::ReadWrite->new( | |
34 | 'Handle' => $socket, | |
35 | 'Driver' => POE::Driver::SysRW->new(), | |
36 | 'Filter' => POE::Filter::Line->new(), | |
37 | 'InputEvent' => 'Got_Input', | |
38 | 'FlushedEvent' => 'Got_Flush', | |
39 | 'ErrorEvent' => 'Got_Error', | |
40 | ); | |
41 | ||
42 | # Store it... | |
43 | $_[HEAP]->{'WHEELS'}->{ $wheel->ID } = $wheel; | |
44 | return; | |
45 | }, | |
46 | 'ListenerError' => sub { | |
47 | # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID | |
48 | my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ]; | |
49 | warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n"; | |
50 | ||
51 | return; | |
52 | }, | |
53 | 'Got_Input' => sub { | |
54 | # ARG0: The Line, ARG1: Wheel ID | |
55 | ||
56 | # Send back to the client the line! | |
57 | $_[HEAP]->{'WHEELS'}->{ $_[ARG1] }->put( $_[ARG0] ); | |
58 | return; | |
59 | }, | |
60 | 'Got_Flush' => sub { | |
61 | # Done with a wheel | |
62 | delete $_[HEAP]->{'WHEELS'}->{ $_[ARG0] }; | |
63 | return; | |
64 | }, | |
65 | 'Got_Error' => sub { | |
66 | # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID | |
67 | my ( $operation, $errnum, $errstr, $id ) = @_[ ARG0 .. ARG3 ]; | |
68 | warn "Wheel $id generated $operation error $errnum: $errstr\n"; | |
69 | ||
70 | # Done with a wheel | |
71 | delete $_[HEAP]->{'WHEELS'}->{ $_[ARG0] }; | |
72 | return; | |
73 | }, | |
74 | }, | |
75 | ); | |
76 | ||
77 | # Start POE! | |
78 | POE::Kernel->run(); | |
79 | exit 0; |
0 | # Declare our package | |
1 | package POE::Component::SSLify::ClientHandle; | |
2 | ||
3 | # Standard stuff to catch errors | |
4 | use strict qw(subs vars refs); # Make sure we can't mess up | |
5 | use warnings FATAL => 'all'; # Enable warnings to catch errors | |
6 | ||
7 | # Initialize our version | |
8 | # $Revision: 1168 $ | |
9 | use vars qw( $VERSION ); | |
10 | $VERSION = '0.02'; | |
11 | ||
12 | # Import the SSL death routines | |
13 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
14 | ||
15 | # We inherit from ServerHandle | |
16 | use vars qw( @ISA ); | |
17 | @ISA = qw( POE::Component::SSLify::ServerHandle ); | |
18 | ||
19 | # Override TIEHANDLE because we create a CTX | |
20 | sub TIEHANDLE { | |
21 | my ( $class, $socket ) = @_; | |
22 | ||
23 | my $ctx = Net::SSLeay::CTX_new() or die_now( "Failed to create SSL_CTX $!" ); | |
24 | my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" ); | |
25 | ||
26 | my $fileno = fileno( $socket ); | |
27 | ||
28 | Net::SSLeay::set_fd( $ssl, $fileno ); # Must use fileno | |
29 | ||
30 | my $resp = Net::SSLeay::connect( $ssl ) or die_if_ssl_error( 'ssl connect' ); | |
31 | ||
32 | $POE::Component::SSLify::ServerHandle::Filenum_Object{ $fileno } = { | |
33 | ssl => $ssl, | |
34 | ctx => $ctx, | |
35 | socket => $socket, | |
36 | }; | |
37 | ||
38 | return bless \$fileno, $class; | |
39 | } | |
40 | ||
41 | # Override close because it does not do CTX_Free, which is bad bad | |
42 | sub CLOSE { | |
43 | my $self = shift; | |
44 | my $info = $self->_get_self(); | |
45 | ||
46 | # Thanks to Eric Waters -> closes RT #22372 | |
47 | if ( $info ) { | |
48 | Net::SSLeay::free( $info->{'ssl'} ); | |
49 | Net::SSLeay::CTX_free( $info->{'ctx'} ); | |
50 | close $info->{'socket'}; | |
51 | } | |
52 | delete $POE::Component::SSLify::ServerHandle::Filenum_Object{ $$self }; | |
53 | return 1; | |
54 | } | |
55 | ||
56 | # End of module | |
57 | 1; | |
58 | ||
59 | __END__ | |
60 | =head1 NAME | |
61 | ||
62 | POE::Component::SSLify::ClientHandle | |
63 | ||
64 | =head1 ABSTRACT | |
65 | ||
66 | See POE::Component::SSLify | |
67 | ||
68 | =head1 DESCRIPTION | |
69 | ||
70 | This is a subclass of Net::SSLeay::Handle because their read() and sysread() | |
71 | does not cooperate well with POE. They block until length bytes are read from the | |
72 | socket, and that is BAD in the world of POE... | |
73 | ||
74 | This subclass behaves exactly the same, except that it doesn't block :) | |
75 | ||
76 | =head1 SEE ALSO | |
77 | ||
78 | L<POE::Component::SSLify> | |
79 | ||
80 | =head1 AUTHOR | |
81 | ||
82 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
83 | ||
84 | =head1 PROPS | |
85 | ||
86 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
87 | packaged up the code into something everyone could use... | |
88 | ||
89 | From the PoCo::Client::HTTP code =] | |
90 | # TODO - This code should probably become a POE::Kernel method, | |
91 | # seeing as it's rather baroque and potentially useful in a number | |
92 | # of places. | |
93 | ||
94 | =head1 COPYRIGHT AND LICENSE | |
95 | ||
96 | Copyright 2006 by Apocalypse/Rocco Caputo | |
97 | ||
98 | This library is free software; you can redistribute it and/or modify | |
99 | it under the same terms as Perl itself. | |
100 | ||
101 | =cut |
0 | # Declare our package | |
1 | package POE::Component::SSLify::ServerHandle; | |
2 | ||
3 | # Standard stuff to catch errors | |
4 | use strict qw(subs vars refs); # Make sure we can't mess up | |
5 | use warnings FATAL => 'all'; # Enable warnings to catch errors | |
6 | ||
7 | # Initialize our version | |
8 | # $Revision: 1168 $ | |
9 | use vars qw( $VERSION ); | |
10 | $VERSION = '0.03'; | |
11 | ||
12 | # Import the SSL death routines | |
13 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
14 | ||
15 | # Argh, we actually copy over some stuff | |
16 | our %Filenum_Object; #-- hash of hashes, keyed by fileno() | |
17 | ||
18 | # Ties the socket | |
19 | sub TIEHANDLE { | |
20 | my ( $class, $socket, $ctx ) = @_; | |
21 | ||
22 | my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" ); | |
23 | ||
24 | my $fileno = fileno( $socket ); | |
25 | ||
26 | Net::SSLeay::set_fd( $ssl, $fileno ); | |
27 | ||
28 | my $err = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' ); | |
29 | ||
30 | $Filenum_Object{ $fileno } = { | |
31 | ssl => $ssl, | |
32 | ctx => $ctx, | |
33 | socket => $socket, | |
34 | }; | |
35 | ||
36 | return bless \$fileno, $class; | |
37 | } | |
38 | ||
39 | # Read something from the socket | |
40 | sub READ { | |
41 | # Get ourself! | |
42 | my $self = shift; | |
43 | ||
44 | # Get the pointers to buffer, length, and the offset | |
45 | my( $buf, $len, $offset ) = \( @_ ); | |
46 | ||
47 | # Get the actual ssl handle | |
48 | my $ssl = $Filenum_Object{ $$self }->{'ssl'}; | |
49 | ||
50 | # If we have no offset, replace the buffer with some input | |
51 | if ( ! defined $$offset ) { | |
52 | $$buf = Net::SSLeay::read( $ssl, $$len ); | |
53 | ||
54 | # Are we done? | |
55 | if ( defined $$buf ) { | |
56 | return length( $$buf ); | |
57 | } else { | |
58 | # Nah, clear the buffer too... | |
59 | $$buf = ""; | |
60 | return; | |
61 | } | |
62 | } | |
63 | ||
64 | # Now, actually read the data | |
65 | defined( my $read = Net::SSLeay::read( $ssl, $$len ) ) or return undef; | |
66 | ||
67 | # Figure out the buffer and offset | |
68 | my $buf_len = length( $$buf ); | |
69 | ||
70 | # If our offset is bigger, pad the buffer | |
71 | if ( $$offset > $buf_len ) { | |
72 | $$buf .= chr( 0 ) x ( $$offset - $buf_len ); | |
73 | } | |
74 | ||
75 | # Insert what we just read into the buffer | |
76 | substr( $$buf, $$offset ) = $read; | |
77 | ||
78 | # All done! | |
79 | return length( $read ); | |
80 | } | |
81 | ||
82 | # Write some stuff to the socket | |
83 | sub WRITE { | |
84 | # Get ourself + buffer + length + offset to write | |
85 | my( $self, $buf, $len, $offset ) = @_; | |
86 | ||
87 | # If we have nothing to offset, then start from the beginning | |
88 | if ( ! defined $offset ) { | |
89 | $offset = 0; | |
90 | } | |
91 | ||
92 | # Okay, get the ssl handle | |
93 | my $ssl = $Filenum_Object{ $$self }->{'ssl'}; | |
94 | ||
95 | # We count the number of characters written to the socket | |
96 | my $wrote_len = Net::SSLeay::write( $ssl, substr( $buf, $offset, $len ) ); | |
97 | ||
98 | # Did we get an error or number of bytes written? | |
99 | # Net::SSLeay::write() returns the number of bytes written, or -1 on error. | |
100 | if ( $wrote_len < 0 ) { | |
101 | # The normal syswrite() POE uses expects 0 here. | |
102 | return 0; | |
103 | } else { | |
104 | # All done! | |
105 | return $wrote_len; | |
106 | } | |
107 | } | |
108 | ||
109 | # Sets binmode on the socket | |
110 | # Thanks to RT #27117 | |
111 | sub BINMODE { | |
112 | my $self = shift; | |
113 | if (@_) { | |
114 | my $mode = shift; | |
115 | binmode $Filenum_Object{$$self}->{'socket'}, $mode; | |
116 | } else { | |
117 | binmode $Filenum_Object{$$self}->{'socket'}; | |
118 | } | |
119 | } | |
120 | ||
121 | # Closes the socket | |
122 | sub CLOSE { | |
123 | my $self = shift; | |
124 | Net::SSLeay::free( $Filenum_Object{ $$self }->{'ssl'} ); | |
125 | close $Filenum_Object{ $$self }->{'socket'}; | |
126 | delete $Filenum_Object{ $$self }; | |
127 | return 1; | |
128 | } | |
129 | ||
130 | # Add DESTROY handler | |
131 | sub DESTROY { | |
132 | my $self = shift; | |
133 | ||
134 | # Did we already CLOSE? | |
135 | if ( exists $Filenum_Object{ $$self } ) { | |
136 | # Guess not... | |
137 | $self->CLOSE(); | |
138 | } | |
139 | } | |
140 | ||
141 | sub FILENO { | |
142 | return ${ $_[0] }; | |
143 | } | |
144 | ||
145 | # Not implemented TIE's | |
146 | sub READLINE { | |
147 | die 'Not Implemented'; | |
148 | } | |
149 | ||
150 | sub PRINT { | |
151 | die 'Not Implemented'; | |
152 | } | |
153 | ||
154 | # Returns our hash | |
155 | sub _get_self { | |
156 | return $Filenum_Object{ ${ $_[0] } }; | |
157 | } | |
158 | ||
159 | # End of module | |
160 | 1; | |
161 | ||
162 | __END__ | |
163 | =head1 NAME | |
164 | ||
165 | POE::Component::SSLify::ServerHandle | |
166 | ||
167 | =head1 ABSTRACT | |
168 | ||
169 | See POE::Component::SSLify | |
170 | ||
171 | =head1 DESCRIPTION | |
172 | ||
173 | This is a subclass of Net::SSLeay::Handle because their read() and sysread() | |
174 | does not cooperate well with POE. They block until length bytes are read from the | |
175 | socket, and that is BAD in the world of POE... | |
176 | ||
177 | This subclass behaves exactly the same, except that it doesn't block :) | |
178 | ||
179 | =head2 DIFFERENCES | |
180 | ||
181 | This subclass doesn't know what to do with PRINT/READLINE, as they usually are not used in POE::Wheel operations... | |
182 | ||
183 | =head1 SEE ALSO | |
184 | ||
185 | L<POE::Component::SSLify> | |
186 | ||
187 | =head1 AUTHOR | |
188 | ||
189 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
190 | ||
191 | =head1 PROPS | |
192 | ||
193 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
194 | packaged up the code into something everyone could use... | |
195 | ||
196 | From the PoCo::Client::HTTP code for blocking sockets =] | |
197 | # TODO - This code should probably become a POE::Kernel method, | |
198 | # seeing as it's rather baroque and potentially useful in a number | |
199 | # of places. | |
200 | ||
201 | =head1 COPYRIGHT AND LICENSE | |
202 | ||
203 | Copyright 2007 by Apocalypse/Rocco Caputo | |
204 | ||
205 | This library is free software; you can redistribute it and/or modify | |
206 | it under the same terms as Perl itself. | |
207 | ||
208 | =cut |
0 | # Declare our package | |
1 | package POE::Component::SSLify; | |
2 | ||
3 | # Standard stuff to catch errors | |
4 | use strict qw(subs vars refs); # Make sure we can't mess up | |
5 | use warnings FATAL => 'all'; # Enable warnings to catch errors | |
6 | ||
7 | # Initialize our version | |
8 | # $Revision: 1213 $ | |
9 | our $VERSION = '0.08'; | |
10 | ||
11 | # We need Net::SSLeay or all's a failure! | |
12 | BEGIN { | |
13 | eval { require Net::SSLeay }; | |
14 | ||
15 | # Check for errors... | |
16 | if ( $@ ) { | |
17 | # Oh boy! | |
18 | die $@; | |
19 | } else { | |
20 | # Check to make sure the versions are what we want | |
21 | if ( ! ( defined $Net::SSLeay::VERSION and | |
22 | $Net::SSLeay::VERSION >= 1.30 ) ) { | |
23 | # Argh... | |
24 | die 'Please upgrade Net::SSLeay to 1.30+'; | |
25 | } else { | |
26 | # Finally, load our subclass :) | |
27 | require POE::Component::SSLify::ClientHandle; | |
28 | require POE::Component::SSLify::ServerHandle; | |
29 | ||
30 | # Initialize Net::SSLeay | |
31 | Net::SSLeay::load_error_strings(); | |
32 | Net::SSLeay::SSLeay_add_ssl_algorithms(); | |
33 | Net::SSLeay::randomize(); | |
34 | } | |
35 | } | |
36 | } | |
37 | ||
38 | # Do the exporting magic... | |
39 | require Exporter; | |
40 | use vars qw( @ISA @EXPORT_OK ); | |
41 | @ISA = qw( Exporter ); | |
42 | @EXPORT_OK = qw( Client_SSLify Server_SSLify SSLify_Options SSLify_GetCTX SSLify_GetCipher SSLify_GetSocket ); | |
43 | ||
44 | # Bring in some socket-related stuff | |
45 | use Symbol qw( gensym ); | |
46 | use POSIX qw( F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK ); | |
47 | ||
48 | # We need the server-side stuff | |
49 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
50 | ||
51 | # The server-side CTX stuff | |
52 | my $ctx = undef; | |
53 | ||
54 | # Helper sub to set blocking on a handle | |
55 | sub Set_Blocking { | |
56 | my $socket = shift; | |
57 | ||
58 | # Net::SSLeay needs blocking for setup. | |
59 | # | |
60 | # ActiveState Perl 5.8.0 dislikes the Win32-specific code to make | |
61 | # a socket blocking, so we use IO::Handle's blocking(1) method. | |
62 | # Perl 5.005_03 doesn't like blocking(), so we only use it in | |
63 | # 5.8.0 and beyond. | |
64 | if ( $] >= 5.008 and $^O eq 'MSWin32' ) { | |
65 | # From IO::Handle POD | |
66 | # If an error occurs blocking will return undef and $! will be set. | |
67 | if ( ! $socket->blocking( 1 ) ) { | |
68 | die "Unable to set blocking mode on socket: $!"; | |
69 | } | |
70 | } else { | |
71 | # Make the handle blocking, the POSIX way. | |
72 | if ( $^O ne 'MSWin32' ) { | |
73 | # Get the old flags | |
74 | my $flags = fcntl( $socket, F_GETFL, 0 ) or die "fcntl( $socket, F_GETFL, 0 ) fails: $!"; | |
75 | ||
76 | # Okay, we patiently wait until the socket turns blocking mode | |
77 | until( fcntl( $socket, F_SETFL, $flags & ~O_NONBLOCK ) ) { | |
78 | # What was the error? | |
79 | if ( ! ( $! == EAGAIN or $! == EWOULDBLOCK ) ) { | |
80 | # Fatal error... | |
81 | die "fcntl( $socket, FSETFL, etc ) fails: $!"; | |
82 | } | |
83 | } | |
84 | } else { | |
85 | # Darned MSWin32 way... | |
86 | # Do some ioctl magic here | |
87 | # 126 is FIONBIO ( some docs say 0x7F << 16 ) | |
88 | my $flag = "0"; | |
89 | ioctl( $socket, 0x80000000 | ( 4 << 16 ) | ( ord( 'f' ) << 8 ) | 126, $flag ) or die "ioctl( $socket, FIONBIO, $flag ) fails: $!"; | |
90 | } | |
91 | } | |
92 | ||
93 | # All done! | |
94 | return $socket; | |
95 | } | |
96 | ||
97 | # Okay, the main routine here! | |
98 | sub Client_SSLify { | |
99 | # Get the socket! | |
100 | my $socket = shift; | |
101 | ||
102 | # Validation... | |
103 | if ( ! defined $socket ) { | |
104 | die "Did not get a defined socket"; | |
105 | } | |
106 | ||
107 | # Set blocking on | |
108 | $socket = Set_Blocking( $socket ); | |
109 | ||
110 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
111 | my $newsock = gensym(); | |
112 | tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket ) or die "Unable to tie to our subclass: $!"; | |
113 | ||
114 | # All done! | |
115 | return $newsock; | |
116 | } | |
117 | ||
118 | # Okay, the main routine here! | |
119 | sub Server_SSLify { | |
120 | # Get the socket! | |
121 | my $socket = shift; | |
122 | ||
123 | # Validation... | |
124 | if ( ! defined $socket ) { | |
125 | die "Did not get a defined socket"; | |
126 | } | |
127 | ||
128 | # If we don't have a ctx ready, we can't do anything... | |
129 | if ( ! defined $ctx ) { | |
130 | die 'Please do SSLify_Options() first'; | |
131 | } | |
132 | ||
133 | # Set blocking on | |
134 | $socket = Set_Blocking( $socket ); | |
135 | ||
136 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
137 | my $newsock = gensym(); | |
138 | tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, $ctx ) or die "Unable to tie to our subclass: $!"; | |
139 | ||
140 | # All done! | |
141 | return $newsock; | |
142 | } | |
143 | ||
144 | # Sets the key + certificate | |
145 | sub SSLify_Options { | |
146 | # Get the key + cert | |
147 | my( $key, $cert ) = @_; | |
148 | ||
149 | $ctx = Net::SSLeay::CTX_new() or die_now( "CTX_new($ctx): $!" ); | |
150 | Net::SSLeay::CTX_set_options( $ctx, &Net::SSLeay::OP_ALL ) and die_if_ssl_error( 'ssl ctx set options' ); | |
151 | ||
152 | # Following will ask password unless private key is not encrypted | |
153 | Net::SSLeay::CTX_use_RSAPrivateKey_file( $ctx, $key, &Net::SSLeay::FILETYPE_PEM ); | |
154 | die_if_ssl_error( 'private key' ); | |
155 | ||
156 | # Set the cert file | |
157 | Net::SSLeay::CTX_use_certificate_file( $ctx, $cert, &Net::SSLeay::FILETYPE_PEM ); | |
158 | die_if_ssl_error( 'certificate' ); | |
159 | ||
160 | # All done! | |
161 | return 1; | |
162 | } | |
163 | ||
164 | # Returns the server-side CTX in case somebody wants to play with it | |
165 | sub SSLify_GetCTX { | |
166 | return $ctx; | |
167 | } | |
168 | ||
169 | # Gives you the cipher type of a SSLified socket | |
170 | sub SSLify_GetCipher { | |
171 | my $sock = shift; | |
172 | return Net::SSLeay::get_cipher( tied( *$sock )->_get_self()->{'ssl'} ); | |
173 | } | |
174 | ||
175 | # Gives you the "Real" Socket to play with | |
176 | sub SSLify_GetSocket { | |
177 | my $sock = shift; | |
178 | return tied( *$sock )->_get_self()->{'socket'}; | |
179 | } | |
180 | ||
181 | # End of module | |
182 | 1; | |
183 | ||
184 | __END__ | |
185 | =head1 NAME | |
186 | ||
187 | POE::Component::SSLify - Makes using SSL in the world of POE easy! | |
188 | ||
189 | =head1 SYNOPSIS | |
190 | ||
191 | =head2 Client-side usage | |
192 | ||
193 | # Import the module | |
194 | use POE::Component::SSLify qw( Client_SSLify ); | |
195 | ||
196 | # Create a normal SocketFactory wheel or something | |
197 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
198 | ||
199 | # Converts the socket into a SSL socket POE can communicate with | |
200 | eval { $socket = Client_SSLify( $socket ) }; | |
201 | if ( $@ ) { | |
202 | # Unable to SSLify it... | |
203 | } | |
204 | ||
205 | # Now, hand it off to ReadWrite | |
206 | my $rw = POE::Wheel::ReadWrite->new( | |
207 | Handle => $socket, | |
208 | ... | |
209 | ); | |
210 | ||
211 | # Use it as you wish... | |
212 | ||
213 | =head2 Server-side usage | |
214 | ||
215 | # !!! Make sure you have a public key + certificate generated via Net::SSLeay's makecert.pl | |
216 | ||
217 | # Import the module | |
218 | use POE::Component::SSLify qw( Server_SSLify SSLify_Options SSLify_GetCTX ); | |
219 | ||
220 | # Set the key + certificate file | |
221 | eval { SSLify_Options( 'public-key.pem', 'public-cert.pem' ) }; | |
222 | if ( $@ ) { | |
223 | # Unable to load key or certificate file... | |
224 | } | |
225 | ||
226 | # Ah, I want to set some options ( not required ) | |
227 | # my $ctx = SSLify_GetCTX(); | |
228 | # Net::SSLeay::CTX_set_options( $ctx, foo ); | |
229 | ||
230 | # Create a normal SocketFactory wheel or something | |
231 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
232 | ||
233 | # Converts the socket into a SSL socket POE can communicate with | |
234 | eval { $socket = Server_SSLify( $socket ) }; | |
235 | if ( $@ ) { | |
236 | # Unable to SSLify it... | |
237 | } | |
238 | ||
239 | # Now, hand it off to ReadWrite | |
240 | my $rw = POE::Wheel::ReadWrite->new( | |
241 | Handle => $socket, | |
242 | ... | |
243 | ); | |
244 | ||
245 | # Use it as you wish... | |
246 | ||
247 | =head1 ABSTRACT | |
248 | ||
249 | Makes SSL use in POE a breeze! | |
250 | ||
251 | =head1 DESCRIPTION | |
252 | ||
253 | This component represents the standard way to do SSL in POE. | |
254 | ||
255 | =head1 NOTES | |
256 | ||
257 | =head2 Socket methods doesn't work | |
258 | ||
259 | The new socket this module gives you actually is some tied socket magic, so you cannot do stuff like | |
260 | getpeername() or getsockname(). The only way to do it is to use SSLify_GetSocket and then operate on | |
261 | the socket it returns. | |
262 | ||
263 | =head2 Dying everywhere... | |
264 | ||
265 | This module will die() if Net::SSLeay could not be loaded or it is not the version we want. So, it is recommended | |
266 | that you check for errors and not use SSL, like so: | |
267 | ||
268 | eval { use POE::Component::SSLify }; | |
269 | if ( $@ ) { | |
270 | $sslavailable = 0; | |
271 | } else { | |
272 | $sslavailable = 1; | |
273 | } | |
274 | ||
275 | # Make socket SSL! | |
276 | if ( $sslavailable ) { | |
277 | eval { $socket = POE::Component::SSLify::Client_SSLify( $socket ) }; | |
278 | if ( $@ ) { | |
279 | # Unable to SSLify the socket... | |
280 | } | |
281 | } | |
282 | ||
283 | =head1 FUNCTIONS | |
284 | ||
285 | =head2 Client_SSLify | |
286 | ||
287 | Accepts a socket, returns a brand new socket SSLified | |
288 | ||
289 | =head2 Server_SSLify | |
290 | ||
291 | Accepts a socket, returns a brand new socket SSLified | |
292 | ||
293 | NOTE: SSLify_Options must be set first! | |
294 | ||
295 | =head2 SSLify_Options | |
296 | ||
297 | Accepts the location of the SSL key + certificate files and does it's job | |
298 | ||
299 | =head2 SSLify_GetCTX | |
300 | ||
301 | Returns the server-side CTX in case you wanted to play around with it :) | |
302 | ||
303 | =head2 SSLify_GetCipher | |
304 | ||
305 | Returns the cipher used by the SSLified socket | |
306 | ||
307 | Example: | |
308 | print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n"; | |
309 | ||
310 | =head2 SSLify_GetSocket | |
311 | ||
312 | Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname() | |
313 | ||
314 | Example: | |
315 | print "Remote IP is: " . ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[0] . "\n"; | |
316 | ||
317 | =head1 EXPORT | |
318 | ||
319 | Stuffs all the 4 functions in @EXPORT_OK so you have to request them directly | |
320 | ||
321 | =head1 BUGS | |
322 | ||
323 | On Win32 platforms SSL support is pretty shaky, please help me out with detailed error descriptions if it happens to you! | |
324 | ||
325 | =head1 SEE ALSO | |
326 | ||
327 | L<POE> | |
328 | ||
329 | L<Net::SSLeay> | |
330 | ||
331 | =head1 AUTHOR | |
332 | ||
333 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
334 | ||
335 | =head1 PROPS | |
336 | ||
337 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
338 | packaged up the code into something everyone could use and accepted the burden | |
339 | of maintaining it :) | |
340 | ||
341 | From the PoCo::Client::HTTP code =] | |
342 | # TODO - This code should probably become a POE::Kernel method, | |
343 | # seeing as it's rather baroque and potentially useful in a number | |
344 | # of places. | |
345 | ||
346 | =head1 COPYRIGHT AND LICENSE | |
347 | ||
348 | Copyright 2007 by Apocalypse/Rocco Caputo | |
349 | ||
350 | This library is free software; you can redistribute it and/or modify | |
351 | it under the same terms as Perl itself. | |
352 | ||
353 | =cut |