File Coverage

blib/lib/POE/Filter/SSL.pm

Criterion	Covered	Total	%
statement	48	411	11.6
branch	0	266	0.0
condition	0	109	0.0
subroutine	9	45	20.0
pod	23	23	100.0
total	80	854	9.3

package POE::Filter::SSL;

use strict;
use Net::SSLeay;
use POE qw (Filter::HTTPD Filter::Stackable Wheel::ReadWrite);
use Scalar::Util qw(blessed);
use Carp qw(carp confess);
use POE;

use vars qw($VERSION @ISA);
$VERSION = '0.37';
sub DOSENDBACK () { 1 }

our $globalinfos;

my $PATCH         = 18;
my $HANDSHAKE     = 19;
my $EVENT_FLUSHED = 20;
my $EVENT_INPUT   = 21;

BEGIN {
   eval {
      require Net::SSLeay;
      Net::SSLeay->import( 1.30 );
   };
   Net::SSLeay::load_error_strings();
   Net::SSLeay::SSLeay_add_ssl_algorithms();
   Net::SSLeay::randomize();

   no warnings 'redefine';
   my $old_new = \&POE::Wheel::ReadWrite::new;
   my $old_set_filter = \&POE::Wheel::ReadWrite::set_filter;
   my $old_set_input_filter = \&POE::Wheel::ReadWrite::set_input_filter;
   my $old_set_output_filter = \&POE::Wheel::ReadWrite::set_output_filter;
   my $old_rw_put = \&POE::Wheel::ReadWrite::put;
   *POE::Wheel::ReadWrite::put = sub {
      my $self = shift;
      my $unique_id = $self->[POE::Wheel::ReadWrite::UNIQUE_ID()];
      if (defined($self->[$EVENT_FLUSHED])) {
         $self->[POE::Wheel::ReadWrite::EVENT_FLUSHED] = $self->[$EVENT_FLUSHED];
         $self->[$EVENT_FLUSHED] = undef;
      }
      $old_rw_put->($self, @_);
   };
   *POE::Wheel::ReadWrite::new = sub {
      my $class = shift;
      my %arg = @_;
      my $self = $old_new->($class,%arg);
      my $unique_id = $self->[POE::Wheel::ReadWrite::UNIQUE_ID];
      $self->[$EVENT_INPUT] = $self->[POE::Wheel::ReadWrite::EVENT_INPUT];
      $self->[POE::Wheel::ReadWrite::EVENT_INPUT] = ref($self) . "($unique_id) -> ssl handshake";
      my $flushed_event = \$self->[POE::Wheel::ReadWrite::EVENT_FLUSHED];
      my $temp_flushed_event = \$self->[$EVENT_FLUSHED];
      my $temp_event_input = \$self->[$EVENT_INPUT];
      my $filter_output = \$self->[POE::Wheel::ReadWrite::FILTER_OUTPUT];
      my $driver = \$self->[POE::Wheel::ReadWrite::DRIVER_BOTH];
      my $handle_output = \$self->[POE::Wheel::ReadWrite::HANDLE_OUTPUT];
      $poe_kernel->state(
         $self->[$HANDSHAKE] = ref($self) . "($unique_id) -> ssl handshake",
         sub {
            if (checkForDoSendback($_[ARG0])) {
               unless (defined($$temp_flushed_event)) {
                  $$temp_flushed_event = $$flushed_event;
                  $$flushed_event = undef;
               }
               $$driver->put($$filter_output->put([$_[ARG0]]));
               $poe_kernel->select_resume_write($$handle_output);
            } else {
               $poe_kernel->call($_[SESSION], $$temp_event_input, $_[ARG0], $_[ARG1]);
            }
         }
      );
      $poe_kernel->state(
         $self->[$PATCH] = ref($self) . "($unique_id) -> ssl patch",
         sub {
            my $type = $_[ARG0];
            my $self = $_[ARG1];
            if ($_[HEAP]->{self}->{PreFilter}) {
               $_[HEAP]->{self}->{"PreFilter".ref($self).$self->[POE::Wheel::ReadWrite::UNIQUE_ID()]} = $_[HEAP]->{self}->{PreFilter}->clone()
                  unless ($_[HEAP]->{self}->{"PreFilter".ref($self).$self->[POE::Wheel::ReadWrite::UNIQUE_ID()]});
               if ($type eq "input") {
                  $old_set_input_filter->($self, POE::Filter::Stackable->new(
                     Filters => [
                        $_[HEAP]->{self}->{"PreFilter".ref($self).$self->[POE::Wheel::ReadWrite::UNIQUE_ID()]},
                        $self->get_input_filter()
                     ]
                  ));
               } else {
                  $old_set_output_filter->($self, POE::Filter::Stackable->new(
                     Filters => [
                        $_[HEAP]->{self}->{"PreFilter".ref($self).$self->[POE::Wheel::ReadWrite::UNIQUE_ID()]},
                        $self->get_output_filter()
                     ]
                  ));
               }
            }
         }
      );
      $poe_kernel->yield(ref($self) . "($unique_id) -> ssl patch" => "input" => $self);
      $poe_kernel->yield(ref($self) . "($unique_id) -> ssl patch" => "output" => $self);
      return $self;
   };
   my $old_destroy = \&POE::Wheel::ReadWrite::DESTROY;
   *POE::Wheel::ReadWrite::DESTROY = sub {
      my $self = shift;
      if ($self->[$PATCH]) {
         $poe_kernel->state($self->[$PATCH]);
         $self->[$PATCH] = undef;
      }
      if ($self->[$HANDSHAKE]) {
         $poe_kernel->state($self->[$HANDSHAKE]);
         $self->[$HANDSHAKE] = undef;
      }
      return $old_destroy->($self, @_);
   };
   *POE::Wheel::ReadWrite::set_filter = sub {
      my $self = shift;
      my $new_filter = shift;
      my $unique_id = $self->[POE::Wheel::ReadWrite::UNIQUE_ID()];
      my $ret = $old_set_filter->($self, $new_filter, @_);
      $poe_kernel->yield(ref($self) . "($unique_id) -> ssl patch" => "input" => $self);
      $poe_kernel->yield(ref($self) . "($unique_id) -> ssl patch" => "output" => $self);
      return $ret;
   };
   *POE::Wheel::ReadWrite::set_input_filter = sub {
      my $self = shift;
      my $new_filter = shift;
      my $unique_id = $self->[POE::Wheel::ReadWrite::UNIQUE_ID()];
      my $ret = $old_set_input_filter->($self, $new_filter, @_);
      $poe_kernel->yield(ref($self) . "($unique_id) -> ssl patch" => "input" => $self);
      return $ret;
   };
   *POE::Wheel::ReadWrite::set_output_filter = sub {
      my $self = shift;
      my $new_filter = shift;
      my $unique_id = $self->[POE::Wheel::ReadWrite::UNIQUE_ID()];
      my $ret = $old_set_output_filter->($self, $new_filter, @_);
      $poe_kernel->yield(ref($self) . "($unique_id) -> ssl patch" => "output" => $self);
      return $ret;
   };
   #my $old_get_one  = \&POE::Filter::Stackable::get_one;
   *POE::Filter::Stackable::get_one = sub {
      my ($self) = @_;
      my $return = [ ];
      while (!@$return) {
         my $exchanged = 0;
         foreach my $filter (@{$self->[POE::Filter::Stackable::FILTERS]}) {
            # If we have something to input to the next filter, do that.
            if (@$return) {
               $filter->get_one_start($return);
               $exchanged++;
            }
            # Get what we can from the current filter.
            $return = $filter->get_one();
            # This is the only inserted line:
            return $return if (checkForDoSendback($return) && ($return->[0] eq $filter));
         }
         last unless $exchanged;
      }
      return $return;
   };
   my $old_get_one_start = \&POE::Filter::Stackable::get_one_start;
   *POE::Filter::Stackable::get_one_start = sub {
      my $self = shift;
      (exists($self->[POE::Filter::Stackable::FILTERS]->[0])) ? $old_get_one_start->($self, @_) : []
   };
   my $old_put = \&POE::Filter::Stackable::put;
   *POE::Filter::Stackable::put = sub {
      my $self = shift;
      my $data = shift;
      my $found = 0;
      if (checkForDoSendback($data)) {
         foreach my $filter (@{$self->[POE::Filter::Stackable::FILTERS]}) {
            if ($data->[0] eq $filter) {
               $found++;
               last;
            }
         }
      }
      if ($found) {
         my $ok = 0;
         foreach my $filter (reverse @{$self->[POE::Filter::Stackable::FILTERS]}) {
            next unless ($ok || (($filter eq $data->[0]) && checkForDoSendback($data)));
            $ok++;
            $data = $filter->put($data);
            last unless @$data;
         }
         $data;
      } else {
         $old_put->($self, $data, @_);
      }
   };
   *POE::Filter::HTTPD::get_pending = sub {
      return undef;
   }
}

require XSLoader;
XSLoader::load('POE::Filter::SSL', $VERSION);

sub checkForDoSendback {
   my $chunks = shift;
   $chunks = $chunks->[0] if ((ref($chunks) eq "ARRAY") &&
                          (scalar(@$chunks)));
   return 1 if (blessed($chunks) &&
                       ($chunks->can("DOSENDBACK")) &&
                       ($chunks->DOSENDBACK()));
   return 0;
}

sub PEMdataToX509 {
   my $x509 = shift;
   my $bio = dataToBio($x509);
   my $x509result = undef;
   die "Error using x509: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
      unless ($x509result = Net::SSLeay::PEM_read_bio_X509($bio));
   Net::SSLeay::BIO_free($bio);
   return $x509result;
}

sub PEMdataToEVP_PKEY {
   my $ssl = shift;
   my $crt = shift;
   my $bio = dataToBio($crt);
   my $evp_pkey = undef;
   die "Error using cacrt: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
      unless ($evp_pkey = Net::SSLeay::PEM_read_bio_PrivateKey($bio));
   Net::SSLeay::BIO_free($bio);
   return $evp_pkey;
}

sub CTX_add_client_CA {
   my $ctx = shift;
   my $x509 = shift;
   my $ssl = shift;
   my $err = Net::SSLeay::X509_STORE_add_cert(Net::SSLeay::CTX_get_cert_store($ctx), PEMdataToX509($x509));
   die "Error using cacrt: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
      if ($err && ($err != 1));
   $err = Net::SSLeay::CTX_add_client_CA($ctx, PEMdataToX509($x509));
   die "Error using cacrt: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
      if ($err && ($err != 1));
}

sub dataToBio {
   my $data = shift;
   my $self = $globalinfos->[3] || {};
   my $bio = Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem());
   my $sent = Net::SSLeay::BIO_write($bio, $data);
   print "Wrote ".$sent." of ".length($data)." bytes.\n"
      if $self->{debug};
   die "Cannot write to bio!"
      if (($sent) != length($data));
   return $bio;
}

sub new {
   my $type = shift;

   my $params = {@_};
   my $self = bless({}, $type);

   $globalinfos = [0, 0, [], $self];

   $self->{buffer} = '';
   $self->{debug} = $params->{debug} || 0;
   $self->{cacrl} = $params->{cacrl}
      if $self->{cacrl};
   $self->{client} = $params->{client} || 0;
   $self->{errorhandler} = $params->{errorhandler};
   $self->{params} = $params;

   $self->{context} =
      ($params->{tls} || $params->{tls1_2}) ?
                        ($params->{tls1_2}  ?
         Net::SSLeay::CTX_tlsv1_2_new() :
         Net::SSLeay::CTX_tlsv1_new()) :
         Net::SSLeay::CTX_new();

   Net::SSLeay::CTX_set_options($self->{context}, 0x00400000) # SSL_OP_CIPHER_SERVER_PREFERENCE # Beim Apache: SSLHonorCipherOrder
      if ((!$self->{client}) && (!$params->{"nohonor"}));

   my $err = undef;
   if ($params->{chain}) {
      $err = Net::SSLeay::CTX_use_certificate_chain_file($self->{context}, $params->{chain});
      die "Error using chain: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
         if ($err && ($err != 1));
   } else {
      if ($params->{keymem} || $params->{key}) {
         if ($params->{keymem}) {
            $err = Net::SSLeay::CTX_use_PrivateKey($self->{context}, PEMdataToEVP_PKEY($self->{ssl}, $params->{keymem}));
            print "Loaded keymem(".length($params->{keymem})." Bytes) with result ".$err."\n"
               if $self->{debug};
         } else {
            $err = Net::SSLeay::CTX_use_PrivateKey_file($self->{context}, $params->{key}, &Net::SSLeay::FILETYPE_PEM);
            print "Loaded key from file ".$params->{key}." with result ".$err."\n"
               if $self->{debug};
         }
         die "Error using keymem: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
            if ($err && ($err != 1));
      }
      if ($params->{crtmem} || $params->{crt}) {
         if ($params->{crtmem}) {
            my $crt = PEMdataToX509($params->{crtmem});
            $err = Net::SSLeay::CTX_use_certificate($self->{context}, $crt);
            print "Loaded crtmem(".length($params->{crtmem})." Bytes/".$crt.") with result ".$err."\n"
               if $self->{debug};
         } else {
            # TODO:XXX:FIXME: Errorchecking!
            $err = Net::SSLeay::CTX_use_certificate_file($self->{context}, $params->{crt}, &Net::SSLeay::FILETYPE_PEM);
            print "Loaded crt from file ".$params->{crt}." with result ".$err."\n"
               if $self->{debug};
         }
         die "Error using crtmem: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
            if ($err && ($err != 1));
      }
   }

   $err = undef;
   if ($params->{cacrt}||
       $params->{cacrtmem}) {
      if ($params->{cacrtmem}) {
         if (ref($params->{cacrtmem}) eq "ARRAY") {
            foreach my $curcert (@{$params->{cacrtmem}}) {
               $err = CTX_add_client_CA($self->{context}, $curcert, $self->{ssl});
               last
                  unless $err;
            }
         } else {
            $err = CTX_add_client_CA($self->{context}, $params->{cacrtmem}, $self->{ssl});
            print "Loaded cacrtmem(".length($params->{cacrtmem})." Bytes) with result ".$err."\n"
               if $self->{debug};
         }
      } else {
         $err = Net::SSLeay::CTX_load_verify_locations($self->{context}, $params->{cacrt}, '');
         print "Loaded cacrt from file ".$params->{cacrt}." with result ".$err."\n"
            if $self->{debug};
         $err = Net::SSLeay::CTX_set_client_CA_list($self->{context}, Net::SSLeay::load_client_CA_file($params->{cacrt}))
            unless ($err && ($err == 1));
         print "Set client cacrt from file ".$params->{cacrt}." with result ".$err."\n"
            if $self->{debug};
      }
      $err = Net::SSLeay::CTX_set_verify_depth($self->{context}, $params->{caverifydepth} || 5)
         unless ($err && ($err == 1));
   }
   die "Error using cacrt: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
      if ($err && ($err != 1));

   $err = undef;
   $err = Net::SSLeay::CTX_set_cipher_list($self->{context}, $params->{cipher})
      if ($params->{cipher});
   die "Error setting cipher: ".Net::SSLeay::ERR_error_string(ERR_get_error())
      if ($err && ($err != 1));

   $err = undef;
   $self->{rbio} = Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem())
      or die("Error creating r BIO: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()));
   $self->{wbio} = Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem())
      or die("Error creating w BIO: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()));
   $self->{ssl} = Net::SSLeay::new($self->{context});
   $err = Net::SSLeay::set_bio($self->{ssl}, $self->{rbio}, $self->{wbio});
   die "Error setting r/w BIOs: ".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
      if ($err && ($err != 1));

   if ($params->{dhcert} ||
       $params->{dhcertmem}) {
      my $dhbio = undef;
      if ($params->{dhcertmem}) {
         $dhbio = dataToBio($params->{dhcertmem});
      } else {
         die "Cannot open dhcert file!"
            unless ((-s $params->{dhcert}) && ($dhbio = Net::SSLeay::BIO_new_file($params->{dhcert}, "r")));
      }
      # TODO:XXX:FIXME: Errorchecking!
      my $dhret = Net::SSLeay::PEM_read_bio_DHparams($dhbio);
      print "Loaded dhcert with result ".$err."\n"
         if $self->{debug};
      Net::SSLeay::BIO_free($dhbio);
      die "Couldn't set DH parameters!"
         if (SSL_set_tmp_dh($self->{ssl}, $dhret) < 0);
      print "Set dhcert params with result ".$err."\n"
         if $self->{debug};
      #die "Couldn't set CTX DH parameters!"
      #   if (SSL_CTX_set_tmp_dh($self->{context}, $dhret) < 0);
      # TODO:XXX:FIXME: Errorchecking!
      my $rsa = Net::SSLeay::RSA_generate_key(2048, 73);
      #die "Couldn't set RSA key!"
      #   if (!Net::SSLeay::set_tmp_rsa($self->{ssl}, $rsa));
      die "Couldn't set RSA key!"
         if (!SSL_CTX_set_tmp_rsa($self->{context}, $rsa));
      print "Set dhrsa with result ".$err."\n"
         if $self->{debug};
      Net::SSLeay::RSA_free($rsa);
   }
   my $orfilter = &Net::SSLeay::VERIFY_PEER;
   $orfilter |=   &Net::SSLeay::VERIFY_CLIENT_ONCE
      if $params->{clientcert};
   $orfilter |=   &Net::SSLeay::VERIFY_FAIL_IF_NO_PEER_CERT
      if $params->{blockbadclientcert};
   # TODO:XXX:FIXME: Errorchecking!
   #Net::SSLeay::CTX_set_verify($self->{context}, $orfilter, \&VERIFY);
   Net::SSLeay::set_verify($self->{ssl}, $orfilter, \&VERIFY);
   print "Set verify ".($params->{blockbadclientcert} ? "FORCE" : "")." ".$orfilter."\n"
      if $self->{debug};
   if ($params->{sni}) {
      my $err = Net::SSLeay::set_tlsext_host_name($self->{ssl}, $params->{sni});
      print "Set sni with result ".$err."\n"
         if $self->{debug};
      die "Error setting sni:".Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
         if ($err && ($err != 1));
   }
   $self->{ignoreVerifyErrors} = $params->{ignoreVerifyErrors}
      if ($params->{ignoreVerifyErrors} &&
     (ref($params->{ignoreVerifyErrors}) eq "ARRAY"));

   $self
}

sub VERIFY {
   my ($ok, $x509_store_ctx) = @_;
   my $self = $globalinfos->[3] || {};
   print "VERIFY ".$ok
      if $self->{debug};
   my $errcode = Net::SSLeay::X509_STORE_CTX_get_error($x509_store_ctx);
   if ($self->{ignoreVerifyErrors} &&
  (ref($self->{ignoreVerifyErrors}) eq "ARRAY") && (scalar(grep { $errcode == $_ }
     @{$self->{ignoreVerifyErrors}}))) {
      $ok = 1;
      print " -> ".$ok." (Ignoring error ".$errcode.")"
         if $self->{debug};
   }
   print "\n"
      if $self->{debug};
   $globalinfos->[0] = $ok ? 1 : 2
      if ($globalinfos->[0] != 2);
   $globalinfos->[1]++;
   # TODO:XXX:FIXME: Chainlength check
   #X509_STORE_CTX_set_error($x509_store_ctx, X509_V_ERR_CERT_CHAIN_TOO_LONG)
   #   if (X509_STORE_CTX_get_error_depth(ctx) > uuu);
   # TODO:XXX:FIXME: No globalconfig
   #    ssl = X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
   #    mydata = SSL_get_ex_data(ssl, mydata_index);
   if (my $x = Net::SSLeay::X509_STORE_CTX_get_current_cert($x509_store_ctx)) {
      push(@{$globalinfos->[2]},[Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($x)),
                                 Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_issuer_name($x)),
                                 X509_get_serialNumber($x),
                                 $errcode]);
   }
   Net::SSLeay::X509_STORE_CTX_set_error($x509_store_ctx, 0);
   return 1; # $ok; # 1=accept cert, 0=reject
}

sub clone {
   my $self = shift;
   return POE::Filter::SSL->new(%{$self->{params}});
}

sub get_one_start {
   my ($self, $data) = @_;
   print "GETONESTART: NETWORK -> SSL -> POE: ".$self->hexdump(join("", @$data))."\n"
      if $self->{debug};
   $self->writeToSSLBIO(join("", @$data), $self->{accepted} ? 0 : 1);
   []
}

sub get_one {
   my $self = shift;
   print "GETONE: BEGIN\n"
      if $self->{debug};
   my @return = ();
   push(@return, $self) if ($self->doSSL() || $self->{buffer});
   my $data = Net::SSLeay::read($self->{ssl});
   push(@return, $data)
      if $data;
   print "GETONE: END: ".scalar(@return)."\n"
      if $self->{debug};
   [@return]
}

sub get {
   my ($self, $chunks) = @_;
   print "GET: BEGIN\n"
      if $self->{debug};
   my @return = ();
   #print "GET:\n"
   #   if $self->{debug};
   push(@return, $self) if ($self->doSSL() || $self->{buffer});
   foreach my $data (@$chunks) {
      print "GET: NETWORK -> SSL -> POE: ".join("", @$data)."\n"
         if $self->{debug};
      $self->writeToSSLBIO(join("", @$data));
      my $data = Net::SSLeay::read($self->{ssl});
      print "GET: Read ".length($data)." bytes.\n"
         if $self->{debug};
      push(@return, $data);
   }
   [@return]
}

sub put {
   my ($self, $chunks) = @_;
   print "PUT: BEGIN\n"
      if $self->{debug};
   my @return = ();
   $self->doSSL();
   if ($self->{accepted}) {
      if (defined($self->{sendbuf})) {
         foreach my $cdata (@{$self->{sendbuf}}) {
            $self->writeToSSL($cdata);
         }
         delete($self->{sendbuf});
      }
   }
   foreach my $data (@$chunks) {
      next if (ref($data) eq "POE::Filter::SSL");
      print "PUT: POE -> SSL -> NETWORK: ".$self->hexdump($data)."\r\n"
         if $self->{debug};
      if ($self->{accepted}) {
         $self->writeToSSL($data);
      } else {
         push(@{$self->{sendbuf}}, $data)
            if ($data);
      }
   }
   push(@return, $self->{buffer})
      if $self->{buffer};
   $self->{buffer} = '';
   [@return]
}

sub writeToSSL {
   my $self = shift;
   my $data = shift;
   if ((my $sent = Net::SSLeay::write($self->{ssl}, $data)) != length($data)) {
      my $err2 = Net::SSLeay::get_error($self->{ssl}, $sent);
      #die("PUT: Not all data given to SSL(".$err2."): ".$sent." != ".length($data)) if ($sent);
   }
   $self->doSSL();
}

sub writeToSSLBIO {
   my $self = shift;
   my $data = shift;
   my $nodoSSL = shift;
   if ((my $sent = Net::SSLeay::BIO_write($self->{rbio}, $data)) != length($data)) {
      my $err2 = Net::SSLeay::get_error($self->{ssl}, $sent);
      #die("GET: Not all data given to BIO SSL(".$err2."): ".$sent." != ".length($data)) if ($sent);
   }
   $self->doSSL() unless $nodoSSL;
}

sub get_pending {
  return undef;
}

sub doSSL {
   my $self = shift;
   my $ret = 0;
   print "SSLing..."
      if $self->{debug};
   unless ($self->{accepted}) {
      my $err = $self->{client} ?
         Net::SSLeay::connect($self->{ssl}) :
         Net::SSLeay::accept($self->{ssl});
      if ($err == 1) {
         $self->{infos} = [((@$globalinfos)[0..2])];
         $globalinfos = [0, 0, []];
         $self->{accepted}++;
         $ret++;
      } else {
         my $errtext = $!;
         my $err2 = Net::SSLeay::get_error($self->{ssl}, $err);
         unless ($err2 == Net::SSLeay::ERROR_WANT_READ()) {
            my $tmp = "POE::Filter::SSL: ".($self->{client} ? "connect" : "accept").": ";
            my $err3 = undef;
            if ($err3 = Net::SSLeay::ERR_get_error()) {
               $tmp .= Net::SSLeay::ERR_error_string($err3)."(".$err3.", ".$err2.")";
            } else {
               $tmp .= "No error (return=".$err2.")";
            }
            if (defined($self->{errorhandler})) {
               if (ref($self->{errorhandler}) eq "CODE") {
                  $self->{errorhandler}($self, {
                     ssl       => $self->{ssl},
                     msg       => $tmp,
                     ret       => $err,
                     get_error => $err2,
                     error     => $err3,
                  });
               } elsif(lc($self->{errorhandler}) eq "ignore") {
               } elsif(lc($self->{errorhandler}) eq "carp") {
                  carp($tmp);
               } elsif(lc($self->{errorhandler}) eq "confess") {
                  confess($tmp);
               } elsif(lc($self->{errorhandler}) eq "carponetime") {
                  carp($tmp)
                     unless $self->{errorstat}->{$err||"-"}->{$err2||"-"}->{$err3||"-"}++;
               }
            } else {
               carp($tmp);
            }
            $ret++
               unless $self->{accepted}++;
         }
      }
   }
   while (my $data = Net::SSLeay::BIO_read($self->{wbio})) {
      $self->{buffer} .= $data;
   }
   print $ret."\n"
      if $self->{debug};
   return $ret;
}

sub getCipher {
   my $self = shift;
   return Net::SSLeay::get_cipher($self->{ssl});
}

sub clientCertExists {
   my $self = shift;
   return ((ref($self->{infos}) eq "ARRAY") && ($self->{infos}->[1]));
}

sub clientCertValid {
   my $self = shift;
   my $valid = 1;
   if (defined($self->{cacrl})) {
      $valid = $self->clientCertNotOnCRL($self->{cacrl}) ? 1 : 0;
   }
   return $self->clientCertExists() ? (($self->{infos}->[0] ne "2") && scalar(@{$self->{infos}->[2]}) && $valid) : undef;
}

sub clientCertIds {
   my $self = shift;
   return $self->clientCertExists ? @{$self->{infos}->[2]} : undef;
}

sub clientCertNotOnCRL {
   my $self = shift;
   my $crlfilename = shift;
   my @certids = $self->clientCertIds();
   if (scalar(@certids)) {
      my $found = 0;
      my $badcrls = 0;
      my $jump = 0;
      print("----- SSL Infos BEGIN ---------------"."\n")
         if $self->{debug};
      foreach (@{$self->{infos}->[2]}) {
         my $crlstatus = verify_serial_against_crl_file($crlfilename, $_->[2]);
         $badcrls++ if $crlstatus;
         $crlstatus = $crlstatus ? "INVALID (".($crlstatus !~ m,^CRL:, ? $self->hexdump($crlstatus) : $crlstatus).")" : "VALID";
         my $t = ("  " x $jump++);
         if (ref($_) eq "ARRAY") {
            if ($self->{debug}){
               print(" ".$t."  |---[ Subcertificate ]---\n") if $t;
               print(" ".$t."  | Subject Name: ".$_->[0]."\n");
               print(" ".$t."  | Issuer Name : ".$_->[1]."\n");
               print(" ".$t."  | Serial      : ".$self->hexdump($_->[2])."\n");
               print(" ".$t."  | CRL Status  : ".$crlstatus."\n");
            }
         } else {
            print(" NOCERTINFOS!"."\n") if $self->{debug};
            return 0;
         }
      }
      print("----- SSL Infos END -----------------"."\n") if $self->{debug};
      return 1 unless $badcrls;
   }
   return 0;
}

sub handshakeDone {
   my $self = shift;
   my $params = {@_};
   return ($self->{accepted} && (($params->{ignorebuf}) || ((!$self->{sendbuf}) && (!$self->{buffer})))) || 0;
}

sub DESTROY {
   my $self = shift;
   Net::SSLeay::free($self->{ssl})
      if $self->{ssl};
   Net::SSLeay::CTX_free($self->{context})
      if $self->{context};
   #Net::SSLeay::BIO_free($self->{bio}) # CTX_free automatically frees BIO!!!
   #   if $self->{bio};
}

sub hexdump { my $self = shift; join ':', map { sprintf "%02X", $_ } unpack "C*", $_[0]; }

1;

__END__