File Coverage

blib/lib/POE/Component/TLSify/ServerHandle.pm

Criterion	Covered	Total	%
statement	49	52	94.2
branch	20	26	76.9
condition	3	6	50.0
subroutine	11	13	84.6
pod			n/a
total	83	97	85.5

package POE::Component::TLSify::ServerHandle;
$POE::Component::TLSify::ServerHandle::VERSION = '0.04';
#ABSTRACT: Server-side handle for TLSify

use strict;
use warnings;
use POSIX qw[EAGAIN EWOULDBLOCK];
use IO::Socket::SSL qw[$SSL_ERROR SSL_WANT_READ SSL_WANT_WRITE];

sub TIEHANDLE {
  my ($class,$socket,$args,$connref) = @_;
  my $fileno = fileno($socket);
  $socket = IO::Socket::SSL->start_SSL(
    $socket,
    SSL_Server => 1,
    SSL_startHandshake => 0,
    %$args,
  ) or die IO::Socket::SSL->errstr;
  $socket->accept_SSL;
  if( $! != EAGAIN and $! != EWOULDBLOCK ) {
    die IO::Socket::SSL::errstr();
  }
  my $self = bless {
    socket  => $socket,
    started => 0,
    fileno  => $fileno,
    method  => 'accept_SSL',
    on_connect => $connref,
  }, $class;
  return $self;
}

sub _check_status {
  my $self = shift;
  my $method = $self->{method};
  unless ( $self->{socket}->$method ) {
    if ( $! != EAGAIN and $! != EWOULDBLOCK ) {
      if ( defined $self->{on_connect} ) {
        my $errval = IO::Socket::SSL->errstr;
        $self->{'on_connect'}->( $self->{'orig_socket'}, 0, $errval );
      }
      return 0;
    }
  }
  $self->{started} = 1;
  if ( defined $self->{on_connect} ) {
    $self->{'on_connect'}->( $self->{'orig_socket'}, 1 );
  }
  return 1;
}

sub READ {
  my $self = shift;
  if ( ! $self->{started} ) {
    return if $self->_check_status == 0;
  }
  return $self->{socket}->sysread( @_ );
}

sub WRITE {
  my $self = shift;
  if ( ! $self->{started} ) {
    return 0 if $self->_check_status == 0;
  }
  return $self->{socket}->syswrite( @_ );
}

sub CLOSE {
  my $self = shift;
  return 1 if ! defined $self->{socket};
  $self->{socket}->close() if defined $self->{socket}->can('close');
  undef $self->{socket};
  return 1;
}

sub DESTROY {
  my $self = shift;
  if ( defined $self->{socket} ) {
    $self->CLOSE();
  }
  return;
}

sub FILENO {
  return $_[0]->{fileno};
}

sub READLINE {
  die 'Not Implemented';
}

sub PRINT {
  die 'Not Implemented';
}

qq[I TLSify!];

__END__