Codebase list libpoe-component-sslify-perl / 0da4e5f
* New upstream release. * debian/rules: refreshed from templates. * debian/watch: allow for v\d.+ format. * debian/control: add myself to Uploaders, bumped Standards-Version with no changes, added new build-dependencies. Martín Ferrari 15 years ago
24 changed file(s) with 1048 addition(s) and 828 deletion(s). Raw diff Collapse all Expand all
00 Revision history for Perl extension POE::Component::SSLify.
1
2 * 0.13
3
4 POD typo errors in SSLify_ContextCreate - thanks ASCENT!
5
6 * 0.12
7
8 Kwalitee-related fixes
9
10 * 0.11
11
12 allowed setting of client-side context ( $ctx ) object - thanks RT #34442
13
14 squashed typo in pod - thanks ASCENT!
15
16 changed version check code to regexp for compatibility with SSLeay v1.33_01 - thanks Mark!
17
18 added SSLify_ContextCreate helper function
19
20 backported Net::SSLeay's removal of %Filenum_Objects hash
121
222 * 0.10
323
0 Makefile.PL
1 MANIFEST
2 README
3 t/1_load.t
4 t/2_pod.t
0 Changes
1 examples/client.pl
2 examples/server.pl
53 lib/POE/Component/SSLify.pm
64 lib/POE/Component/SSLify/ClientHandle.pm
75 lib/POE/Component/SSLify/ServerHandle.pm
6 Makefile.PL
7 MANIFEST
8 MANIFEST.SKIP
89 META.yml
9 Changes
10 examples/server.pl
11 examples/client.pl
10 README
11 t/1_load.t
12 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
0 ^.includepath
1 ^.project
2 ^.settings/
3
4 # Avoid version control files.
5 \B\.svn\b
6
7 # Avoid Makemaker generated and utility files.
8 \bMANIFEST\.SKIP
9 \bMakefile$
10 \bblib/
11 \bMakeMaker-\d
12 \bpm_to_blib$
13
14 # Avoid Module::Build generated and utility files.
15 \bBuild$
16 \b_build/
17
18 # Avoid temp and backup files.
19 ~$
20 \.old$
21 \#$
22 \b\.#
23 \.bak$
24
25 # our tarballs
26 \.tar\.gz$
00 --- #YAML:1.0
11 name: POE-Component-SSLify
2 version: 0.10
3 abstract: Makes using SSL in the world of POE easy!
2 version: 0.13
3 abstract: Makes using SSL in the world of POE easy!
44 license: perl
5 generated_by: ExtUtils::MakeMaker version 6.31
5 author:
6 - Apocalypse <APOCAL@cpan.org>
7 generated_by: ExtUtils::MakeMaker version 6.44
68 distribution_type: module
79 requires:
810 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
921 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>
22 url: http://module-build.sourceforge.net/META-spec-v1.3.html
23 version: 1.3
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 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 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 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 libpoe-component-sslify-perl (0.13-1) UNRELEASED; urgency=low
1
2 * New upstream release.
3 * debian/rules: refreshed from templates.
4 * debian/watch: allow for v\d.+ format.
5 * debian/control: add myself to Uploaders, bumped Standards-Version with no
6 changes, added new build-dependencies.
7
8 -- Martín Ferrari <tincho@debian.org> Thu, 03 Jul 2008 04:40:11 -0300
9
010 libpoe-component-sslify-perl (0.10-1) unstable; urgency=low
111
212 [ Kees Cook ]
11 Section: perl
22 Priority: optional
33 Maintainer: Debian Perl Group <pkg-perl-maintainers@lists.alioth.debian.org>
4 Uploaders: Niko Tyni <ntyni@debian.org>
4 Uploaders: Niko Tyni <ntyni@debian.org>, Martín Ferrari <tincho@debian.org>
55 Build-Depends: debhelper (>= 5.0.0)
66 Build-Depends-Indep: perl (>= 5.8.8-7), libnet-ssleay-perl (>= 1.30),
7 libtest-pod-perl
8 Standards-Version: 3.7.3
7 libtest-pod-perl, libtest-distribution-perl, libtest-simple-perl,
8 libtest-pod-coverage-perl
9 Standards-Version: 3.8.0
910 Homepage: http://search.cpan.org/dist/POE-Component-SSLify/
1011 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libpoe-component-sslify-perl/
1112 Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/libpoe-component-sslify-perl/
00 #!/usr/bin/make -f
1 # This debian/rules file is provided as a template for normal perl
2 # packages. It was created by Marc Brockschmidt <marc@dch-faq.de> for
3 # the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
4 # be used freely wherever it is useful.
51
6 # Uncomment this to turn on verbose mode.
72 #export DH_VERBOSE=1
8
9 # If set to a true value then MakeMaker's prompt function will
10 # always return the default without waiting for user input.
113 export PERL_MM_USE_DEFAULT=1
124
13 PACKAGE=$(shell dh_listpackages)
14
15 ifndef PERL
16 PERL = /usr/bin/perl
17 endif
18
19 TMP =$(CURDIR)/debian/$(PACKAGE)
5 PERL ?= /usr/bin/perl
6 PACKAGE = $(shell dh_listpackages)
7 TMP = $(CURDIR)/debian/$(PACKAGE)
208
219 build: build-stamp
2210 build-stamp:
2311 dh_testdir
24
25 # Add commands to compile the package here
26 $(PERL) Makefile.PL INSTALLDIRS=vendor \
27 INSTALLVENDORARCH=/usr/share/perl5/ \
28 VENDORARCHEXP=/usr/share/perl5/
12 $(PERL) Makefile.PL INSTALLDIRS=vendor
2913 $(MAKE)
3014 $(MAKE) test
31
3215 touch $@
3316
3417 clean:
3518 dh_testdir
3619 dh_testroot
37
3820 dh_clean build-stamp install-stamp
39
40 # Add commands to clean up after the build process here
4121 [ ! -f Makefile ] || $(MAKE) realclean
4222
4323 install: install-stamp
4525 dh_testdir
4626 dh_testroot
4727 dh_clean -k
48
49 # Add commands to install the package into debian/$PACKAGE_NAME here
5028 $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
51
29 [ ! -d $(TMP)/usr/lib/perl5 ] || \
30 rmdir --ignore-fail-on-non-empty --parents --verbose \
31 $(TMP)/usr/lib/perl5
5232 touch $@
5333
5434 binary-arch:
6848 dh_md5sums
6949 dh_builddeb
7050
71 source diff:
72 @echo >&2 'source and diff are obsolete - use dpkg-source -b'; false
73
7451 binary: binary-indep binary-arch
75 .PHONY: build clean binary-indep binary-arch binary
52 .PHONY: build clean binary-indep binary-arch binary install
00 version=3
1 http://search.cpan.org/dist/POE-Component-SSLify/ .*/POE-Component-SSLify-([[:digit:]].*)\.tar\.gz
1 http://search.cpan.org/dist/POE-Component-SSLify/ \
2 .*/POE-Component-SSLify-v?(\d.*)\.tar\.gz
11 use strict; use warnings;
22
33 use POE;
4 use POE::Component::SSLify qw( Server_SSLify SSLify_Options );
4 use Socket qw( inet_ntoa unpack_sockaddr_in );
5 use POE::Component::SSLify qw( Server_SSLify SSLify_Options SSLify_GetCipher SSLify_GetSocket );
56 use POE::Wheel::ReadWrite;
67 use POE::Wheel::SocketFactory;
78 use POE::Driver::SysRW;
1112 'inline_states' => {
1213 '_start' => sub {
1314 # Okay, set the SSL options
14 SSLify_Options( 'server.key', 'server.crt', 'default' );
15 SSLify_Options( 'server.key', 'server.crt' );
1516
1617 # Set the alias
1718 $_[KERNEL]->alias_set( 'main' );
3233
3334 # SSLify it!
3435 $socket = Server_SSLify( $socket );
36
37 # testing stuff
38 warn "got connection from: " . inet_ntoa( ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $socket ) ) ) )[1] ) . " cipher type: " . SSLify_GetCipher( $socket );
3539
3640 # Hand it off to ReadWrite
3741 my $wheel = POE::Wheel::ReadWrite->new(
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: 1247 $
9 use vars qw( $VERSION );
10 $VERSION = '0.04';
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, $version, $options ) = @_;
22
23 my $ctx;
24 if ( defined $version and ! ref $version ) {
25 if ( $version eq 'sslv2' ) {
26 $ctx = Net::SSLeay::CTX_v2_new();
27 } elsif ( $version eq 'sslv3' ) {
28 $ctx = Net::SSLeay::CTX_v3_new();
29 } elsif ( $version eq 'tlsv1' ) {
30 $ctx = Net::SSLeay::CTX_tlsv1_new();
31 } elsif ( $version eq 'default' ) {
32 $ctx = Net::SSLeay::CTX_new();
33 } else {
34 die "unknown SSL version: $version";
35 }
36 } else {
37 $ctx = Net::SSLeay::CTX_new();
38 }
39 $ctx || die_now( "Failed to create SSL_CTX $!" );
40
41 if ( defined $options ) {
42 Net::SSLeay::CTX_set_options( $ctx, $options ) and die_if_ssl_error( 'ssl ctx set options' );
43 }
44
45 my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" );
46
47 my $fileno = fileno( $socket );
48
49 Net::SSLeay::set_fd( $ssl, $fileno ); # Must use fileno
50
51 my $resp = Net::SSLeay::connect( $ssl ) or die_if_ssl_error( 'ssl connect' );
52
53 $POE::Component::SSLify::ServerHandle::Filenum_Object{ $fileno } = {
54 ssl => $ssl,
55 ctx => $ctx,
56 socket => $socket,
57 };
58
59 return bless \$fileno, $class;
60 }
61
62 # Override close because it does not do CTX_Free, which is bad bad
63 sub CLOSE {
64 my $self = shift;
65 my $info = $self->_get_self();
66
67 # Thanks to Eric Waters -> closes RT #22372
68 if ( $info ) {
69 Net::SSLeay::free( $info->{'ssl'} );
70 Net::SSLeay::CTX_free( $info->{'ctx'} );
71 close $info->{'socket'};
72 }
73 delete $POE::Component::SSLify::ServerHandle::Filenum_Object{ $$self };
74 return 1;
75 }
76
77 # End of module
78 1;
79
80 __END__
81
82 =head1 NAME
83
84 POE::Component::SSLify::ClientHandle - client object for POE::Component::SSLify
85
86 =head1 ABSTRACT
87
88 See POE::Component::SSLify
89
90 =head1 DESCRIPTION
91
92 This is a subclass of Net::SSLeay::Handle because their read() and sysread()
93 does not cooperate well with POE. They block until length bytes are read from the
94 socket, and that is BAD in the world of POE...
95
96 This subclass behaves exactly the same, except that it doesn't block :)
97
98 =head1 SEE ALSO
99
100 L<POE::Component::SSLify>
101
102 =head1 AUTHOR
103
104 Apocalypse E<lt>apocal@cpan.orgE<gt>
105
106 =head1 PROPS
107
108 Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply
109 packaged up the code into something everyone could use...
110
111 From the PoCo::Client::HTTP code =]
112 # TODO - This code should probably become a POE::Kernel method,
113 # seeing as it's rather baroque and potentially useful in a number
114 # of places.
115
116 =head1 COPYRIGHT AND LICENSE
117
118 Copyright 2007 by Apocalypse/Rocco Caputo
119
120 This library is free software; you can redistribute it and/or modify
121 it under the same terms as Perl itself.
122
123 =cut
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 # 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: 1247 $
9 use vars qw( $VERSION );
10 $VERSION = '0.04';
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
164 =head1 NAME
165
166 POE::Component::SSLify::ServerHandle - server object for POE::Component::SSLify
167
168 =head1 ABSTRACT
169
170 See POE::Component::SSLify
171
172 =head1 DESCRIPTION
173
174 This is a subclass of Net::SSLeay::Handle because their read() and sysread()
175 does not cooperate well with POE. They block until length bytes are read from the
176 socket, and that is BAD in the world of POE...
177
178 This subclass behaves exactly the same, except that it doesn't block :)
179
180 =head2 DIFFERENCES
181
182 This subclass doesn't know what to do with PRINT/READLINE, as they usually are not used in POE::Wheel operations...
183
184 =head1 SEE ALSO
185
186 L<POE::Component::SSLify>
187
188 =head1 AUTHOR
189
190 Apocalypse E<lt>apocal@cpan.orgE<gt>
191
192 =head1 PROPS
193
194 Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply
195 packaged up the code into something everyone could use...
196
197 From the PoCo::Client::HTTP code for blocking sockets =]
198 # TODO - This code should probably become a POE::Kernel method,
199 # seeing as it's rather baroque and potentially useful in a number
200 # of places.
201
202 =head1 COPYRIGHT AND LICENSE
203
204 Copyright 2007 by Apocalypse/Rocco Caputo
205
206 This library is free software; you can redistribute it and/or modify
207 it under the same terms as Perl itself.
208
209 =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 # 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: 1248 $
9 our $VERSION = '0.10';
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 + version + options
100 my( $socket, $version, $options ) = @_;
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, $version, $options ) 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 sub SSLify_Options {
145 # Get the key + cert + version + options
146 my( $key, $cert, $version, $options ) = @_;
147
148 if ( defined $version and ! ref $version ) {
149 if ( $version eq 'sslv2' ) {
150 $ctx = Net::SSLeay::CTX_v2_new();
151 } elsif ( $version eq 'sslv3' ) {
152 $ctx = Net::SSLeay::CTX_v3_new();
153 } elsif ( $version eq 'tlsv1' ) {
154 $ctx = Net::SSLeay::CTX_tlsv1_new();
155 } elsif ( $version eq 'default' ) {
156 $ctx = Net::SSLeay::CTX_new();
157 } else {
158 die "unknown SSL version: $version";
159 }
160 } else {
161 $ctx = Net::SSLeay::CTX_new();
162 }
163 if ( ! defined $ctx ) {
164 die_now( "Failed to create SSL_CTX $!" );
165 }
166
167 # Set the default
168 if ( ! defined $options ) {
169 $options = &Net::SSLeay::OP_ALL;
170 }
171
172 Net::SSLeay::CTX_set_options( $ctx, $options ) and die_if_ssl_error( 'ssl ctx set options' );
173
174 # Following will ask password unless private key is not encrypted
175 Net::SSLeay::CTX_use_RSAPrivateKey_file( $ctx, $key, &Net::SSLeay::FILETYPE_PEM );
176 die_if_ssl_error( 'private key' );
177
178 # Set the cert file
179 Net::SSLeay::CTX_use_certificate_file( $ctx, $cert, &Net::SSLeay::FILETYPE_PEM );
180 die_if_ssl_error( 'certificate' );
181
182 # All done!
183 return 1;
184 }
185
186 # Returns the server-side CTX in case somebody wants to play with it
187 sub SSLify_GetCTX {
188 return $ctx;
189 }
190
191 # Gives you the cipher type of a SSLified socket
192 sub SSLify_GetCipher {
193 my $sock = shift;
194 return Net::SSLeay::get_cipher( tied( *$sock )->_get_self()->{'ssl'} );
195 }
196
197 # Gives you the "Real" Socket to play with
198 sub SSLify_GetSocket {
199 my $sock = shift;
200 return tied( *$sock )->_get_self()->{'socket'};
201 }
202
203 # End of module
204 1;
205
206 __END__
207
208 =head1 NAME
209
210 POE::Component::SSLify - Makes using SSL in the world of POE easy!
211
212 =head1 SYNOPSIS
213
214 =head2 Client-side usage
215
216 # Import the module
217 use POE::Component::SSLify qw( Client_SSLify );
218
219 # Create a normal SocketFactory wheel or something
220 my $factory = POE::Wheel::SocketFactory->new( ... );
221
222 # Converts the socket into a SSL socket POE can communicate with
223 eval { $socket = Client_SSLify( $socket ) };
224 if ( $@ ) {
225 # Unable to SSLify it...
226 }
227
228 # Now, hand it off to ReadWrite
229 my $rw = POE::Wheel::ReadWrite->new(
230 Handle => $socket,
231 ...
232 );
233
234 # Use it as you wish...
235
236 =head2 Server-side usage
237
238 # !!! Make sure you have a public key + certificate generated via Net::SSLeay's makecert.pl
239 # excellent howto: http://www.akadia.com/services/ssh_test_certificate.html
240
241 # Import the module
242 use POE::Component::SSLify qw( Server_SSLify SSLify_Options );
243
244 # Set the key + certificate file
245 eval { SSLify_Options( 'server.key', 'server.crt' ) };
246 if ( $@ ) {
247 # Unable to load key or certificate file...
248 }
249
250 # Create a normal SocketFactory wheel or something
251 my $factory = POE::Wheel::SocketFactory->new( ... );
252
253 # Converts the socket into a SSL socket POE can communicate with
254 eval { $socket = Server_SSLify( $socket ) };
255 if ( $@ ) {
256 # Unable to SSLify it...
257 }
258
259 # Now, hand it off to ReadWrite
260 my $rw = POE::Wheel::ReadWrite->new(
261 Handle => $socket,
262 ...
263 );
264
265 # Use it as you wish...
266
267 =head1 ABSTRACT
268
269 Makes SSL use in POE a breeze!
270
271 =head1 DESCRIPTION
272
273 This component represents the standard way to do SSL in POE.
274
275 =head1 NOTES
276
277 =head2 Socket methods doesn't work
278
279 The new socket this module gives you actually is some tied socket magic, so you cannot do stuff like
280 getpeername() or getsockname(). The only way to do it is to use SSLify_GetSocket and then operate on
281 the socket it returns.
282
283 =head2 Dying everywhere...
284
285 This module will die() if Net::SSLeay could not be loaded or it is not the version we want. So, it is recommended
286 that you check for errors and not use SSL, like so:
287
288 eval { use POE::Component::SSLify };
289 if ( $@ ) {
290 $sslavailable = 0;
291 } else {
292 $sslavailable = 1;
293 }
294
295 # Make socket SSL!
296 if ( $sslavailable ) {
297 eval { $socket = POE::Component::SSLify::Client_SSLify( $socket ) };
298 if ( $@ ) {
299 # Unable to SSLify the socket...
300 }
301 }
302
303 =head1 FUNCTIONS
304
305 =head2 Client_SSLify
306
307 Accepts a socket, returns a brand new socket SSLified
308
309 Optionally accepts the SSL version + CTX options
310 Client_SSLify( $socket, $version, $options );
311
312 Known versions:
313 * sslv2
314 * sslv3
315 * tlsv1
316 * default
317
318 By default we use the version: default
319
320 By default we don't set any options
321
322 =head2 Server_SSLify
323
324 Accepts a socket, returns a brand new socket SSLified
325
326 NOTE: SSLify_Options must be set first!
327
328 =head2 SSLify_Options
329
330 Accepts the location of the SSL key + certificate files and does it's job
331
332 Optionally accepts the SSL version + CTX options
333 SSLify_Options( $key, $cert, $version, $options );
334
335 Known versions:
336 * sslv2
337 * sslv3
338 * tlsv1
339 * default
340
341 By default we use the version: default
342
343 By default we use the options: &Net::SSLeay::OP_ALL
344
345 =head2 SSLify_GetCTX
346
347 Returns the server-side CTX in case you wanted to play around with it :)
348
349 =head2 SSLify_GetCipher
350
351 Returns the cipher used by the SSLified socket
352
353 Example:
354 print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n";
355
356 =head2 SSLify_GetSocket
357
358 Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname()
359
360 Example:
361 print "Remote IP is: " . ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[0] . "\n";
362
363 =head1 EXPORT
364
365 Stuffs all the 4 functions in @EXPORT_OK so you have to request them directly
366
367 =head1 BUGS
368
369 On Win32 platforms SSL support is pretty shaky, please help me out with detailed error descriptions if it happens to you!
370
371 =head1 SEE ALSO
372
373 L<POE>
374
375 L<Net::SSLeay>
376
377 =head1 AUTHOR
378
379 Apocalypse E<lt>apocal@cpan.orgE<gt>
380
381 =head1 PROPS
382
383 Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply
384 packaged up the code into something everyone could use and accepted the burden
385 of maintaining it :)
386
387 From the PoCo::Client::HTTP code =]
388 # TODO - This code should probably become a POE::Kernel method,
389 # seeing as it's rather baroque and potentially useful in a number
390 # of places.
391
392 =head1 COPYRIGHT AND LICENSE
393
394 Copyright 2007 by Apocalypse/Rocco Caputo
395
396 This library is free software; you can redistribute it and/or modify
397 it under the same terms as Perl itself.
398
399 =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 use Test::More tests => 1;
0 #!/usr/bin/perl
11
2 # Test the load!
3 use_ok('POE::Component::SSLify');
2 # Import the stuff
3 use Test::UseAllModules;
4 BEGIN { all_uses_ok(); }
+0
-4
t/2_pod.t less more
0 use Test::More;
1 eval "use Test::Pod 1.00";
2 plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
3 all_pod_files_ok();
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 "require Test::Distribution";
9 if ( $@ ) {
10 plan skip_all => 'Test::Distribution required for validating the dist';
11 } else {
12 Test::Distribution->import( not => 'podcover' );
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::HasVersion";
9 if ( $@ ) {
10 plan skip_all => 'Test::HasVersion required for testing for version numbers';
11 } else {
12 all_pm_version_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 "require Test::Kwalitee";
9 if ( $@ ) {
10 plan skip_all => 'Test::Kwalitee required for measuring the kwalitee';
11 } else {
12 Test::Kwalitee->import();
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::CheckManifest";
9 if ( $@ ) {
10 plan skip_all => 'Test::CheckManifest required for validating the MANIFEST';
11 } else {
12 ok_manifest( {
13 'filter' => [ qr/\.svn/, qr/\.tar\.gz$/, ],
14 } );
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::MinimumVersion";
9 if ( $@ ) {
10 plan skip_all => 'Test::MinimumVersion required to test minimum perl version';
11 } else {
12 all_minimum_version_ok('5.008');
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::Pod";
9 if ( $@ ) {
10 plan skip_all => 'Test::Pod required for testing POD';
11 } else {
12 all_pod_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 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::Strict";
9 if ( $@ ) {
10 plan skip_all => 'Test::Strict required to test strictness';
11 } else {
12 all_perl_files_ok( 'lib/' );
13 }
14 }