r8480 - in /branches/upstream/libpoe-component-sslify-perl: ./ current/ current/examples/ current/lib/ current/lib/POE/ current/lib/POE/Component/ current/lib/POE/Component/SSLify/ current/t/
keescook-guest at users.alioth.debian.org
keescook-guest at users.alioth.debian.org
Tue Oct 23 05:16:19 UTC 2007
Author: keescook-guest
Date: Tue Oct 23 05:16:19 2007
New Revision: 8480
URL: http://svn.debian.org/wsvn/?sc=1&rev=8480
Log:
[svn-inject] Installing original source of libpoe-component-sslify-perl
Added:
branches/upstream/libpoe-component-sslify-perl/
branches/upstream/libpoe-component-sslify-perl/current/
branches/upstream/libpoe-component-sslify-perl/current/Changes
branches/upstream/libpoe-component-sslify-perl/current/MANIFEST
branches/upstream/libpoe-component-sslify-perl/current/META.yml
branches/upstream/libpoe-component-sslify-perl/current/Makefile.PL
branches/upstream/libpoe-component-sslify-perl/current/README
branches/upstream/libpoe-component-sslify-perl/current/examples/
branches/upstream/libpoe-component-sslify-perl/current/examples/server.pl
branches/upstream/libpoe-component-sslify-perl/current/lib/
branches/upstream/libpoe-component-sslify-perl/current/lib/POE/
branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/
branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/
branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify.pm
branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ClientHandle.pm
branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ServerHandle.pm
branches/upstream/libpoe-component-sslify-perl/current/t/
branches/upstream/libpoe-component-sslify-perl/current/t/1_load.t
branches/upstream/libpoe-component-sslify-perl/current/t/2_pod.t
Added: branches/upstream/libpoe-component-sslify-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/Changes?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/Changes (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/Changes Tue Oct 23 05:16:19 2007
@@ -1,0 +1,43 @@
+Revision history for Perl extension POE::Component::SSLify.
+
+* 0.08
+
+ Added support for BINMODE - thanks RT #27117
+
+* 0.07
+
+ Fixed undefined $info - thanks RT #22372
+
+* 0.06
+
+ Kwalitee-related fixes
+
+* 0.05
+
+ Finally use a Changes file - thanks RT #18981
+ Documentation tweaks
+ Upgraded Net::SSLeay requirement to 1.30 to help Win32 problems
+
+* 0.04
+
+ Added new functions to extract data from the SSL socket -> GetCipher and GetSocket
+ In the case somebody knows Net::SSLeay more than me, added GetCTX to return the server-side CTX object
+ Removed the dependency on Net::SSLeay::Handle
+
+* 0.03
+
+ First stab at the server-side code, help me test it out!
+ Refactored SSLify() into client/server side, so update your program accordingly!
+
+* 0.02
+
+ Made sure the IO::Handle way was used only on MSWin32
+
+ * SSLify::ServerHandle
+ Removed _CIPHER and moved it to the main SSLify.pm code
+ Oops, forgot to override _get_self and _get_ssl
+ Fixed a nasty leak issue
+
+* 0.01
+
+ Initial release
Added: branches/upstream/libpoe-component-sslify-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/MANIFEST?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/MANIFEST (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/MANIFEST Tue Oct 23 05:16:19 2007
@@ -1,0 +1,11 @@
+Makefile.PL
+MANIFEST
+README
+t/1_load.t
+t/2_pod.t
+lib/POE/Component/SSLify.pm
+lib/POE/Component/SSLify/ClientHandle.pm
+lib/POE/Component/SSLify/ServerHandle.pm
+META.yml
+Changes
+examples/server.pl
Added: branches/upstream/libpoe-component-sslify-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/META.yml?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/META.yml (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/META.yml Tue Oct 23 05:16:19 2007
@@ -1,0 +1,14 @@
+--- #YAML:1.0
+name: POE-Component-SSLify
+version: 0.08
+abstract: Makes using SSL in the world of POE easy!
+license: perl
+generated_by: ExtUtils::MakeMaker version 6.31
+distribution_type: module
+requires:
+ Net::SSLeay: 1.30
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Apocalypse <APOCAL at cpan.org>
Added: branches/upstream/libpoe-component-sslify-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/Makefile.PL?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/Makefile.PL (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/Makefile.PL Tue Oct 23 05:16:19 2007
@@ -1,0 +1,17 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'POE::Component::SSLify',
+ 'VERSION_FROM' => 'lib/POE/Component/SSLify.pm',
+ 'PREREQ_PM' => {
+ 'Net::SSLeay' => '1.30',
+ },
+ ( $] >= 5.005 ? # Add new keywords
+ (
+ 'ABSTRACT_FROM' => 'lib/POE/Component/SSLify.pm', # retrieve abstract from module
+ 'AUTHOR' => 'Apocalypse <APOCAL at cpan.org>',
+ 'LICENSE' => 'perl',
+ ) : ()
+ ),
+);
Added: branches/upstream/libpoe-component-sslify-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/README?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/README (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/README Tue Oct 23 05:16:19 2007
@@ -1,0 +1,18 @@
+POE-Component-SSLify
+====================
+
+This module makes Net::SSLeay's SSL sockets behave with POE :)
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+MORE INFO
+
+ # After installing:
+ perldoc POE::Component::SSLify
Added: branches/upstream/libpoe-component-sslify-perl/current/examples/server.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/examples/server.pl?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/examples/server.pl (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/examples/server.pl Tue Oct 23 05:16:19 2007
@@ -1,0 +1,80 @@
+use POE;
+use POE::Component::SSLify qw( Server_SSLify SSLify_Options );
+use POE::Wheel::ReadWrite;
+use POE::Wheel::SocketFactory;
+use POE::Driver::SysRW;
+use POE::Filter::Line;
+
+# Needs to generate the SSL certs before running this!
+
+POE::Session->new(
+ 'inline_states' => {
+ '_start' => sub {
+ # Okay, set the SSL options
+ SSLify_Options( 'public-key.pem', 'public-cert.pem' );
+
+ # Create the socketfactory wheel to listen for requests
+ $_[HEAP]->{'SOCKETFACTORY'} = POE::Wheel::SocketFactory->new(
+ 'BindPort' => 5432,
+ 'BindAddress' => localhost,
+ 'Reuse' => 'yes',
+ 'SuccessEvent' => 'Got_Connection',
+ 'FailureEvent' => 'ListenerError',
+ );
+ return;
+ },
+ 'Got_Connection' => sub {
+ # ARG0 = Socket, ARG1 = Remote Address, ARG2 = Remote Port
+ my $socket = $_[ ARG0 ];
+
+ # SSLify it!
+ $socket = Server_SSLify( $socket );
+
+ # Hand it off to ReadWrite
+ my $wheel = POE::Wheel::ReadWrite->new(
+ 'Handle' => $socket,
+ 'Driver' => POE::Driver::SysRW->new(),
+ 'Filter' => POE::Filter::Line->new(),
+ 'InputEvent' => 'Got_Input',
+ 'FlushedEvent' => 'Got_Flush',
+ 'ErrorEvent' => 'Got_Error',
+ );
+
+ # Store it...
+ $_[HEAP]->{'WHEELS'}->{ $wheel->ID } = $wheel;
+ return;
+ },
+ 'ListenerError' => sub {
+ # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
+ my ( $operation, $errnum, $errstr, $wheel_id ) = @_[ ARG0 .. ARG3 ];
+ warn "SocketFactory Wheel $wheel_id generated $operation error $errnum: $errstr\n";
+
+ return;
+ },
+ 'Got_Input' => sub {
+ # ARG0: The Line, ARG1: Wheel ID
+
+ # Send back to the client the line!
+ $_[HEAP]->{'WHEELS'}->{ $_[ARG1] }->put( $_[ARG0] );
+ return;
+ },
+ 'Got_Flush' => sub {
+ # Done with a wheel
+ delete $_[HEAP]->{'WHEELS'}->{ $_[ARG0] };
+ return;
+ },
+ 'Got_Error' => sub {
+ # ARG0 = operation, ARG1 = error number, ARG2 = error string, ARG3 = wheel ID
+ my ( $operation, $errnum, $errstr, $id ) = @_[ ARG0 .. ARG3 ];
+ warn "Wheel $id generated $operation error $errnum: $errstr\n";
+
+ # Done with a wheel
+ delete $_[HEAP]->{'WHEELS'}->{ $_[ARG0] };
+ return;
+ },
+ },
+);
+
+# Start POE!
+POE::Kernel->run();
+exit 0;
Added: branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify.pm?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify.pm (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify.pm Tue Oct 23 05:16:19 2007
@@ -1,0 +1,354 @@
+# Declare our package
+package POE::Component::SSLify;
+
+# Standard stuff to catch errors
+use strict qw(subs vars refs); # Make sure we can't mess up
+use warnings FATAL => 'all'; # Enable warnings to catch errors
+
+# Initialize our version
+# $Revision: 1213 $
+our $VERSION = '0.08';
+
+# We need Net::SSLeay or all's a failure!
+BEGIN {
+ eval { require Net::SSLeay };
+
+ # Check for errors...
+ if ( $@ ) {
+ # Oh boy!
+ die $@;
+ } else {
+ # Check to make sure the versions are what we want
+ if ( ! ( defined $Net::SSLeay::VERSION and
+ $Net::SSLeay::VERSION >= 1.30 ) ) {
+ # Argh...
+ die 'Please upgrade Net::SSLeay to 1.30+';
+ } else {
+ # Finally, load our subclass :)
+ require POE::Component::SSLify::ClientHandle;
+ require POE::Component::SSLify::ServerHandle;
+
+ # Initialize Net::SSLeay
+ Net::SSLeay::load_error_strings();
+ Net::SSLeay::SSLeay_add_ssl_algorithms();
+ Net::SSLeay::randomize();
+ }
+ }
+}
+
+# Do the exporting magic...
+require Exporter;
+use vars qw( @ISA @EXPORT_OK );
+ at ISA = qw( Exporter );
+ at EXPORT_OK = qw( Client_SSLify Server_SSLify SSLify_Options SSLify_GetCTX SSLify_GetCipher SSLify_GetSocket );
+
+# Bring in some socket-related stuff
+use Symbol qw( gensym );
+use POSIX qw( F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK );
+
+# We need the server-side stuff
+use Net::SSLeay qw( die_now die_if_ssl_error );
+
+# The server-side CTX stuff
+my $ctx = undef;
+
+# Helper sub to set blocking on a handle
+sub Set_Blocking {
+ my $socket = shift;
+
+ # Net::SSLeay needs blocking for setup.
+ #
+ # ActiveState Perl 5.8.0 dislikes the Win32-specific code to make
+ # a socket blocking, so we use IO::Handle's blocking(1) method.
+ # Perl 5.005_03 doesn't like blocking(), so we only use it in
+ # 5.8.0 and beyond.
+ if ( $] >= 5.008 and $^O eq 'MSWin32' ) {
+ # From IO::Handle POD
+ # If an error occurs blocking will return undef and $! will be set.
+ if ( ! $socket->blocking( 1 ) ) {
+ die "Unable to set blocking mode on socket: $!";
+ }
+ } else {
+ # Make the handle blocking, the POSIX way.
+ if ( $^O ne 'MSWin32' ) {
+ # Get the old flags
+ my $flags = fcntl( $socket, F_GETFL, 0 ) or die "fcntl( $socket, F_GETFL, 0 ) fails: $!";
+
+ # Okay, we patiently wait until the socket turns blocking mode
+ until( fcntl( $socket, F_SETFL, $flags & ~O_NONBLOCK ) ) {
+ # What was the error?
+ if ( ! ( $! == EAGAIN or $! == EWOULDBLOCK ) ) {
+ # Fatal error...
+ die "fcntl( $socket, FSETFL, etc ) fails: $!";
+ }
+ }
+ } else {
+ # Darned MSWin32 way...
+ # Do some ioctl magic here
+ # 126 is FIONBIO ( some docs say 0x7F << 16 )
+ my $flag = "0";
+ ioctl( $socket, 0x80000000 | ( 4 << 16 ) | ( ord( 'f' ) << 8 ) | 126, $flag ) or die "ioctl( $socket, FIONBIO, $flag ) fails: $!";
+ }
+ }
+
+ # All done!
+ return $socket;
+}
+
+# Okay, the main routine here!
+sub Client_SSLify {
+ # Get the socket!
+ my $socket = shift;
+
+ # Validation...
+ if ( ! defined $socket ) {
+ die "Did not get a defined socket";
+ }
+
+ # Set blocking on
+ $socket = Set_Blocking( $socket );
+
+ # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle
+ my $newsock = gensym();
+ tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket ) or die "Unable to tie to our subclass: $!";
+
+ # All done!
+ return $newsock;
+}
+
+# Okay, the main routine here!
+sub Server_SSLify {
+ # Get the socket!
+ my $socket = shift;
+
+ # Validation...
+ if ( ! defined $socket ) {
+ die "Did not get a defined socket";
+ }
+
+ # If we don't have a ctx ready, we can't do anything...
+ if ( ! defined $ctx ) {
+ die 'Please do SSLify_Options() first';
+ }
+
+ # Set blocking on
+ $socket = Set_Blocking( $socket );
+
+ # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle
+ my $newsock = gensym();
+ tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, $ctx ) or die "Unable to tie to our subclass: $!";
+
+ # All done!
+ return $newsock;
+}
+
+# Sets the key + certificate
+sub SSLify_Options {
+ # Get the key + cert
+ my( $key, $cert ) = @_;
+
+ $ctx = Net::SSLeay::CTX_new() or die_now( "CTX_new($ctx): $!" );
+ Net::SSLeay::CTX_set_options( $ctx, &Net::SSLeay::OP_ALL ) and die_if_ssl_error( 'ssl ctx set options' );
+
+ # Following will ask password unless private key is not encrypted
+ Net::SSLeay::CTX_use_RSAPrivateKey_file( $ctx, $key, &Net::SSLeay::FILETYPE_PEM );
+ die_if_ssl_error( 'private key' );
+
+ # Set the cert file
+ Net::SSLeay::CTX_use_certificate_file( $ctx, $cert, &Net::SSLeay::FILETYPE_PEM );
+ die_if_ssl_error( 'certificate' );
+
+ # All done!
+ return 1;
+}
+
+# Returns the server-side CTX in case somebody wants to play with it
+sub SSLify_GetCTX {
+ return $ctx;
+}
+
+# Gives you the cipher type of a SSLified socket
+sub SSLify_GetCipher {
+ my $sock = shift;
+ return Net::SSLeay::get_cipher( tied( *$sock )->_get_self()->{'ssl'} );
+}
+
+# Gives you the "Real" Socket to play with
+sub SSLify_GetSocket {
+ my $sock = shift;
+ return tied( *$sock )->_get_self()->{'socket'};
+}
+
+# End of module
+1;
+
+__END__
+=head1 NAME
+
+POE::Component::SSLify - Makes using SSL in the world of POE easy!
+
+=head1 SYNOPSIS
+
+=head2 Client-side usage
+
+ # Import the module
+ use POE::Component::SSLify qw( Client_SSLify );
+
+ # Create a normal SocketFactory wheel or something
+ my $factory = POE::Wheel::SocketFactory->new( ... );
+
+ # Converts the socket into a SSL socket POE can communicate with
+ eval { $socket = Client_SSLify( $socket ) };
+ if ( $@ ) {
+ # Unable to SSLify it...
+ }
+
+ # Now, hand it off to ReadWrite
+ my $rw = POE::Wheel::ReadWrite->new(
+ Handle => $socket,
+ ...
+ );
+
+ # Use it as you wish...
+
+=head2 Server-side usage
+
+ # !!! Make sure you have a public key + certificate generated via Net::SSLeay's makecert.pl
+
+ # Import the module
+ use POE::Component::SSLify qw( Server_SSLify SSLify_Options SSLify_GetCTX );
+
+ # Set the key + certificate file
+ eval { SSLify_Options( 'public-key.pem', 'public-cert.pem' ) };
+ if ( $@ ) {
+ # Unable to load key or certificate file...
+ }
+
+ # Ah, I want to set some options ( not required )
+ # my $ctx = SSLify_GetCTX();
+ # Net::SSLeay::CTX_set_options( $ctx, foo );
+
+ # Create a normal SocketFactory wheel or something
+ my $factory = POE::Wheel::SocketFactory->new( ... );
+
+ # Converts the socket into a SSL socket POE can communicate with
+ eval { $socket = Server_SSLify( $socket ) };
+ if ( $@ ) {
+ # Unable to SSLify it...
+ }
+
+ # Now, hand it off to ReadWrite
+ my $rw = POE::Wheel::ReadWrite->new(
+ Handle => $socket,
+ ...
+ );
+
+ # Use it as you wish...
+
+=head1 ABSTRACT
+
+ Makes SSL use in POE a breeze!
+
+=head1 DESCRIPTION
+
+This component represents the standard way to do SSL in POE.
+
+=head1 NOTES
+
+=head2 Socket methods doesn't work
+
+The new socket this module gives you actually is some tied socket magic, so you cannot do stuff like
+getpeername() or getsockname(). The only way to do it is to use SSLify_GetSocket and then operate on
+the socket it returns.
+
+=head2 Dying everywhere...
+
+This module will die() if Net::SSLeay could not be loaded or it is not the version we want. So, it is recommended
+that you check for errors and not use SSL, like so:
+
+ eval { use POE::Component::SSLify };
+ if ( $@ ) {
+ $sslavailable = 0;
+ } else {
+ $sslavailable = 1;
+ }
+
+ # Make socket SSL!
+ if ( $sslavailable ) {
+ eval { $socket = POE::Component::SSLify::Client_SSLify( $socket ) };
+ if ( $@ ) {
+ # Unable to SSLify the socket...
+ }
+ }
+
+=head1 FUNCTIONS
+
+=head2 Client_SSLify
+
+ Accepts a socket, returns a brand new socket SSLified
+
+=head2 Server_SSLify
+
+ Accepts a socket, returns a brand new socket SSLified
+
+ NOTE: SSLify_Options must be set first!
+
+=head2 SSLify_Options
+
+ Accepts the location of the SSL key + certificate files and does it's job
+
+=head2 SSLify_GetCTX
+
+ Returns the server-side CTX in case you wanted to play around with it :)
+
+=head2 SSLify_GetCipher
+
+ Returns the cipher used by the SSLified socket
+
+ Example:
+ print "SSL Cipher is: " . SSLify_GetCipher( $sslified_sock ) . "\n";
+
+=head2 SSLify_GetSocket
+
+ Returns the actual socket used by the SSLified socket, useful for stuff like getpeername()/getsockname()
+
+ Example:
+ print "Remote IP is: " . ( unpack_sockaddr_in( getpeername( SSLify_GetSocket( $sslified_sock ) ) ) )[0] . "\n";
+
+=head1 EXPORT
+
+ Stuffs all the 4 functions in @EXPORT_OK so you have to request them directly
+
+=head1 BUGS
+
+On Win32 platforms SSL support is pretty shaky, please help me out with detailed error descriptions if it happens to you!
+
+=head1 SEE ALSO
+
+L<POE>
+
+L<Net::SSLeay>
+
+=head1 AUTHOR
+
+Apocalypse E<lt>apocal at cpan.orgE<gt>
+
+=head1 PROPS
+
+ Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply
+ packaged up the code into something everyone could use and accepted the burden
+ of maintaining it :)
+
+ From the PoCo::Client::HTTP code =]
+ # TODO - This code should probably become a POE::Kernel method,
+ # seeing as it's rather baroque and potentially useful in a number
+ # of places.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Apocalypse/Rocco Caputo
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ClientHandle.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ClientHandle.pm?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ClientHandle.pm (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ClientHandle.pm Tue Oct 23 05:16:19 2007
@@ -1,0 +1,102 @@
+# Declare our package
+package POE::Component::SSLify::ClientHandle;
+
+# Standard stuff to catch errors
+use strict qw(subs vars refs); # Make sure we can't mess up
+use warnings FATAL => 'all'; # Enable warnings to catch errors
+
+# Initialize our version
+# $Revision: 1168 $
+use vars qw( $VERSION );
+$VERSION = '0.02';
+
+# Import the SSL death routines
+use Net::SSLeay qw( die_now die_if_ssl_error );
+
+# We inherit from ServerHandle
+use vars qw( @ISA );
+ at ISA = qw( POE::Component::SSLify::ServerHandle );
+
+# Override TIEHANDLE because we create a CTX
+sub TIEHANDLE {
+ my ( $class, $socket ) = @_;
+
+ my $ctx = Net::SSLeay::CTX_new() or die_now( "Failed to create SSL_CTX $!" );
+ my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" );
+
+ my $fileno = fileno( $socket );
+
+ Net::SSLeay::set_fd( $ssl, $fileno ); # Must use fileno
+
+ my $resp = Net::SSLeay::connect( $ssl ) or die_if_ssl_error( 'ssl connect' );
+
+ $POE::Component::SSLify::ServerHandle::Filenum_Object{ $fileno } = {
+ ssl => $ssl,
+ ctx => $ctx,
+ socket => $socket,
+ };
+
+ return bless \$fileno, $class;
+}
+
+# Override close because it does not do CTX_Free, which is bad bad
+sub CLOSE {
+ my $self = shift;
+ my $info = $self->_get_self();
+
+ # Thanks to Eric Waters -> closes RT #22372
+ if ( $info ) {
+ Net::SSLeay::free( $info->{'ssl'} );
+ Net::SSLeay::CTX_free( $info->{'ctx'} );
+ close $info->{'socket'};
+ }
+ delete $POE::Component::SSLify::ServerHandle::Filenum_Object{ $$self };
+ return 1;
+}
+
+# End of module
+1;
+
+__END__
+=head1 NAME
+
+POE::Component::SSLify::ClientHandle
+
+=head1 ABSTRACT
+
+ See POE::Component::SSLify
+
+=head1 DESCRIPTION
+
+ This is a subclass of Net::SSLeay::Handle because their read() and sysread()
+ does not cooperate well with POE. They block until length bytes are read from the
+ socket, and that is BAD in the world of POE...
+
+ This subclass behaves exactly the same, except that it doesn't block :)
+
+=head1 SEE ALSO
+
+L<POE::Component::SSLify>
+
+=head1 AUTHOR
+
+Apocalypse E<lt>apocal at cpan.orgE<gt>
+
+=head1 PROPS
+
+ Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply
+ packaged up the code into something everyone could use...
+
+ From the PoCo::Client::HTTP code =]
+ # TODO - This code should probably become a POE::Kernel method,
+ # seeing as it's rather baroque and potentially useful in a number
+ # of places.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Apocalypse/Rocco Caputo
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ServerHandle.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ServerHandle.pm?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ServerHandle.pm (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/lib/POE/Component/SSLify/ServerHandle.pm Tue Oct 23 05:16:19 2007
@@ -1,0 +1,209 @@
+# Declare our package
+package POE::Component::SSLify::ServerHandle;
+
+# Standard stuff to catch errors
+use strict qw(subs vars refs); # Make sure we can't mess up
+use warnings FATAL => 'all'; # Enable warnings to catch errors
+
+# Initialize our version
+# $Revision: 1168 $
+use vars qw( $VERSION );
+$VERSION = '0.03';
+
+# Import the SSL death routines
+use Net::SSLeay qw( die_now die_if_ssl_error );
+
+# Argh, we actually copy over some stuff
+our %Filenum_Object; #-- hash of hashes, keyed by fileno()
+
+# Ties the socket
+sub TIEHANDLE {
+ my ( $class, $socket, $ctx ) = @_;
+
+ my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" );
+
+ my $fileno = fileno( $socket );
+
+ Net::SSLeay::set_fd( $ssl, $fileno );
+
+ my $err = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' );
+
+ $Filenum_Object{ $fileno } = {
+ ssl => $ssl,
+ ctx => $ctx,
+ socket => $socket,
+ };
+
+ return bless \$fileno, $class;
+}
+
+# Read something from the socket
+sub READ {
+ # Get ourself!
+ my $self = shift;
+
+ # Get the pointers to buffer, length, and the offset
+ my( $buf, $len, $offset ) = \( @_ );
+
+ # Get the actual ssl handle
+ my $ssl = $Filenum_Object{ $$self }->{'ssl'};
+
+ # If we have no offset, replace the buffer with some input
+ if ( ! defined $$offset ) {
+ $$buf = Net::SSLeay::read( $ssl, $$len );
+
+ # Are we done?
+ if ( defined $$buf ) {
+ return length( $$buf );
+ } else {
+ # Nah, clear the buffer too...
+ $$buf = "";
+ return;
+ }
+ }
+
+ # Now, actually read the data
+ defined( my $read = Net::SSLeay::read( $ssl, $$len ) ) or return undef;
+
+ # Figure out the buffer and offset
+ my $buf_len = length( $$buf );
+
+ # If our offset is bigger, pad the buffer
+ if ( $$offset > $buf_len ) {
+ $$buf .= chr( 0 ) x ( $$offset - $buf_len );
+ }
+
+ # Insert what we just read into the buffer
+ substr( $$buf, $$offset ) = $read;
+
+ # All done!
+ return length( $read );
+}
+
+# Write some stuff to the socket
+sub WRITE {
+ # Get ourself + buffer + length + offset to write
+ my( $self, $buf, $len, $offset ) = @_;
+
+ # If we have nothing to offset, then start from the beginning
+ if ( ! defined $offset ) {
+ $offset = 0;
+ }
+
+ # Okay, get the ssl handle
+ my $ssl = $Filenum_Object{ $$self }->{'ssl'};
+
+ # We count the number of characters written to the socket
+ my $wrote_len = Net::SSLeay::write( $ssl, substr( $buf, $offset, $len ) );
+
+ # Did we get an error or number of bytes written?
+ # Net::SSLeay::write() returns the number of bytes written, or -1 on error.
+ if ( $wrote_len < 0 ) {
+ # The normal syswrite() POE uses expects 0 here.
+ return 0;
+ } else {
+ # All done!
+ return $wrote_len;
+ }
+}
+
+# Sets binmode on the socket
+# Thanks to RT #27117
+sub BINMODE {
+ my $self = shift;
+ if (@_) {
+ my $mode = shift;
+ binmode $Filenum_Object{$$self}->{'socket'}, $mode;
+ } else {
+ binmode $Filenum_Object{$$self}->{'socket'};
+ }
+}
+
+# Closes the socket
+sub CLOSE {
+ my $self = shift;
+ Net::SSLeay::free( $Filenum_Object{ $$self }->{'ssl'} );
+ close $Filenum_Object{ $$self }->{'socket'};
+ delete $Filenum_Object{ $$self };
+ return 1;
+}
+
+# Add DESTROY handler
+sub DESTROY {
+ my $self = shift;
+
+ # Did we already CLOSE?
+ if ( exists $Filenum_Object{ $$self } ) {
+ # Guess not...
+ $self->CLOSE();
+ }
+}
+
+sub FILENO {
+ return ${ $_[0] };
+}
+
+# Not implemented TIE's
+sub READLINE {
+ die 'Not Implemented';
+}
+
+sub PRINT {
+ die 'Not Implemented';
+}
+
+# Returns our hash
+sub _get_self {
+ return $Filenum_Object{ ${ $_[0] } };
+}
+
+# End of module
+1;
+
+__END__
+=head1 NAME
+
+POE::Component::SSLify::ServerHandle
+
+=head1 ABSTRACT
+
+ See POE::Component::SSLify
+
+=head1 DESCRIPTION
+
+ This is a subclass of Net::SSLeay::Handle because their read() and sysread()
+ does not cooperate well with POE. They block until length bytes are read from the
+ socket, and that is BAD in the world of POE...
+
+ This subclass behaves exactly the same, except that it doesn't block :)
+
+=head2 DIFFERENCES
+
+ This subclass doesn't know what to do with PRINT/READLINE, as they usually are not used in POE::Wheel operations...
+
+=head1 SEE ALSO
+
+L<POE::Component::SSLify>
+
+=head1 AUTHOR
+
+Apocalypse E<lt>apocal at cpan.orgE<gt>
+
+=head1 PROPS
+
+ Original code is entirely Rocco Caputo ( Creator of POE ) -> I simply
+ packaged up the code into something everyone could use...
+
+ From the PoCo::Client::HTTP code for blocking sockets =]
+ # TODO - This code should probably become a POE::Kernel method,
+ # seeing as it's rather baroque and potentially useful in a number
+ # of places.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 by Apocalypse/Rocco Caputo
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libpoe-component-sslify-perl/current/t/1_load.t
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/t/1_load.t?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/t/1_load.t (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/t/1_load.t Tue Oct 23 05:16:19 2007
@@ -1,0 +1,4 @@
+use Test::More tests => 1;
+
+# Test the load!
+use_ok('POE::Component::SSLify');
Added: branches/upstream/libpoe-component-sslify-perl/current/t/2_pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libpoe-component-sslify-perl/current/t/2_pod.t?rev=8480&op=file
==============================================================================
--- branches/upstream/libpoe-component-sslify-perl/current/t/2_pod.t (added)
+++ branches/upstream/libpoe-component-sslify-perl/current/t/2_pod.t Tue Oct 23 05:16:19 2007
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list