File Coverage

blib/lib/POE/Component/TLSify/ServerHandle.pm
Criterion Covered Total %
statement 50 53 94.3
branch 20 26 76.9
condition 3 6 50.0
subroutine 11 13 84.6
pod n/a
total 84 98 85.7


line stmt bran cond sub pod time code
1             package POE::Component::TLSify::ServerHandle;
2             $POE::Component::TLSify::ServerHandle::VERSION = '0.08';
3             #ABSTRACT: Server-side handle for TLSify
4              
5 11     11   5212 use strict;
  11         28  
  11         331  
6 11     11   62 use warnings;
  11         25  
  11         375  
7 11     11   65 use POSIX qw[EAGAIN EWOULDBLOCK];
  11         23  
  11         117  
8 11     11   1133 use IO::Socket::SSL qw[$SSL_ERROR SSL_WANT_READ SSL_WANT_WRITE];
  11         33  
  11         75  
9              
10             sub TIEHANDLE {
11 18     18   72 my ($class,$socket,$args,$connref) = @_;
12 18         46 my $fileno = fileno($socket);
13 18 50       183 $socket = IO::Socket::SSL->start_SSL(
14             $socket,
15             SSL_Server => 1,
16             SSL_startHandshake => 0,
17             %$args,
18             ) or die IO::Socket::SSL->errstr;
19 18         33253 $socket->accept_SSL;
20 18 50 33     4198 if( $! != EAGAIN and $! != EWOULDBLOCK ) {
21 0         0 die IO::Socket::SSL::errstr();
22             }
23 18         177 my $self = bless {
24             socket => $socket,
25             started => 0,
26             fileno => $fileno,
27             method => 'accept_SSL',
28             on_connect => $connref,
29             }, $class;
30 18         149 return $self;
31             }
32              
33             sub _check_status {
34 36     36   68 my $self = shift;
35 36         91 my $method = $self->{method};
36 36 100       74 unless ( eval { $self->{socket}->$method } ) {
  36         167  
37 27 100 66     12143 if ( $! != EAGAIN and $! != EWOULDBLOCK ) {
38 2 50       8 if ( defined $self->{on_connect} ) {
39 2         16 my $errval = IO::Socket::SSL->errstr;
40 2         24 $self->{'on_connect'}->( $self->{'orig_socket'}, 0, $errval );
41             }
42 2         2203 return 0;
43             }
44             }
45 34         27237 $self->{started} = 1;
46 34 100       99 if ( defined $self->{on_connect} ) {
47 6         22 $self->{'on_connect'}->( $self->{'orig_socket'}, 1 );
48             }
49 34         1049 return 1;
50             }
51              
52             sub READ {
53 329     329   189031 my $self = shift;
54 329 100       884 if ( ! $self->{started} ) {
55 21 100       67 return if $self->_check_status == 0;
56             }
57 327         1037 return $self->{socket}->sysread( @_ );
58             }
59              
60             sub WRITE {
61 335     335   131006 my $self = shift;
62 335 100       828 if ( ! $self->{started} ) {
63 15 50       49 return 0 if $self->_check_status == 0;
64             }
65 335         1033 return $self->{socket}->syswrite( @_ );
66             }
67              
68             sub CLOSE {
69 36     36   66 my $self = shift;
70 36 50       123 return 1 if ! defined $self->{socket};
71 36 100       355 $self->{socket}->close() if defined $self->{socket}->can('close');
72 36         6352 undef $self->{socket};
73 36         3008 return 1;
74             }
75              
76             sub DESTROY {
77 36     36   2116 my $self = shift;
78 36 50       129 if ( defined $self->{socket} ) {
79 36         132 $self->CLOSE();
80             }
81 36         201 return;
82             }
83              
84             sub FILENO {
85 725     725   85856 return $_[0]->{fileno};
86             }
87              
88             sub READLINE {
89 0     0     die 'Not Implemented';
90             }
91              
92             sub PRINT {
93 0     0     die 'Not Implemented';
94             }
95              
96             qq[I TLSify!];
97              
98             __END__