[svn-upgrade] Integrating new upstream version, libpoe-component-sslify-perl (0.14)
Jose Luis Rivas Contreras
14 years ago
0 | use Module::Build; | |
1 | my $build = Module::Build->new( | |
2 | # look up Module::Build::API for the info! | |
3 | 'dynamic_config' => 0, | |
4 | 'module_name' => 'POE::Component::SSLify', | |
5 | 'license' => 'perl', | |
6 | ||
7 | 'dist_abstract' => 'SSL in the world of POE made easy', | |
8 | ||
9 | 'create_packlist' => 1, | |
10 | 'create_makefile_pl' => 'traditional', | |
11 | 'create_readme' => 1, | |
12 | ||
13 | 'test_files' => 't/*.t', | |
14 | ||
15 | 'add_to_cleanup' => [ 'META.yml', 'Makefile.PL', 'README' ], # automatically generated | |
16 | ||
17 | 'requires' => { | |
18 | # Networking | |
19 | 'Net::SSLeay' => '1.30', | |
20 | ||
21 | # Test stuff | |
22 | 'Test::More' => 0, | |
23 | }, | |
24 | ||
25 | 'recommends' => { | |
26 | # boo! | |
27 | }, | |
28 | ||
29 | # FIXME wishlist... | |
30 | # 'test_requires' => { | |
31 | # # Test stuff | |
32 | # 'Test::Compile' => 0, | |
33 | # 'Test::Perl::Critic' => 0, | |
34 | # 'Test::Dependencies' => 0, | |
35 | # 'Test::Distribution' => 0, | |
36 | # 'Test::Fixme' => 0, | |
37 | # 'Test::HasVersion' => 0, | |
38 | # 'Test::Kwalitee' => 0, | |
39 | # 'Test::CheckManifest' => 0, | |
40 | # 'Test::MinimumVersion' => 0, | |
41 | # 'Test::Pod::Coverage' => 0, | |
42 | # 'Test::Spelling' => 0, | |
43 | # 'Test::Pod' => 0, | |
44 | # 'Test::Prereq' => 0, | |
45 | # 'Test::Strict' => 0, | |
46 | # 'Test::UseAllModules' => 0, | |
47 | # }, | |
48 | ); | |
49 | ||
50 | # all done! | |
51 | $build->create_build_script; |
0 | 0 | Revision history for Perl extension POE::Component::SSLify. |
1 | ||
2 | * 0.14 | |
3 | ||
4 | removed Test::* modules from dependency list, thanks BINGOS - RT #36725 | |
5 | ||
6 | dos2unix fixes - thanks RT #36704 | |
7 | ||
8 | added Build.PL | |
1 | 9 | |
2 | 10 | * 0.13 |
3 | 11 |
0 | Build.PL | |
0 | 1 | Changes |
1 | 2 | examples/client.pl |
2 | 3 | examples/server.pl |
8 | 9 | MANIFEST.SKIP |
9 | 10 | META.yml |
10 | 11 | README |
11 | t/1_load.t | |
12 | t/load.t | |
13 | t/a_critic.t | |
14 | t/a_kwalitee.t | |
15 | t/a_pod.t | |
16 | t/a_pod_spelling.t | |
17 | t/a_pod_coverage.t | |
18 | t/a_strict.t | |
19 | t/a_hasversion.t | |
20 | t/a_minimumversion.t | |
21 | t/a_manifest.t | |
12 | 22 | t/a_distribution.t |
13 | t/a_hasversion.t | |
14 | t/a_kwalitee.t | |
15 | t/a_manifest.t | |
16 | t/a_minimumversion.t | |
17 | t/a_pod.t | |
18 | t/a_podcoverage.t | |
19 | t/a_strict.t | |
23 | t/a_compile.t | |
24 | t/a_dependencies.t | |
25 | t/a_fixme.t | |
26 | t/a_prereq.t | |
27 | t/a_prereq_build.t | |
28 | t/a_dosnewline.t |
0 | ^.includepath | |
1 | ^.project | |
2 | ^.settings/ | |
0 | # Avoid Eclipse stuff | |
1 | \.includepath$ | |
2 | \.project$ | |
3 | \.settings/ | |
3 | 4 | |
4 | 5 | # Avoid version control files. |
5 | 6 | \B\.svn\b |
0 | --- #YAML:1.0 | |
1 | name: POE-Component-SSLify | |
2 | version: 0.13 | |
3 | abstract: Makes using SSL in the world of POE easy! | |
4 | license: perl | |
5 | author: | |
6 | - Apocalypse <APOCAL@cpan.org> | |
7 | generated_by: ExtUtils::MakeMaker version 6.44 | |
8 | distribution_type: module | |
9 | requires: | |
10 | Net::SSLeay: 1.30 | |
11 | Test::CheckManifest: 0 | |
12 | Test::Distribution: 0 | |
13 | Test::HasVersion: 0 | |
14 | Test::Kwalitee: 0 | |
15 | Test::MinimumVersion: 0 | |
16 | Test::More: 0 | |
17 | Test::Pod: 0 | |
18 | Test::Pod::Coverage: 0 | |
19 | Test::Strict: 0 | |
20 | Test::UseAllModules: 0 | |
0 | --- | |
1 | name: POE-Component-SSLify | |
2 | version: 0.14 | |
3 | author: | |
4 | - 'Apocalypse E<lt>apocal@cpan.orgE<gt>' | |
5 | abstract: SSL in the world of POE made easy | |
6 | license: perl | |
7 | resources: | |
8 | license: http://dev.perl.org/licenses/ | |
9 | requires: | |
10 | Net::SSLeay: 1.30 | |
11 | Test::More: 0 | |
12 | dynamic_config: 0 | |
13 | provides: | |
14 | POE::Component::SSLify: | |
15 | file: lib/POE/Component/SSLify.pm | |
16 | version: 0.14 | |
17 | POE::Component::SSLify::ClientHandle: | |
18 | file: lib/POE/Component/SSLify/ClientHandle.pm | |
19 | version: 53 | |
20 | POE::Component::SSLify::ServerHandle: | |
21 | file: lib/POE/Component/SSLify/ServerHandle.pm | |
22 | version: 53 | |
23 | generated_by: Module::Build version 0.2808 | |
21 | 24 | meta-spec: |
22 | url: http://module-build.sourceforge.net/META-spec-v1.3.html | |
23 | version: 1.3 | |
25 | url: http://module-build.sourceforge.net/META-spec-v1.2.html | |
26 | version: 1.2 |
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 | # test stuff | |
10 | 'Test::More' => 0, | |
11 | 'Test::Distribution' => 0, | |
12 | 'Test::Strict' => 0, | |
13 | 'Test::HasVersion' => 0, | |
14 | 'Test::CheckManifest' => 0, | |
15 | 'Test::Kwalitee' => 0, | |
16 | 'Test::MinimumVersion' => 0, | |
17 | 'Test::Pod' => 0, | |
18 | 'Test::Pod::Coverage' => 0, | |
19 | 'Test::UseAllModules' => 0, | |
20 | }, | |
21 | ( $] >= 5.005 ? # Add new keywords | |
22 | ( | |
23 | 'ABSTRACT_FROM' => 'lib/POE/Component/SSLify.pm', # retrieve abstract from module | |
24 | 'AUTHOR' => 'Apocalypse <APOCAL@cpan.org>', | |
25 | 'LICENSE' => 'perl', | |
26 | ) : () | |
27 | ), | |
28 | ); | |
0 | # Note: this file was auto-generated by Module::Build::Compat version 0.03 | |
1 | use ExtUtils::MakeMaker; | |
2 | WriteMakefile | |
3 | ( | |
4 | 'PL_FILES' => {}, | |
5 | 'INSTALLDIRS' => 'site', | |
6 | 'NAME' => 'POE::Component::SSLify', | |
7 | 'EXE_FILES' => [], | |
8 | 'VERSION_FROM' => 'lib/POE/Component/SSLify.pm', | |
9 | 'PREREQ_PM' => { | |
10 | 'Test::More' => 0, | |
11 | 'Net::SSLeay' => '1.30' | |
12 | } | |
13 | ) | |
14 | ; |
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 | |
18 | ||
0 | NAME | |
1 | POE::Component::SSLify - Makes using SSL in the world of POE easy! | |
2 | ||
3 | SYNOPSIS | |
4 | Client-side usage | |
5 | # Import the module | |
6 | use POE::Component::SSLify qw( Client_SSLify ); | |
7 | ||
8 | # Create a normal SocketFactory wheel or something | |
9 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
10 | ||
11 | # Converts the socket into a SSL socket POE can communicate with | |
12 | eval { $socket = Client_SSLify( $socket ) }; | |
13 | if ( $@ ) { | |
14 | # Unable to SSLify it... | |
15 | } | |
16 | ||
17 | # Now, hand it off to ReadWrite | |
18 | my $rw = POE::Wheel::ReadWrite->new( | |
19 | Handle => $socket, | |
20 | ... | |
21 | ); | |
22 | ||
23 | # Use it as you wish... | |
24 | ||
25 | Server-side usage | |
26 | # !!! Make sure you have a public key + certificate generated via Net::SSLeay's makecert.pl | |
27 | # excellent howto: http://www.akadia.com/services/ssh_test_certificate.html | |
28 | ||
29 | # Import the module | |
30 | use POE::Component::SSLify qw( Server_SSLify SSLify_Options ); | |
31 | ||
32 | # Set the key + certificate file | |
33 | eval { SSLify_Options( 'server.key', 'server.crt' ) }; | |
34 | if ( $@ ) { | |
35 | # Unable to load key or certificate file... | |
36 | } | |
37 | ||
38 | # Create a normal SocketFactory wheel or something | |
39 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
40 | ||
41 | # Converts the socket into a SSL socket POE can communicate with | |
42 | eval { $socket = Server_SSLify( $socket ) }; | |
43 | if ( $@ ) { | |
44 | # Unable to SSLify it... | |
45 | } | |
46 | ||
47 | # Now, hand it off to ReadWrite | |
48 | my $rw = POE::Wheel::ReadWrite->new( | |
49 | Handle => $socket, | |
50 | ... | |
51 | ); | |
52 | ||
53 | # Use it as you wish... | |
54 | ||
55 | ABSTRACT | |
56 | Makes SSL use in POE a breeze! | |
57 | ||
58 | DESCRIPTION | |
59 | This component represents the standard way to do SSL in POE. | |
60 | ||
61 | NOTES | |
62 | Socket methods doesn't work | |
63 | The new socket this module gives you actually is some tied socket magic, | |
64 | so you cannot do stuff like getpeername() or getsockname(). The only way | |
65 | to do it is to use SSLify_GetSocket and then operate on the socket it | |
66 | returns. | |
67 | ||
68 | Dying everywhere... | |
69 | This module will die() if Net::SSLeay could not be loaded or it is not | |
70 | the version we want. So, it is recommended that you check for errors and | |
71 | not use SSL, like so: | |
72 | ||
73 | eval { use POE::Component::SSLify }; | |
74 | if ( $@ ) { | |
75 | $sslavailable = 0; | |
76 | } else { | |
77 | $sslavailable = 1; | |
78 | } | |
79 | ||
80 | # Make socket SSL! | |
81 | if ( $sslavailable ) { | |
82 | eval { $socket = POE::Component::SSLify::Client_SSLify( $socket ) }; | |
83 | if ( $@ ) { | |
84 | # Unable to SSLify the socket... | |
85 | } | |
86 | } | |
87 | ||
88 | Mixing Server/Client in the same program | |
89 | Some users have reported success, others failure when they tried to utilize SSLify in both roles. This | |
90 | would require more investigation, so please tread carefully if you need to use it! | |
91 | ||
92 | FUNCTIONS | |
93 | Client_SSLify | |
94 | Accepts a socket, returns a brand new socket SSLified. Optionally accepts SSL | |
95 | context data. | |
96 | my $socket = shift; # get the socket from somewhere | |
97 | $socket = Client_SSLify( $socket ); # the default | |
98 | $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context | |
99 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context | |
100 | ||
101 | If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify | |
102 | will create it from the $version + $options parameters. | |
103 | ||
104 | Known versions: | |
105 | * sslv2 | |
106 | * sslv3 | |
107 | * tlsv1 | |
108 | * default | |
109 | ||
110 | By default we use the version: default | |
111 | ||
112 | By default we don't set any options | |
113 | ||
114 | NOTE: The way to have a client socket with proper certificates set up is: | |
115 | my $socket = shift; # get the socket from somewhere | |
116 | my $ctx = SSLify_ContextCreate( 'server.key', 'server.crt' ); | |
117 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); | |
118 | ||
119 | BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the | |
120 | socket is destroyed. This means you cannot reuse contexts! | |
121 | ||
122 | Server_SSLify | |
123 | Accepts a socket, returns a brand new socket SSLified | |
124 | my $socket = shift; # get the socket from somewhere | |
125 | $socket = Server_SSLify( $socket ); | |
126 | ||
127 | NOTE: SSLify_Options must be set first! | |
128 | ||
129 | SSLify_Options | |
130 | Accepts the location of the SSL key + certificate files and does it's job | |
131 | ||
132 | Optionally accepts the SSL version + CTX options | |
133 | SSLify_Options( $key, $cert, $version, $options ); | |
134 | ||
135 | Known versions: | |
136 | * sslv2 | |
137 | * sslv3 | |
138 | * tlsv1 | |
139 | * default | |
140 | ||
141 | By default we use the version: default | |
142 | ||
143 | By default we use the options: &Net::SSLeay::OP_ALL | |
144 | ||
145 | SSLify_GetCTX | |
146 | Returns the server-side CTX in case you wanted to play around with it :) | |
147 | ||
148 | If passed in a socket, it will return that socket's $ctx instead of the global. | |
149 | my $ctx = SSLify_GetCTX(); # get the one set via SSLify_Options | |
150 | my $ctx = SSLify_GetCTX( $sslified_sock ); # get the one in the object | |
151 | ||
152 | SSLify_GetCipher | |
153 | Returns the cipher used by the SSLified socket | |
154 | ||
155 | Example: | |
156 | print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n"; | |
157 | ||
158 | SSLify_GetSocket | |
159 | Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname() | |
160 | ||
161 | Example: | |
162 | print "Remote IP is: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[1] ) . "\n"; | |
163 | ||
164 | SSLify_ContextCreate | |
165 | Accepts some options, and returns a brand-new SSL context object ( $ctx ) | |
166 | my $ctx = SSLify_ContextCreate(); | |
167 | my $ctx = SSLify_ContextCreate( $key, $cert ); | |
168 | my $ctx = SSLify_ContextCreate( $key, $cert, $version, $options ); | |
169 | ||
170 | Known versions: | |
171 | * sslv2 | |
172 | * sslv3 | |
173 | * tlsv1 | |
174 | * default | |
175 | ||
176 | By default we use the version: default | |
177 | ||
178 | By default we don't set any options | |
179 | ||
180 | By default we don't use the SSL key + certificate files | |
181 | ||
182 | EXPORT | |
183 | Stuffs all of the above functions in @EXPORT_OK so you have to request them directly | |
184 | ||
185 | BUGS | |
186 | On Win32 platforms SSL support is pretty shaky, please help me out with | |
187 | detailed error descriptions if it happens to you! | |
188 | ||
189 | SEE ALSO | |
190 | POE | |
191 | ||
192 | Net::SSLeay | |
193 | ||
194 | AUTHOR | |
195 | Apocalypse <apocal@cpan.org> | |
196 | ||
197 | PROPS | |
198 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
199 | packaged up the code into something everyone could use and accepted the burden | |
200 | of maintaining it :) | |
201 | ||
202 | From the PoCo::Client::HTTP code =] | |
203 | # TODO - This code should probably become a POE::Kernel method, | |
204 | # seeing as it's rather baroque and potentially useful in a number | |
205 | # of places. | |
206 | ||
207 | COPYRIGHT AND LICENSE | |
208 | Copyright 2008 by Apocalypse/Rocco Caputo | |
209 | ||
210 | This library is free software; you can redistribute it and/or modify it | |
211 | under the same terms as Perl itself. | |
212 |
0 | # Declare our package | |
1 | package POE::Component::SSLify::ClientHandle; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = (qw$LastChangedRevision: 7 $)[1]; | |
7 | ||
8 | # Import the SSL death routines | |
9 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
10 | ||
11 | # We inherit from ServerHandle | |
12 | use vars qw( @ISA ); | |
13 | @ISA = qw( POE::Component::SSLify::ServerHandle ); | |
14 | ||
15 | # Override TIEHANDLE because we create a CTX | |
16 | sub TIEHANDLE { | |
17 | my ( $class, $socket, $version, $options, $ctx ) = @_; | |
18 | ||
19 | # create a context, if necessary | |
20 | if ( ! defined $ctx ) { | |
21 | $ctx = POE::Component::SSLify::createSSLcontext( undef, undef, $version, $options ); | |
22 | } | |
23 | ||
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 | my $self = bless { | |
33 | 'ssl' => $ssl, | |
34 | 'ctx' => $ctx, | |
35 | 'socket' => $socket, | |
36 | 'fileno' => $fileno, | |
37 | 'client' => 1, | |
38 | }, $class; | |
39 | ||
40 | return $self; | |
41 | } | |
42 | ||
43 | # End of module | |
44 | 1; | |
45 | ||
46 | __END__ | |
47 | ||
48 | =head1 NAME | |
49 | ||
50 | POE::Component::SSLify::ClientHandle - client object for POE::Component::SSLify | |
51 | ||
52 | =head1 ABSTRACT | |
53 | ||
54 | See POE::Component::SSLify::ServerHandle | |
55 | ||
56 | =head1 DESCRIPTION | |
57 | ||
58 | This is a subclass of ServerHandle to accomodate clients setting custom context objects. | |
59 | ||
60 | =head1 SEE ALSO | |
61 | ||
62 | L<POE::Component::SSLify> | |
63 | ||
64 | L<POE::Component::SSLify::ServerHandle> | |
65 | ||
66 | =head1 AUTHOR | |
67 | ||
68 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
69 | ||
70 | =head1 COPYRIGHT AND LICENSE | |
71 | ||
72 | Copyright 2008 by Apocalypse | |
73 | ||
74 | This library is free software; you can redistribute it and/or modify | |
75 | it under the same terms as Perl itself. | |
76 | ||
77 | =cut | |
0 | # $Id: ClientHandle.pm 53 2008-07-28 03:03:04Z larwan $ | |
1 | package POE::Component::SSLify::ClientHandle; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = (qw$LastChangedRevision: 53 $)[1]; | |
7 | ||
8 | # Import the SSL death routines | |
9 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
10 | ||
11 | # We inherit from ServerHandle | |
12 | use vars qw( @ISA ); | |
13 | require POE::Component::SSLify::ServerHandle; | |
14 | @ISA = qw( POE::Component::SSLify::ServerHandle ); | |
15 | ||
16 | # Override TIEHANDLE because we create a CTX | |
17 | sub TIEHANDLE { | |
18 | my ( $class, $socket, $version, $options, $ctx ) = @_; | |
19 | ||
20 | # create a context, if necessary | |
21 | if ( ! defined $ctx ) { | |
22 | $ctx = POE::Component::SSLify::createSSLcontext( undef, undef, $version, $options ); | |
23 | } | |
24 | ||
25 | my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" ); | |
26 | ||
27 | my $fileno = fileno( $socket ); | |
28 | ||
29 | Net::SSLeay::set_fd( $ssl, $fileno ); # Must use fileno | |
30 | ||
31 | my $resp = Net::SSLeay::connect( $ssl ) or die_if_ssl_error( 'ssl connect' ); | |
32 | ||
33 | my $self = bless { | |
34 | 'ssl' => $ssl, | |
35 | 'ctx' => $ctx, | |
36 | 'socket' => $socket, | |
37 | 'fileno' => $fileno, | |
38 | 'client' => 1, | |
39 | }, $class; | |
40 | ||
41 | return $self; | |
42 | } | |
43 | ||
44 | # End of module | |
45 | 1; | |
46 | ||
47 | __END__ | |
48 | ||
49 | =head1 NAME | |
50 | ||
51 | POE::Component::SSLify::ClientHandle - client object for POE::Component::SSLify | |
52 | ||
53 | =head1 ABSTRACT | |
54 | ||
55 | See POE::Component::SSLify::ServerHandle | |
56 | ||
57 | =head1 DESCRIPTION | |
58 | ||
59 | This is a subclass of ServerHandle to accomodate clients setting custom context objects. | |
60 | ||
61 | =head1 SEE ALSO | |
62 | ||
63 | L<POE::Component::SSLify> | |
64 | ||
65 | L<POE::Component::SSLify::ServerHandle> | |
66 | ||
67 | =head1 AUTHOR | |
68 | ||
69 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
70 | ||
71 | =head1 COPYRIGHT AND LICENSE | |
72 | ||
73 | Copyright 2008 by Apocalypse | |
74 | ||
75 | This library is free software; you can redistribute it and/or modify | |
76 | it under the same terms as Perl itself. | |
77 | ||
78 | =cut |
0 | # Declare our package | |
1 | package POE::Component::SSLify::ServerHandle; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = (qw$LastChangedRevision: 7 $)[1]; | |
7 | ||
8 | # Import the SSL death routines | |
9 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
10 | ||
11 | # Ties the socket | |
12 | sub TIEHANDLE { | |
13 | my ( $class, $socket, $ctx ) = @_; | |
14 | ||
15 | my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" ); | |
16 | ||
17 | my $fileno = fileno( $socket ); | |
18 | ||
19 | Net::SSLeay::set_fd( $ssl, $fileno ); | |
20 | ||
21 | my $err = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' ); | |
22 | ||
23 | my $self = bless { | |
24 | 'ssl' => $ssl, | |
25 | 'ctx' => $ctx, | |
26 | 'socket' => $socket, | |
27 | 'fileno' => $fileno, | |
28 | }, $class; | |
29 | ||
30 | return $self; | |
31 | } | |
32 | ||
33 | # Read something from the socket | |
34 | sub READ { | |
35 | # Get ourself! | |
36 | my $self = shift; | |
37 | ||
38 | # Get the pointers to buffer, length, and the offset | |
39 | my( $buf, $len, $offset ) = \( @_ ); | |
40 | ||
41 | # If we have no offset, replace the buffer with some input | |
42 | if ( ! defined $$offset ) { | |
43 | $$buf = Net::SSLeay::read( $self->{'ssl'}, $$len ); | |
44 | ||
45 | # Are we done? | |
46 | if ( defined $$buf ) { | |
47 | return length( $$buf ); | |
48 | } else { | |
49 | # Nah, clear the buffer too... | |
50 | $$buf = ""; | |
51 | return; | |
52 | } | |
53 | } | |
54 | ||
55 | # Now, actually read the data | |
56 | defined( my $read = Net::SSLeay::read( $self->{'ssl'}, $$len ) ) or return undef; | |
57 | ||
58 | # Figure out the buffer and offset | |
59 | my $buf_len = length( $$buf ); | |
60 | ||
61 | # If our offset is bigger, pad the buffer | |
62 | if ( $$offset > $buf_len ) { | |
63 | $$buf .= chr( 0 ) x ( $$offset - $buf_len ); | |
64 | } | |
65 | ||
66 | # Insert what we just read into the buffer | |
67 | substr( $$buf, $$offset ) = $read; | |
68 | ||
69 | # All done! | |
70 | return length( $read ); | |
71 | } | |
72 | ||
73 | # Write some stuff to the socket | |
74 | sub WRITE { | |
75 | # Get ourself + buffer + length + offset to write | |
76 | my( $self, $buf, $len, $offset ) = @_; | |
77 | ||
78 | # If we have nothing to offset, then start from the beginning | |
79 | if ( ! defined $offset ) { | |
80 | $offset = 0; | |
81 | } | |
82 | ||
83 | # We count the number of characters written to the socket | |
84 | my $wrote_len = Net::SSLeay::write( $self->{'ssl'}, substr( $buf, $offset, $len ) ); | |
85 | ||
86 | # Did we get an error or number of bytes written? | |
87 | # Net::SSLeay::write() returns the number of bytes written, or -1 on error. | |
88 | if ( $wrote_len < 0 ) { | |
89 | # The normal syswrite() POE uses expects 0 here. | |
90 | return 0; | |
91 | } else { | |
92 | # All done! | |
93 | return $wrote_len; | |
94 | } | |
95 | } | |
96 | ||
97 | # Sets binmode on the socket | |
98 | # Thanks to RT #27117 | |
99 | sub BINMODE { | |
100 | my $self = shift; | |
101 | if (@_) { | |
102 | my $mode = shift; | |
103 | binmode $self->{'socket'}, $mode; | |
104 | } else { | |
105 | binmode $self->{'socket'}; | |
106 | } | |
107 | } | |
108 | ||
109 | # Closes the socket | |
110 | sub CLOSE { | |
111 | my $self = shift; | |
112 | if ( defined $self->{'socket'} ) { | |
113 | Net::SSLeay::free( $self->{'ssl'} ); | |
114 | close( $self->{'socket'} ); | |
115 | undef $self->{'socket'}; | |
116 | ||
117 | # do we need to do CTX_free? | |
118 | if ( exists $self->{'client'} ) { | |
119 | Net::SSLeay::CTX_free( $self->{'ctx'} ); | |
120 | } | |
121 | } | |
122 | ||
123 | return 1; | |
124 | } | |
125 | ||
126 | # Add DESTROY handler | |
127 | sub DESTROY { | |
128 | my $self = shift; | |
129 | ||
130 | # Did we already CLOSE? | |
131 | if ( defined $self->{'socket'} ) { | |
132 | # Guess not... | |
133 | $self->CLOSE(); | |
134 | } | |
135 | } | |
136 | ||
137 | sub FILENO { | |
138 | my $self = shift; | |
139 | return $self->{'fileno'}; | |
140 | } | |
141 | ||
142 | # Not implemented TIE's | |
143 | sub READLINE { | |
144 | die 'Not Implemented'; | |
145 | } | |
146 | ||
147 | sub PRINT { | |
148 | die 'Not Implemented'; | |
149 | } | |
150 | ||
151 | # End of module | |
152 | 1; | |
153 | ||
154 | __END__ | |
155 | ||
156 | =head1 NAME | |
157 | ||
158 | POE::Component::SSLify::ServerHandle - server object for POE::Component::SSLify | |
159 | ||
160 | =head1 ABSTRACT | |
161 | ||
162 | See POE::Component::SSLify | |
163 | ||
164 | =head1 DESCRIPTION | |
165 | ||
166 | This is a subclass of Net::SSLeay::Handle because their read() and sysread() | |
167 | does not cooperate well with POE. They block until length bytes are read from the | |
168 | socket, and that is BAD in the world of POE... | |
169 | ||
170 | This subclass behaves exactly the same, except that it doesn't block :) | |
171 | ||
172 | =head2 DIFFERENCES | |
173 | ||
174 | This subclass doesn't know what to do with PRINT/READLINE, as they usually are not used in POE::Wheel operations... | |
175 | ||
176 | =head1 SEE ALSO | |
177 | ||
178 | L<POE::Component::SSLify> | |
179 | ||
180 | =head1 AUTHOR | |
181 | ||
182 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
183 | ||
184 | =head1 PROPS | |
185 | ||
186 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
187 | packaged up the code into something everyone could use... | |
188 | ||
189 | From the PoCo::Client::HTTP code for blocking sockets =] | |
190 | # TODO - This code should probably become a POE::Kernel method, | |
191 | # seeing as it's rather baroque and potentially useful in a number | |
192 | # of places. | |
193 | ||
194 | =head1 COPYRIGHT AND LICENSE | |
195 | ||
196 | Copyright 2008 by Apocalypse/Rocco Caputo | |
197 | ||
198 | This library is free software; you can redistribute it and/or modify | |
199 | it under the same terms as Perl itself. | |
200 | ||
201 | =cut | |
0 | # $Id: ServerHandle.pm 53 2008-07-28 03:03:04Z larwan $ | |
1 | package POE::Component::SSLify::ServerHandle; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = (qw$LastChangedRevision: 53 $)[1]; | |
7 | ||
8 | # Import the SSL death routines | |
9 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
10 | ||
11 | # Ties the socket | |
12 | sub TIEHANDLE { | |
13 | my ( $class, $socket, $ctx ) = @_; | |
14 | ||
15 | my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" ); | |
16 | ||
17 | my $fileno = fileno( $socket ); | |
18 | ||
19 | Net::SSLeay::set_fd( $ssl, $fileno ); | |
20 | ||
21 | my $err = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' ); | |
22 | ||
23 | my $self = bless { | |
24 | 'ssl' => $ssl, | |
25 | 'ctx' => $ctx, | |
26 | 'socket' => $socket, | |
27 | 'fileno' => $fileno, | |
28 | }, $class; | |
29 | ||
30 | return $self; | |
31 | } | |
32 | ||
33 | # Read something from the socket | |
34 | sub READ { | |
35 | # Get ourself! | |
36 | my $self = shift; | |
37 | ||
38 | # Get the pointers to buffer, length, and the offset | |
39 | my( $buf, $len, $offset ) = \( @_ ); | |
40 | ||
41 | # If we have no offset, replace the buffer with some input | |
42 | if ( ! defined $$offset ) { | |
43 | $$buf = Net::SSLeay::read( $self->{'ssl'}, $$len ); | |
44 | ||
45 | # Are we done? | |
46 | if ( defined $$buf ) { | |
47 | return length( $$buf ); | |
48 | } else { | |
49 | # Nah, clear the buffer too... | |
50 | $$buf = ""; | |
51 | return; | |
52 | } | |
53 | } | |
54 | ||
55 | # Now, actually read the data | |
56 | defined( my $read = Net::SSLeay::read( $self->{'ssl'}, $$len ) ) or return; | |
57 | ||
58 | # Figure out the buffer and offset | |
59 | my $buf_len = length( $$buf ); | |
60 | ||
61 | # If our offset is bigger, pad the buffer | |
62 | if ( $$offset > $buf_len ) { | |
63 | $$buf .= chr( 0 ) x ( $$offset - $buf_len ); | |
64 | } | |
65 | ||
66 | # Insert what we just read into the buffer | |
67 | substr( $$buf, $$offset ) = $read; | |
68 | ||
69 | # All done! | |
70 | return length( $read ); | |
71 | } | |
72 | ||
73 | # Write some stuff to the socket | |
74 | sub WRITE { | |
75 | # Get ourself + buffer + length + offset to write | |
76 | my( $self, $buf, $len, $offset ) = @_; | |
77 | ||
78 | # If we have nothing to offset, then start from the beginning | |
79 | if ( ! defined $offset ) { | |
80 | $offset = 0; | |
81 | } | |
82 | ||
83 | # We count the number of characters written to the socket | |
84 | my $wrote_len = Net::SSLeay::write( $self->{'ssl'}, substr( $buf, $offset, $len ) ); | |
85 | ||
86 | # Did we get an error or number of bytes written? | |
87 | # Net::SSLeay::write() returns the number of bytes written, or -1 on error. | |
88 | if ( $wrote_len < 0 ) { | |
89 | # The normal syswrite() POE uses expects 0 here. | |
90 | return 0; | |
91 | } else { | |
92 | # All done! | |
93 | return $wrote_len; | |
94 | } | |
95 | } | |
96 | ||
97 | # Sets binmode on the socket | |
98 | # Thanks to RT #27117 | |
99 | sub BINMODE { | |
100 | my $self = shift; | |
101 | if (@_) { | |
102 | my $mode = shift; | |
103 | binmode $self->{'socket'}, $mode; | |
104 | } else { | |
105 | binmode $self->{'socket'}; | |
106 | } | |
107 | } | |
108 | ||
109 | # Closes the socket | |
110 | sub CLOSE { | |
111 | my $self = shift; | |
112 | if ( defined $self->{'socket'} ) { | |
113 | Net::SSLeay::free( $self->{'ssl'} ); | |
114 | close( $self->{'socket'} ); | |
115 | undef $self->{'socket'}; | |
116 | ||
117 | # do we need to do CTX_free? | |
118 | if ( exists $self->{'client'} ) { | |
119 | Net::SSLeay::CTX_free( $self->{'ctx'} ); | |
120 | } | |
121 | } | |
122 | ||
123 | return 1; | |
124 | } | |
125 | ||
126 | # Add DESTROY handler | |
127 | sub DESTROY { | |
128 | my $self = shift; | |
129 | ||
130 | # Did we already CLOSE? | |
131 | if ( defined $self->{'socket'} ) { | |
132 | # Guess not... | |
133 | $self->CLOSE(); | |
134 | } | |
135 | } | |
136 | ||
137 | sub FILENO { | |
138 | my $self = shift; | |
139 | return $self->{'fileno'}; | |
140 | } | |
141 | ||
142 | # Not implemented TIE's | |
143 | sub READLINE { | |
144 | die 'Not Implemented'; | |
145 | } | |
146 | ||
147 | sub PRINT { | |
148 | die 'Not Implemented'; | |
149 | } | |
150 | ||
151 | # End of module | |
152 | 1; | |
153 | ||
154 | __END__ | |
155 | ||
156 | =head1 NAME | |
157 | ||
158 | POE::Component::SSLify::ServerHandle - server object for POE::Component::SSLify | |
159 | ||
160 | =head1 ABSTRACT | |
161 | ||
162 | See POE::Component::SSLify | |
163 | ||
164 | =head1 DESCRIPTION | |
165 | ||
166 | This is a subclass of Net::SSLeay::Handle because their read() and sysread() | |
167 | does not cooperate well with POE. They block until length bytes are read from the | |
168 | socket, and that is BAD in the world of POE... | |
169 | ||
170 | This subclass behaves exactly the same, except that it doesn't block :) | |
171 | ||
172 | =head2 DIFFERENCES | |
173 | ||
174 | This subclass doesn't know what to do with PRINT/READLINE, as they usually are not used in POE::Wheel operations... | |
175 | ||
176 | =head1 SEE ALSO | |
177 | ||
178 | L<POE::Component::SSLify> | |
179 | ||
180 | =head1 AUTHOR | |
181 | ||
182 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
183 | ||
184 | =head1 PROPS | |
185 | ||
186 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
187 | packaged up the code into something everyone could use... | |
188 | ||
189 | From the PoCo::Client::HTTP code for blocking sockets =] | |
190 | # TODO - This code should probably become a POE::Kernel method, | |
191 | # seeing as it's rather baroque and potentially useful in a number | |
192 | # of places. | |
193 | ||
194 | =head1 COPYRIGHT AND LICENSE | |
195 | ||
196 | Copyright 2008 by Apocalypse/Rocco Caputo | |
197 | ||
198 | This library is free software; you can redistribute it and/or modify | |
199 | it under the same terms as Perl itself. | |
200 | ||
201 | =cut |
0 | # Declare our package | |
1 | package POE::Component::SSLify; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version $LastChangedRevision: 7 $ | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = '0.13'; | |
7 | ||
8 | # We need Net::SSLeay or all's a failure! | |
9 | BEGIN { | |
10 | eval { require Net::SSLeay }; | |
11 | ||
12 | # Check for errors... | |
13 | if ( $@ ) { | |
14 | # Oh boy! | |
15 | die $@; | |
16 | } else { | |
17 | # Check to make sure the versions are what we want | |
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 | # Finally, load our subclass :) | |
24 | require POE::Component::SSLify::ClientHandle; | |
25 | require POE::Component::SSLify::ServerHandle; | |
26 | ||
27 | # Initialize Net::SSLeay | |
28 | Net::SSLeay::load_error_strings(); | |
29 | Net::SSLeay::SSLeay_add_ssl_algorithms(); | |
30 | Net::SSLeay::randomize(); | |
31 | } | |
32 | } | |
33 | ||
34 | # Do the exporting magic... | |
35 | require Exporter; | |
36 | use vars qw( @ISA @EXPORT_OK ); | |
37 | @ISA = qw( Exporter ); | |
38 | @EXPORT_OK = qw( Client_SSLify Server_SSLify SSLify_Options SSLify_GetCTX SSLify_GetCipher SSLify_GetSocket SSLify_ContextCreate ); | |
39 | ||
40 | # Bring in some socket-related stuff | |
41 | use Symbol qw( gensym ); | |
42 | use POSIX qw( F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK ); | |
43 | ||
44 | # We need the server-side stuff | |
45 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
46 | ||
47 | # The server-side CTX stuff | |
48 | my $ctx = undef; | |
49 | ||
50 | # Helper sub to set blocking on a handle | |
51 | sub Set_Blocking { | |
52 | my $socket = shift; | |
53 | ||
54 | # Net::SSLeay needs blocking for setup. | |
55 | # | |
56 | # ActiveState Perl 5.8.0 dislikes the Win32-specific code to make | |
57 | # a socket blocking, so we use IO::Handle's blocking(1) method. | |
58 | # Perl 5.005_03 doesn't like blocking(), so we only use it in | |
59 | # 5.8.0 and beyond. | |
60 | if ( $] >= 5.008 and $^O eq 'MSWin32' ) { | |
61 | # From IO::Handle POD | |
62 | # If an error occurs blocking will return undef and $! will be set. | |
63 | if ( ! $socket->blocking( 1 ) ) { | |
64 | die "Unable to set blocking mode on socket: $!"; | |
65 | } | |
66 | } else { | |
67 | # Make the handle blocking, the POSIX way. | |
68 | if ( $^O ne 'MSWin32' ) { | |
69 | # Get the old flags | |
70 | my $flags = fcntl( $socket, F_GETFL, 0 ) or die "fcntl( $socket, F_GETFL, 0 ) fails: $!"; | |
71 | ||
72 | # Okay, we patiently wait until the socket turns blocking mode | |
73 | until( fcntl( $socket, F_SETFL, $flags & ~O_NONBLOCK ) ) { | |
74 | # What was the error? | |
75 | if ( ! ( $! == EAGAIN or $! == EWOULDBLOCK ) ) { | |
76 | # Fatal error... | |
77 | die "fcntl( $socket, FSETFL, etc ) fails: $!"; | |
78 | } | |
79 | } | |
80 | } else { | |
81 | # Darned MSWin32 way... | |
82 | # Do some ioctl magic here | |
83 | # 126 is FIONBIO ( some docs say 0x7F << 16 ) | |
84 | my $flag = "0"; | |
85 | ioctl( $socket, 0x80000000 | ( 4 << 16 ) | ( ord( 'f' ) << 8 ) | 126, $flag ) or die "ioctl( $socket, FIONBIO, $flag ) fails: $!"; | |
86 | } | |
87 | } | |
88 | ||
89 | # All done! | |
90 | return $socket; | |
91 | } | |
92 | ||
93 | # Okay, the main routine here! | |
94 | sub Client_SSLify { | |
95 | # Get the socket + version + options + ctx | |
96 | my( $socket, $version, $options, $ctx ) = @_; | |
97 | ||
98 | # Validation... | |
99 | if ( ! defined $socket ) { | |
100 | die "Did not get a defined socket"; | |
101 | } | |
102 | ||
103 | # Set blocking on | |
104 | $socket = Set_Blocking( $socket ); | |
105 | ||
106 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
107 | my $newsock = gensym(); | |
108 | tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx ) or die "Unable to tie to our subclass: $!"; | |
109 | ||
110 | # All done! | |
111 | return $newsock; | |
112 | } | |
113 | ||
114 | # Okay, the main routine here! | |
115 | sub Server_SSLify { | |
116 | # Get the socket! | |
117 | my $socket = shift; | |
118 | ||
119 | # Validation... | |
120 | if ( ! defined $socket ) { | |
121 | die "Did not get a defined socket"; | |
122 | } | |
123 | ||
124 | # If we don't have a ctx ready, we can't do anything... | |
125 | if ( ! defined $ctx ) { | |
126 | die 'Please do SSLify_Options() first'; | |
127 | } | |
128 | ||
129 | # Set blocking on | |
130 | $socket = Set_Blocking( $socket ); | |
131 | ||
132 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
133 | my $newsock = gensym(); | |
134 | tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, $ctx ) or die "Unable to tie to our subclass: $!"; | |
135 | ||
136 | # All done! | |
137 | return $newsock; | |
138 | } | |
139 | ||
140 | sub SSLify_ContextCreate { | |
141 | # Get the key + cert + version + options | |
142 | my( $key, $cert, $version, $options ) = @_; | |
143 | ||
144 | return createSSLcontext( $key, $cert, $version, $options ); | |
145 | } | |
146 | ||
147 | sub SSLify_Options { | |
148 | # Get the key + cert + version + options | |
149 | my( $key, $cert, $version, $options ) = @_; | |
150 | ||
151 | # sanity | |
152 | if ( ! defined $key or ! defined $cert ) { | |
153 | die 'no key/cert specified'; | |
154 | return; | |
155 | } | |
156 | ||
157 | # Set the default | |
158 | if ( ! defined $options ) { | |
159 | $options = &Net::SSLeay::OP_ALL; | |
160 | } | |
161 | ||
162 | # set the context, possibly overwriting the previous one | |
163 | if ( defined $ctx ) { | |
164 | Net::SSLeay::CTX_free( $ctx ); | |
165 | undef $ctx; | |
166 | } | |
167 | $ctx = createSSLcontext( $key, $cert, $version, $options ); | |
168 | ||
169 | # all done! | |
170 | return 1; | |
171 | } | |
172 | ||
173 | sub createSSLcontext { | |
174 | my( $key, $cert, $version, $options ) = @_; | |
175 | ||
176 | my $context; | |
177 | if ( defined $version and ! ref $version ) { | |
178 | if ( $version eq 'sslv2' ) { | |
179 | $context = Net::SSLeay::CTX_v2_new(); | |
180 | } elsif ( $version eq 'sslv3' ) { | |
181 | $context = Net::SSLeay::CTX_v3_new(); | |
182 | } elsif ( $version eq 'tlsv1' ) { | |
183 | $context = Net::SSLeay::CTX_tlsv1_new(); | |
184 | } elsif ( $version eq 'default' ) { | |
185 | $context = Net::SSLeay::CTX_new(); | |
186 | } else { | |
187 | die "unknown SSL version: $version"; | |
188 | return; | |
189 | } | |
190 | } else { | |
191 | $context = Net::SSLeay::CTX_new(); | |
192 | } | |
193 | if ( ! defined $context ) { | |
194 | die_now( "Failed to create SSL_CTX $!" ); | |
195 | return; | |
196 | } | |
197 | ||
198 | # do we need to set options? | |
199 | if ( defined $options ) { | |
200 | Net::SSLeay::CTX_set_options( $context, $options ) and die_if_ssl_error( 'ssl ctx set options' ); | |
201 | } | |
202 | ||
203 | # do we need to set key/etc? | |
204 | if ( defined $key ) { | |
205 | # Following will ask password unless private key is not encrypted | |
206 | Net::SSLeay::CTX_use_RSAPrivateKey_file( $context, $key, &Net::SSLeay::FILETYPE_PEM ); | |
207 | die_if_ssl_error( 'private key' ); | |
208 | } | |
209 | ||
210 | # Set the cert file | |
211 | if ( defined $cert ) { | |
212 | Net::SSLeay::CTX_use_certificate_file( $context, $cert, &Net::SSLeay::FILETYPE_PEM ); | |
213 | die_if_ssl_error( 'certificate' ); | |
214 | } | |
215 | ||
216 | # All done! | |
217 | return $context; | |
218 | } | |
219 | ||
220 | # Returns the server-side CTX in case somebody wants to play with it | |
221 | sub SSLify_GetCTX { | |
222 | my $sock = shift; | |
223 | if ( ! defined $sock ) { | |
224 | return $ctx; | |
225 | } else { | |
226 | return tied( *$sock )->{'ctx'}; | |
227 | } | |
228 | } | |
229 | ||
230 | # Gives you the cipher type of a SSLified socket | |
231 | sub SSLify_GetCipher { | |
232 | my $sock = shift; | |
233 | return Net::SSLeay::get_cipher( tied( *$sock )->{'ssl'} ); | |
234 | } | |
235 | ||
236 | # Gives you the "Real" Socket to play with | |
237 | sub SSLify_GetSocket { | |
238 | my $sock = shift; | |
239 | return tied( *$sock )->{'socket'}; | |
240 | } | |
241 | ||
242 | # End of module | |
243 | 1; | |
244 | ||
245 | __END__ | |
246 | ||
247 | =head1 NAME | |
248 | ||
249 | POE::Component::SSLify - Makes using SSL in the world of POE easy! | |
250 | ||
251 | =head1 SYNOPSIS | |
252 | ||
253 | =head2 Client-side usage | |
254 | ||
255 | # Import the module | |
256 | use POE::Component::SSLify qw( Client_SSLify ); | |
257 | ||
258 | # Create a normal SocketFactory wheel or something | |
259 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
260 | ||
261 | # Converts the socket into a SSL socket POE can communicate with | |
262 | eval { $socket = Client_SSLify( $socket ) }; | |
263 | if ( $@ ) { | |
264 | # Unable to SSLify it... | |
265 | } | |
266 | ||
267 | # Now, hand it off to ReadWrite | |
268 | my $rw = POE::Wheel::ReadWrite->new( | |
269 | Handle => $socket, | |
270 | ... | |
271 | ); | |
272 | ||
273 | # Use it as you wish... | |
274 | ||
275 | =head2 Server-side usage | |
276 | ||
277 | # !!! Make sure you have a public key + certificate generated via Net::SSLeay's makecert.pl | |
278 | # excellent howto: http://www.akadia.com/services/ssh_test_certificate.html | |
279 | ||
280 | # Import the module | |
281 | use POE::Component::SSLify qw( Server_SSLify SSLify_Options ); | |
282 | ||
283 | # Set the key + certificate file | |
284 | eval { SSLify_Options( 'server.key', 'server.crt' ) }; | |
285 | if ( $@ ) { | |
286 | # Unable to load key or certificate file... | |
287 | } | |
288 | ||
289 | # Create a normal SocketFactory wheel or something | |
290 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
291 | ||
292 | # Converts the socket into a SSL socket POE can communicate with | |
293 | eval { $socket = Server_SSLify( $socket ) }; | |
294 | if ( $@ ) { | |
295 | # Unable to SSLify it... | |
296 | } | |
297 | ||
298 | # Now, hand it off to ReadWrite | |
299 | my $rw = POE::Wheel::ReadWrite->new( | |
300 | Handle => $socket, | |
301 | ... | |
302 | ); | |
303 | ||
304 | # Use it as you wish... | |
305 | ||
306 | =head1 ABSTRACT | |
307 | ||
308 | Makes SSL use in POE a breeze! | |
309 | ||
310 | =head1 DESCRIPTION | |
311 | ||
312 | This component represents the standard way to do SSL in POE. | |
313 | ||
314 | =head1 NOTES | |
315 | ||
316 | =head2 Socket methods doesn't work | |
317 | ||
318 | The new socket this module gives you actually is some tied socket magic, so you cannot do stuff like | |
319 | getpeername() or getsockname(). The only way to do it is to use SSLify_GetSocket and then operate on | |
320 | the socket it returns. | |
321 | ||
322 | =head2 Dying everywhere... | |
323 | ||
324 | This module will die() if Net::SSLeay could not be loaded or it is not the version we want. So, it is recommended | |
325 | that you check for errors and not use SSL, like so: | |
326 | ||
327 | eval { use POE::Component::SSLify }; | |
328 | if ( $@ ) { | |
329 | $sslavailable = 0; | |
330 | } else { | |
331 | $sslavailable = 1; | |
332 | } | |
333 | ||
334 | # Make socket SSL! | |
335 | if ( $sslavailable ) { | |
336 | eval { $socket = POE::Component::SSLify::Client_SSLify( $socket ) }; | |
337 | if ( $@ ) { | |
338 | # Unable to SSLify the socket... | |
339 | } | |
340 | } | |
341 | ||
342 | =head2 Mixing Server/Client in the same program | |
343 | ||
344 | Some users have reported success, others failure when they tried to utilize SSLify in both roles. This | |
345 | would require more investigation, so please tread carefully if you need to use it! | |
346 | ||
347 | =head1 FUNCTIONS | |
348 | ||
349 | =head2 Client_SSLify | |
350 | ||
351 | Accepts a socket, returns a brand new socket SSLified. Optionally accepts SSL | |
352 | context data. | |
353 | my $socket = shift; # get the socket from somewhere | |
354 | $socket = Client_SSLify( $socket ); # the default | |
355 | $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context | |
356 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context | |
357 | ||
358 | If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify | |
359 | will create it from the $version + $options parameters. | |
360 | ||
361 | Known versions: | |
362 | * sslv2 | |
363 | * sslv3 | |
364 | * tlsv1 | |
365 | * default | |
366 | ||
367 | By default we use the version: default | |
368 | ||
369 | By default we don't set any options | |
370 | ||
371 | NOTE: The way to have a client socket with proper certificates set up is: | |
372 | my $socket = shift; # get the socket from somewhere | |
373 | my $ctx = SSLify_ContextCreate( 'server.key', 'server.crt' ); | |
374 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); | |
375 | ||
376 | BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the | |
377 | socket is destroyed. This means you cannot reuse contexts! | |
378 | ||
379 | =head2 Server_SSLify | |
380 | ||
381 | Accepts a socket, returns a brand new socket SSLified | |
382 | my $socket = shift; # get the socket from somewhere | |
383 | $socket = Server_SSLify( $socket ); | |
384 | ||
385 | NOTE: SSLify_Options must be set first! | |
386 | ||
387 | =head2 SSLify_Options | |
388 | ||
389 | Accepts the location of the SSL key + certificate files and does it's job | |
390 | ||
391 | Optionally accepts the SSL version + CTX options | |
392 | SSLify_Options( $key, $cert, $version, $options ); | |
393 | ||
394 | Known versions: | |
395 | * sslv2 | |
396 | * sslv3 | |
397 | * tlsv1 | |
398 | * default | |
399 | ||
400 | By default we use the version: default | |
401 | ||
402 | By default we use the options: &Net::SSLeay::OP_ALL | |
403 | ||
404 | =head2 SSLify_GetCTX | |
405 | ||
406 | Returns the server-side CTX in case you wanted to play around with it :) | |
407 | ||
408 | If passed in a socket, it will return that socket's $ctx instead of the global. | |
409 | my $ctx = SSLify_GetCTX(); # get the one set via SSLify_Options | |
410 | my $ctx = SSLify_GetCTX( $sslified_sock ); # get the one in the object | |
411 | ||
412 | =head2 SSLify_GetCipher | |
413 | ||
414 | Returns the cipher used by the SSLified socket | |
415 | ||
416 | Example: | |
417 | print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n"; | |
418 | ||
419 | =head2 SSLify_GetSocket | |
420 | ||
421 | Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname() | |
422 | ||
423 | Example: | |
424 | print "Remote IP is: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[1] ) . "\n"; | |
425 | ||
426 | =head2 SSLify_ContextCreate | |
427 | ||
428 | Accepts some options, and returns a brand-new SSL context object ( $ctx ) | |
429 | my $ctx = SSLify_ContextCreate(); | |
430 | my $ctx = SSLify_ContextCreate( $key, $cert ); | |
431 | my $ctx = SSLify_ContextCreate( $key, $cert, $version, $options ); | |
432 | ||
433 | Known versions: | |
434 | * sslv2 | |
435 | * sslv3 | |
436 | * tlsv1 | |
437 | * default | |
438 | ||
439 | By default we use the version: default | |
440 | ||
441 | By default we don't set any options | |
442 | ||
443 | By default we don't use the SSL key + certificate files | |
444 | ||
445 | =head1 EXPORT | |
446 | ||
447 | Stuffs all of the above functions in @EXPORT_OK so you have to request them directly | |
448 | ||
449 | =head1 BUGS | |
450 | ||
451 | On Win32 platforms SSL support is pretty shaky, please help me out with detailed error descriptions if it happens to you! | |
452 | ||
453 | =head1 SEE ALSO | |
454 | ||
455 | L<POE> | |
456 | ||
457 | L<Net::SSLeay> | |
458 | ||
459 | =head1 AUTHOR | |
460 | ||
461 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
462 | ||
463 | =head1 PROPS | |
464 | ||
465 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
466 | packaged up the code into something everyone could use and accepted the burden | |
467 | of maintaining it :) | |
468 | ||
469 | From the PoCo::Client::HTTP code =] | |
470 | # TODO - This code should probably become a POE::Kernel method, | |
471 | # seeing as it's rather baroque and potentially useful in a number | |
472 | # of places. | |
473 | ||
474 | =head1 COPYRIGHT AND LICENSE | |
475 | ||
476 | Copyright 2008 by Apocalypse/Rocco Caputo | |
477 | ||
478 | This library is free software; you can redistribute it and/or modify | |
479 | it under the same terms as Perl itself. | |
480 | ||
481 | =cut | |
0 | # $Id: SSLify.pm 53 2008-07-28 03:03:04Z larwan $ | |
1 | package POE::Component::SSLify; | |
2 | use strict; use warnings; | |
3 | ||
4 | # Initialize our version $LastChangedRevision: 53 $ | |
5 | use vars qw( $VERSION ); | |
6 | $VERSION = '0.14'; | |
7 | ||
8 | # We need Net::SSLeay or all's a failure! | |
9 | BEGIN { | |
10 | eval { require Net::SSLeay }; | |
11 | ||
12 | # Check for errors... | |
13 | if ( $@ ) { | |
14 | # Oh boy! | |
15 | die $@; | |
16 | } else { | |
17 | # Check to make sure the versions are what we want | |
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 | # Finally, load our subclass :) | |
24 | require POE::Component::SSLify::ClientHandle; | |
25 | require POE::Component::SSLify::ServerHandle; | |
26 | ||
27 | # Initialize Net::SSLeay | |
28 | Net::SSLeay::load_error_strings(); | |
29 | Net::SSLeay::SSLeay_add_ssl_algorithms(); | |
30 | Net::SSLeay::randomize(); | |
31 | } | |
32 | } | |
33 | ||
34 | # Do the exporting magic... | |
35 | require Exporter; | |
36 | use vars qw( @ISA @EXPORT_OK ); | |
37 | @ISA = qw( Exporter ); | |
38 | @EXPORT_OK = qw( Client_SSLify Server_SSLify SSLify_Options SSLify_GetCTX SSLify_GetCipher SSLify_GetSocket SSLify_ContextCreate ); | |
39 | ||
40 | # Bring in some socket-related stuff | |
41 | use Symbol qw( gensym ); | |
42 | use POSIX qw( F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK ); | |
43 | ||
44 | # We need the server-side stuff | |
45 | use Net::SSLeay qw( die_now die_if_ssl_error ); | |
46 | ||
47 | # The server-side CTX stuff | |
48 | my $ctx = undef; | |
49 | ||
50 | # Helper sub to set blocking on a handle | |
51 | sub Set_Blocking { | |
52 | my $socket = shift; | |
53 | ||
54 | # Net::SSLeay needs blocking for setup. | |
55 | # | |
56 | # ActiveState Perl 5.8.0 dislikes the Win32-specific code to make | |
57 | # a socket blocking, so we use IO::Handle's blocking(1) method. | |
58 | # Perl 5.005_03 doesn't like blocking(), so we only use it in | |
59 | # 5.8.0 and beyond. | |
60 | if ( $] >= 5.008 and $^O eq 'MSWin32' ) { | |
61 | # From IO::Handle POD | |
62 | # If an error occurs blocking will return undef and $! will be set. | |
63 | if ( ! $socket->blocking( 1 ) ) { | |
64 | die "Unable to set blocking mode on socket: $!"; | |
65 | } | |
66 | } else { | |
67 | # Make the handle blocking, the POSIX way. | |
68 | if ( $^O ne 'MSWin32' ) { | |
69 | # Get the old flags | |
70 | my $flags = fcntl( $socket, F_GETFL, 0 ) or die "fcntl( $socket, F_GETFL, 0 ) fails: $!"; | |
71 | ||
72 | # Okay, we patiently wait until the socket turns blocking mode | |
73 | until( fcntl( $socket, F_SETFL, $flags & ~O_NONBLOCK ) ) { | |
74 | # What was the error? | |
75 | if ( ! ( $! == EAGAIN or $! == EWOULDBLOCK ) ) { | |
76 | # Fatal error... | |
77 | die "fcntl( $socket, FSETFL, etc ) fails: $!"; | |
78 | } | |
79 | } | |
80 | } else { | |
81 | # Darned MSWin32 way... | |
82 | # Do some ioctl magic here | |
83 | # 126 is FIONBIO ( some docs say 0x7F << 16 ) | |
84 | my $flag = "0"; | |
85 | ioctl( $socket, 0x80000000 | ( 4 << 16 ) | ( ord( 'f' ) << 8 ) | 126, $flag ) or die "ioctl( $socket, FIONBIO, $flag ) fails: $!"; | |
86 | } | |
87 | } | |
88 | ||
89 | # All done! | |
90 | return $socket; | |
91 | } | |
92 | ||
93 | # Okay, the main routine here! | |
94 | sub Client_SSLify { | |
95 | # Get the socket + version + options + ctx | |
96 | my( $socket, $version, $options, $ctx ) = @_; | |
97 | ||
98 | # Validation... | |
99 | if ( ! defined $socket ) { | |
100 | die "Did not get a defined socket"; | |
101 | } | |
102 | ||
103 | # Set blocking on | |
104 | $socket = Set_Blocking( $socket ); | |
105 | ||
106 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
107 | my $newsock = gensym(); | |
108 | tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx ) or die "Unable to tie to our subclass: $!"; | |
109 | ||
110 | # All done! | |
111 | return $newsock; | |
112 | } | |
113 | ||
114 | # Okay, the main routine here! | |
115 | sub Server_SSLify { | |
116 | # Get the socket! | |
117 | my $socket = shift; | |
118 | ||
119 | # Validation... | |
120 | if ( ! defined $socket ) { | |
121 | die "Did not get a defined socket"; | |
122 | } | |
123 | ||
124 | # If we don't have a ctx ready, we can't do anything... | |
125 | if ( ! defined $ctx ) { | |
126 | die 'Please do SSLify_Options() first'; | |
127 | } | |
128 | ||
129 | # Set blocking on | |
130 | $socket = Set_Blocking( $socket ); | |
131 | ||
132 | # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle | |
133 | my $newsock = gensym(); | |
134 | tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, $ctx ) or die "Unable to tie to our subclass: $!"; | |
135 | ||
136 | # All done! | |
137 | return $newsock; | |
138 | } | |
139 | ||
140 | sub SSLify_ContextCreate { | |
141 | # Get the key + cert + version + options | |
142 | my( $key, $cert, $version, $options ) = @_; | |
143 | ||
144 | return createSSLcontext( $key, $cert, $version, $options ); | |
145 | } | |
146 | ||
147 | sub SSLify_Options { | |
148 | # Get the key + cert + version + options | |
149 | my( $key, $cert, $version, $options ) = @_; | |
150 | ||
151 | # sanity | |
152 | if ( ! defined $key or ! defined $cert ) { | |
153 | die 'no key/cert specified'; | |
154 | return; | |
155 | } | |
156 | ||
157 | # Set the default | |
158 | if ( ! defined $options ) { | |
159 | $options = &Net::SSLeay::OP_ALL; | |
160 | } | |
161 | ||
162 | # set the context, possibly overwriting the previous one | |
163 | if ( defined $ctx ) { | |
164 | Net::SSLeay::CTX_free( $ctx ); | |
165 | undef $ctx; | |
166 | } | |
167 | $ctx = createSSLcontext( $key, $cert, $version, $options ); | |
168 | ||
169 | # all done! | |
170 | return 1; | |
171 | } | |
172 | ||
173 | sub createSSLcontext { | |
174 | my( $key, $cert, $version, $options ) = @_; | |
175 | ||
176 | my $context; | |
177 | if ( defined $version and ! ref $version ) { | |
178 | if ( $version eq 'sslv2' ) { | |
179 | $context = Net::SSLeay::CTX_v2_new(); | |
180 | } elsif ( $version eq 'sslv3' ) { | |
181 | $context = Net::SSLeay::CTX_v3_new(); | |
182 | } elsif ( $version eq 'tlsv1' ) { | |
183 | $context = Net::SSLeay::CTX_tlsv1_new(); | |
184 | } elsif ( $version eq 'default' ) { | |
185 | $context = Net::SSLeay::CTX_new(); | |
186 | } else { | |
187 | die "unknown SSL version: $version"; | |
188 | return; | |
189 | } | |
190 | } else { | |
191 | $context = Net::SSLeay::CTX_new(); | |
192 | } | |
193 | if ( ! defined $context ) { | |
194 | die_now( "Failed to create SSL_CTX $!" ); | |
195 | return; | |
196 | } | |
197 | ||
198 | # do we need to set options? | |
199 | if ( defined $options ) { | |
200 | Net::SSLeay::CTX_set_options( $context, $options ) and die_if_ssl_error( 'ssl ctx set options' ); | |
201 | } | |
202 | ||
203 | # do we need to set key/etc? | |
204 | if ( defined $key ) { | |
205 | # Following will ask password unless private key is not encrypted | |
206 | Net::SSLeay::CTX_use_RSAPrivateKey_file( $context, $key, &Net::SSLeay::FILETYPE_PEM ); | |
207 | die_if_ssl_error( 'private key' ); | |
208 | } | |
209 | ||
210 | # Set the cert file | |
211 | if ( defined $cert ) { | |
212 | Net::SSLeay::CTX_use_certificate_file( $context, $cert, &Net::SSLeay::FILETYPE_PEM ); | |
213 | die_if_ssl_error( 'certificate' ); | |
214 | } | |
215 | ||
216 | # All done! | |
217 | return $context; | |
218 | } | |
219 | ||
220 | # Returns the server-side CTX in case somebody wants to play with it | |
221 | sub SSLify_GetCTX { | |
222 | my $sock = shift; | |
223 | if ( ! defined $sock ) { | |
224 | return $ctx; | |
225 | } else { | |
226 | return tied( *$sock )->{'ctx'}; | |
227 | } | |
228 | } | |
229 | ||
230 | # Gives you the cipher type of a SSLified socket | |
231 | sub SSLify_GetCipher { | |
232 | my $sock = shift; | |
233 | return Net::SSLeay::get_cipher( tied( *$sock )->{'ssl'} ); | |
234 | } | |
235 | ||
236 | # Gives you the "Real" Socket to play with | |
237 | sub SSLify_GetSocket { | |
238 | my $sock = shift; | |
239 | return tied( *$sock )->{'socket'}; | |
240 | } | |
241 | ||
242 | # End of module | |
243 | 1; | |
244 | ||
245 | __END__ | |
246 | ||
247 | =head1 NAME | |
248 | ||
249 | POE::Component::SSLify - Makes using SSL in the world of POE easy! | |
250 | ||
251 | =head1 SYNOPSIS | |
252 | ||
253 | =head2 Client-side usage | |
254 | ||
255 | # Import the module | |
256 | use POE::Component::SSLify qw( Client_SSLify ); | |
257 | ||
258 | # Create a normal SocketFactory wheel or something | |
259 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
260 | ||
261 | # Converts the socket into a SSL socket POE can communicate with | |
262 | eval { $socket = Client_SSLify( $socket ) }; | |
263 | if ( $@ ) { | |
264 | # Unable to SSLify it... | |
265 | } | |
266 | ||
267 | # Now, hand it off to ReadWrite | |
268 | my $rw = POE::Wheel::ReadWrite->new( | |
269 | Handle => $socket, | |
270 | ... | |
271 | ); | |
272 | ||
273 | # Use it as you wish... | |
274 | ||
275 | =head2 Server-side usage | |
276 | ||
277 | # !!! Make sure you have a public key + certificate generated via Net::SSLeay's makecert.pl | |
278 | # excellent howto: http://www.akadia.com/services/ssh_test_certificate.html | |
279 | ||
280 | # Import the module | |
281 | use POE::Component::SSLify qw( Server_SSLify SSLify_Options ); | |
282 | ||
283 | # Set the key + certificate file | |
284 | eval { SSLify_Options( 'server.key', 'server.crt' ) }; | |
285 | if ( $@ ) { | |
286 | # Unable to load key or certificate file... | |
287 | } | |
288 | ||
289 | # Create a normal SocketFactory wheel or something | |
290 | my $factory = POE::Wheel::SocketFactory->new( ... ); | |
291 | ||
292 | # Converts the socket into a SSL socket POE can communicate with | |
293 | eval { $socket = Server_SSLify( $socket ) }; | |
294 | if ( $@ ) { | |
295 | # Unable to SSLify it... | |
296 | } | |
297 | ||
298 | # Now, hand it off to ReadWrite | |
299 | my $rw = POE::Wheel::ReadWrite->new( | |
300 | Handle => $socket, | |
301 | ... | |
302 | ); | |
303 | ||
304 | # Use it as you wish... | |
305 | ||
306 | =head1 ABSTRACT | |
307 | ||
308 | Makes SSL use in POE a breeze! | |
309 | ||
310 | =head1 DESCRIPTION | |
311 | ||
312 | This component represents the standard way to do SSL in POE. | |
313 | ||
314 | =head1 NOTES | |
315 | ||
316 | =head2 Socket methods doesn't work | |
317 | ||
318 | The new socket this module gives you actually is some tied socket magic, so you cannot do stuff like | |
319 | getpeername() or getsockname(). The only way to do it is to use SSLify_GetSocket and then operate on | |
320 | the socket it returns. | |
321 | ||
322 | =head2 Dying everywhere... | |
323 | ||
324 | This module will die() if Net::SSLeay could not be loaded or it is not the version we want. So, it is recommended | |
325 | that you check for errors and not use SSL, like so: | |
326 | ||
327 | eval { use POE::Component::SSLify }; | |
328 | if ( $@ ) { | |
329 | $sslavailable = 0; | |
330 | } else { | |
331 | $sslavailable = 1; | |
332 | } | |
333 | ||
334 | # Make socket SSL! | |
335 | if ( $sslavailable ) { | |
336 | eval { $socket = POE::Component::SSLify::Client_SSLify( $socket ) }; | |
337 | if ( $@ ) { | |
338 | # Unable to SSLify the socket... | |
339 | } | |
340 | } | |
341 | ||
342 | =head2 Mixing Server/Client in the same program | |
343 | ||
344 | Some users have reported success, others failure when they tried to utilize SSLify in both roles. This | |
345 | would require more investigation, so please tread carefully if you need to use it! | |
346 | ||
347 | =head1 FUNCTIONS | |
348 | ||
349 | =head2 Client_SSLify | |
350 | ||
351 | Accepts a socket, returns a brand new socket SSLified. Optionally accepts SSL | |
352 | context data. | |
353 | my $socket = shift; # get the socket from somewhere | |
354 | $socket = Client_SSLify( $socket ); # the default | |
355 | $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context | |
356 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context | |
357 | ||
358 | If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify | |
359 | will create it from the $version + $options parameters. | |
360 | ||
361 | Known versions: | |
362 | * sslv2 | |
363 | * sslv3 | |
364 | * tlsv1 | |
365 | * default | |
366 | ||
367 | By default we use the version: default | |
368 | ||
369 | By default we don't set any options | |
370 | ||
371 | NOTE: The way to have a client socket with proper certificates set up is: | |
372 | my $socket = shift; # get the socket from somewhere | |
373 | my $ctx = SSLify_ContextCreate( 'server.key', 'server.crt' ); | |
374 | $socket = Client_SSLify( $socket, undef, undef, $ctx ); | |
375 | ||
376 | BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the | |
377 | socket is destroyed. This means you cannot reuse contexts! | |
378 | ||
379 | =head2 Server_SSLify | |
380 | ||
381 | Accepts a socket, returns a brand new socket SSLified | |
382 | my $socket = shift; # get the socket from somewhere | |
383 | $socket = Server_SSLify( $socket ); | |
384 | ||
385 | NOTE: SSLify_Options must be set first! | |
386 | ||
387 | =head2 SSLify_Options | |
388 | ||
389 | Accepts the location of the SSL key + certificate files and does it's job | |
390 | ||
391 | Optionally accepts the SSL version + CTX options | |
392 | SSLify_Options( $key, $cert, $version, $options ); | |
393 | ||
394 | Known versions: | |
395 | * sslv2 | |
396 | * sslv3 | |
397 | * tlsv1 | |
398 | * default | |
399 | ||
400 | By default we use the version: default | |
401 | ||
402 | By default we use the options: &Net::SSLeay::OP_ALL | |
403 | ||
404 | =head2 SSLify_GetCTX | |
405 | ||
406 | Returns the server-side CTX in case you wanted to play around with it :) | |
407 | ||
408 | If passed in a socket, it will return that socket's $ctx instead of the global. | |
409 | my $ctx = SSLify_GetCTX(); # get the one set via SSLify_Options | |
410 | my $ctx = SSLify_GetCTX( $sslified_sock ); # get the one in the object | |
411 | ||
412 | =head2 SSLify_GetCipher | |
413 | ||
414 | Returns the cipher used by the SSLified socket | |
415 | ||
416 | Example: | |
417 | print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n"; | |
418 | ||
419 | =head2 SSLify_GetSocket | |
420 | ||
421 | Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname() | |
422 | ||
423 | Example: | |
424 | print "Remote IP is: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[1] ) . "\n"; | |
425 | ||
426 | =head2 SSLify_ContextCreate | |
427 | ||
428 | Accepts some options, and returns a brand-new SSL context object ( $ctx ) | |
429 | my $ctx = SSLify_ContextCreate(); | |
430 | my $ctx = SSLify_ContextCreate( $key, $cert ); | |
431 | my $ctx = SSLify_ContextCreate( $key, $cert, $version, $options ); | |
432 | ||
433 | Known versions: | |
434 | * sslv2 | |
435 | * sslv3 | |
436 | * tlsv1 | |
437 | * default | |
438 | ||
439 | By default we use the version: default | |
440 | ||
441 | By default we don't set any options | |
442 | ||
443 | By default we don't use the SSL key + certificate files | |
444 | ||
445 | =head1 EXPORT | |
446 | ||
447 | Stuffs all of the above functions in @EXPORT_OK so you have to request them directly | |
448 | ||
449 | =head1 BUGS | |
450 | ||
451 | On Win32 platforms SSL support is pretty shaky, please help me out with detailed error descriptions if it happens to you! | |
452 | ||
453 | =head1 SEE ALSO | |
454 | ||
455 | L<POE> | |
456 | ||
457 | L<Net::SSLeay> | |
458 | ||
459 | =head1 AUTHOR | |
460 | ||
461 | Apocalypse E<lt>apocal@cpan.orgE<gt> | |
462 | ||
463 | =head1 PROPS | |
464 | ||
465 | Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply | |
466 | packaged up the code into something everyone could use and accepted the burden | |
467 | of maintaining it :) | |
468 | ||
469 | From the PoCo::Client::HTTP code =] | |
470 | # TODO - This code should probably become a POE::Kernel method, | |
471 | # seeing as it's rather baroque and potentially useful in a number | |
472 | # of places. | |
473 | ||
474 | =head1 COPYRIGHT AND LICENSE | |
475 | ||
476 | Copyright 2008 by Apocalypse/Rocco Caputo | |
477 | ||
478 | This library is free software; you can redistribute it and/or modify | |
479 | it under the same terms as Perl itself. | |
480 | ||
481 | =cut |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Compile"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Compile required for validating the perl files'; | |
11 | } else { | |
12 | all_pm_files_ok(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | if ( not $ENV{PERL_TEST_CRITIC} ) { | |
9 | plan skip_all => 'PerlCritic test. Sent $ENV{PERL_TEST_CRITIC} to a true value to run.'; | |
10 | } else { | |
11 | # did we get a severity level? | |
12 | if ( length $ENV{PERL_TEST_CRITIC} > 1 ) { | |
13 | eval "use Test::Perl::Critic ( -severity => \"$ENV{PERL_TEST_CRITIC}\" );"; | |
14 | } else { | |
15 | eval "use Test::Perl::Critic;"; | |
16 | #eval "use Test::Perl::Critic ( -severity => 'stern' );"; | |
17 | } | |
18 | ||
19 | if ( $@ ) { | |
20 | plan skip_all => 'Test::Perl::Critic required to criticise perl files'; | |
21 | } else { | |
22 | all_critic_ok( 'lib/' ); | |
23 | } | |
24 | } | |
25 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Dependencies exclude => [ qw/ POE::Component::SSLify / ]"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Dependencies required to test perl module deps'; | |
11 | } else { | |
12 | ok_dependencies(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use File::Find::Rule"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'File::Find::Rule required for checking for presence of DOS newlines'; | |
11 | } else { | |
12 | plan tests => 1; | |
13 | ||
14 | # generate the file list | |
15 | my $rule = File::Find::Rule->new; | |
16 | $rule->grep( qr/\r\n/ ); | |
17 | my @files = $rule->in( qw( lib t examples ) ); | |
18 | ||
19 | # FIXME read in MANIFEST.SKIP and use it! | |
20 | # for now, we skip SVN stuff | |
21 | @files = grep { $_ !~ /\/\.svn\// } @files; | |
22 | ||
23 | # do we have any? | |
24 | if ( scalar @files ) { | |
25 | fail( 'newline check' ); | |
26 | diag( 'DOS newlines found in these files:' ); | |
27 | foreach my $f ( @files ) { | |
28 | diag( ' ' . $f ); | |
29 | } | |
30 | } else { | |
31 | pass( 'newline check' ); | |
32 | } | |
33 | } | |
34 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Fixme"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Fixme required for checking for presence of to-do stuff!'; | |
11 | } else { | |
12 | run_tests( | |
13 | 'where' => [ 'lib', 't' ], | |
14 | 'match' => 'FIX' . 'ME', # weird work-around suggested in POD so we don't catch ourself! | |
15 | ); | |
16 | } | |
17 | } |
10 | 10 | plan skip_all => 'Test::CheckManifest required for validating the MANIFEST'; |
11 | 11 | } else { |
12 | 12 | ok_manifest( { |
13 | 'filter' => [ qr/\.svn/, qr/\.tar\.gz$/, ], | |
13 | 'filter' => [ qr/\.svn/, qr/\.tar\.gz$/ ], | |
14 | 14 | } ); |
15 | 15 | } |
16 | 16 | } |
9 | 9 | if ( $@ ) { |
10 | 10 | plan skip_all => 'Test::MinimumVersion required to test minimum perl version'; |
11 | 11 | } else { |
12 | all_minimum_version_ok('5.008'); | |
12 | all_minimum_version_from_metayml_ok(); | |
13 | 13 | } |
14 | 14 | } |
5 | 5 | if ( not $ENV{TEST_AUTHOR} ) { |
6 | 6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; |
7 | 7 | } else { |
8 | eval "use Test::Pod"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Pod required for testing POD'; | |
8 | if ( not $ENV{PERL_TEST_POD} ) { | |
9 | plan skip_all => 'POD test. Sent $ENV{PERL_TEST_POD} to a true value to run.'; | |
11 | 10 | } else { |
12 | all_pod_files_ok(); | |
11 | eval "use Test::Pod"; | |
12 | if ( $@ ) { | |
13 | plan skip_all => 'Test::Pod required for testing POD'; | |
14 | } else { | |
15 | all_pod_files_ok(); | |
16 | } | |
13 | 17 | } |
14 | 18 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | if ( not $ENV{PERL_TEST_POD} ) { | |
9 | plan skip_all => 'POD test. Sent $ENV{PERL_TEST_POD} to a true value to run.'; | |
10 | } else { | |
11 | eval "use Test::Pod::Coverage"; | |
12 | if ( $@ ) { | |
13 | plan skip_all => "Test::Pod::Coverage required for testing POD coverage"; | |
14 | } else { | |
15 | # FIXME not used now | |
16 | #all_pod_coverage_ok( 'lib/'); | |
17 | plan skip_all => 'not done yet'; | |
18 | } | |
19 | } | |
20 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | if ( not $ENV{PERL_TEST_POD} ) { | |
9 | plan skip_all => 'POD test. Sent $ENV{PERL_TEST_POD} to a true value to run.'; | |
10 | } else { | |
11 | eval "use Test::Spelling"; | |
12 | if ( $@ ) { | |
13 | plan skip_all => 'Test::Spelling required to test POD for spelling errors'; | |
14 | } else { | |
15 | # FIXME need to figure out how to add custom vocabulary to dictionary | |
16 | all_pod_files_spelling_ok(); | |
17 | } | |
18 | } | |
19 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Pod::Coverage"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => "Test::Pod::Coverage required for testing POD coverage"; | |
11 | } else { | |
12 | # XXX not used now | |
13 | #all_pod_coverage_ok( 'lib/'); | |
14 | plan skip_all => 'not done yet'; | |
15 | } | |
16 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Prereq"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Prereq required to test perl module deps'; | |
11 | } else { | |
12 | prereq_ok(); | |
13 | } | |
14 | } |
0 | #!/usr/bin/perl | |
1 | ||
2 | use Test::More; | |
3 | ||
4 | # AUTHOR test | |
5 | if ( not $ENV{TEST_AUTHOR} ) { | |
6 | plan skip_all => 'Author test. Sent $ENV{TEST_AUTHOR} to a true value to run.'; | |
7 | } else { | |
8 | eval "use Test::Prereq::Build"; | |
9 | if ( $@ ) { | |
10 | plan skip_all => 'Test::Prereq required to test perl module deps'; | |
11 | } else { | |
12 | prereq_ok(); | |
13 | } | |
14 | } |