Bug #4765 for POE: Patch for POE::Wheel::SSLSocketFactory

Hi, This is a patch i've made to POE::Wheel::SSLSocketFactory, version 0.01_04 to scratch my itch: client certificates, and client certificates verification. It adds: - SSL listening sockets can demand that the peer authenticate itself with a client certificate. This certificate can be validated against a trusted root certificate, and the signature verification depth can be specified. - SSL client connections are also implemented, with the possibility of using client certificates for authentication as well. It works in my tests (perl 5.8.0, RHL 9.0 / 2.4.22), and i've been using it on both sides (client and server) of an SSL connection, with both sides being authenticated. It also adds a few new option parameters... Hope it helps. --- /download/POE-Wheel-SSLSocketFactory-0.01_04/lib/POE/Wheel/SSLSocketFactory.pm 2001-08-06 16:18:07.00000000 0 -0300 +++ /usr/lib/perl5/site_perl/5.8.0/POE/Wheel/SSLSocketFactory.pm 2003-12-20 17:25:47.000000000 -0300 @@ -53,21 +53,33 @@ sub new { my $class = shift; $class = ref( $class ) || $class; - my %args = ( %default_args, @_ ); my $self = bless {}, $class; + ## If we are in client mode, then remove the default values for key and cert, because + ## they become optional: if they are specified, then they're used as client cert... if not, then + ## the session goes on with no client certs. + my %args = ( @_ ); + if (! exists($args{RemotePort})) { + %args = ( %default_args, %args ); + } + ## Copy out our specific args befor passing on to the normal ## SocketFactory's new(). Also copy out the `real' success and ## failure events - $self->{ _key_file } = $args{ RSAPrivateKeyFile }; - $self->{ _cert_file } = $args{ CertificateFile }; + $self->{ _verifydepth } = 1; # Default value + $self->{ _key_file } = $args{ RSAPrivateKeyFile } if exists($args{RSAPrivateKeyFile}); + $self->{ _cert_file } = $args{ CertificateFile } if exists($args{CertificateFile});; $self->{ _success } = $args{ SuccessEvent }; $self->{ _failure } = $args{ FailureEvent }; + $self->{_requestpeer} = $args{RequestPeerCertificates} if exists($args{RequestPeerCertificates}); + $self->{_trustedcerts} = $args{TrustedCertificatesFile} if exists($args{TrustedCertificatesFile}); + $self->{_verifydepth} = $args{SSLVerifyDepth} if exists($args{SSLVerifyDepth}); $self->{ _debug } = $args{ DEBUG }; delete @args{ qw( RSAPrivateKeyFile CertificateFile SuccessEvent FailureEvent DEBUG + RequestPeerCertificates TrustedCertificatesFile SSLVerifyDepth ) }; ## @@ -90,13 +102,6 @@ $self->{_ctx} = Net::SSLeay::CTX_new() or die_now( "CTX new:\n\$!: $!\n\$\@: $@\n" ); - Net::SSLeay::CTX_set_options($self->{_ctx}, &Net::SSLeay::OP_ALL); - die_if_ssl_error("ssl ctx set options"); - - Net::SSLeay::CTX_set_cipher_list($self->{_ctx}, 'ALL' ); - die_if_ssl_error("ssl ctx set cipher list"); - - ## Figure out if we're listening or connecting unless( exists $args{ RemotePort } ) { ## Listening, so we need to setup the key and certificate @@ -110,11 +115,37 @@ Net::SSLeay::FILETYPE_PEM(), ); die_if_ssl_error( "Certificate File" ); - $self->_define_ssl_accept_state(); + if (lc($self->{_requestpeer}) eq "yes") { + die "Could not open trusted certificates file: $self->{_trustedcerts}" if (! -e $self->{_trustedcert s}); + Net::SSLeay::CTX_load_verify_locations( $self->{_ctx}, $self->{_trustedcerts}, 0); + Net::SSLeay::CTX_set_verify_depth( $self->{_ctx}, $self->{_verifydepth} ); + Net::SSLeay::CTX_set_verify ( $self->{_ctx}, &Net::SSLeay::VERIFY_PEER, 0); + } + + $self->_define_ssl_accept_state(); } else { + # Connecting, check out if we have to use client certificates + if (exists($self->{_key_file}) && exists($self->{_cert_file})) { + Net::SSLeay::CTX_use_RSAPrivateKey_file( $self->{_ctx}, + $self->{_key_file}, + Net::SSLeay::FILETYPE_PEM(), ); + die_if_ssl_error( "RSA Private Key File" ); + + Net::SSLeay::CTX_use_certificate_file( $self->{_ctx}, + $self->{_cert_file}, + Net::SSLeay::FILETYPE_PEM(), ); + die_if_ssl_error( "Certificate File" ); + } + $self->_define_ssl_connect_state(); } + Net::SSLeay::CTX_set_options($self->{_ctx}, &Net::SSLeay::OP_ALL); + die_if_ssl_error("ssl ctx set options"); + + Net::SSLeay::CTX_set_cipher_list($self->{_ctx}, 'ALL' ); + die_if_ssl_error("ssl ctx set cipher list"); + return $self; } @@ -198,7 +229,6 @@ $kernel->call( $session, $failure_event, 'accept', ($!+0), $!, $id ) } - $kernel->call( $session, $success_event, $handle, $peer_addr, $port, $id, $s ) } -- Cristiano Lincoln Mattos Tempest Security Technologies - www.tempest.com.br