18 | 18 |
# die_if_ssl_error won't die on non-blocking errors. We don't need to call accept()
|
19 | 19 |
# again, because OpenSSL I/O functions (read, write, ...) can handle that entirely
|
20 | 20 |
# by self (it's needed to accept() once to determine connection type).
|
21 | |
my $err = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' );
|
22 | |
|
|
21 |
my $res = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' );
|
|
22 |
warn "Net::SSLeay::accept(TIEHANDLE) -> $res";
|
23 | 23 |
my $self = bless {
|
24 | 24 |
'ssl' => $ssl,
|
25 | 25 |
'ctx' => $ctx,
|
26 | 26 |
'socket' => $socket,
|
27 | 27 |
'fileno' => $fileno,
|
|
28 |
'status' => $res,
|
28 | 29 |
}, $class;
|
29 | 30 |
|
30 | 31 |
return $self;
|
|
32 |
}
|
|
33 |
|
|
34 |
sub _check_status {
|
|
35 |
my $self = shift;
|
|
36 |
my $method = shift;
|
|
37 |
|
|
38 |
# Okay, is negotiation done?
|
|
39 |
# http://www.openssl.org/docs/ssl/SSL_connect.html#RETURN_VALUES
|
|
40 |
if ( $self->{'status'} == -1 ) {
|
|
41 |
# client or server?
|
|
42 |
my $res;
|
|
43 |
if ( exists $self->{'client'} ) {
|
|
44 |
$res = Net::SSLeay::connect( $self->{'ssl'} );
|
|
45 |
warn "Net::SSLeay::connect($method) -> $res";
|
|
46 |
} else {
|
|
47 |
$res = Net::SSLeay::accept( $self->{'ssl'} );
|
|
48 |
warn "Net::SSLeay::accept($method) -> $res";
|
|
49 |
}
|
|
50 |
|
|
51 |
if ( $res == 0 ) {
|
|
52 |
# TODO error?
|
|
53 |
} elsif ( $res == 1 ) {
|
|
54 |
$self->{'status'} = 1;
|
|
55 |
|
|
56 |
# TODO call the hook function for successful connect
|
|
57 |
warn "CALLING HOOK FUNCTION for " . ( exists $self->{'client'} ? 'CLIENT' : 'SERVER' );
|
|
58 |
}
|
|
59 |
}
|
31 | 60 |
}
|
32 | 61 |
|
33 | 62 |
# Read something from the socket
|
|
37 | 66 |
|
38 | 67 |
# Get the pointers to buffer, length, and the offset
|
39 | 68 |
my( $buf, $len, $offset ) = \( @_ );
|
|
69 |
|
|
70 |
# Check connection status
|
|
71 |
$self->_check_status( 'READ' );
|
40 | 72 |
|
41 | 73 |
# If we have no offset, replace the buffer with some input
|
42 | 74 |
if ( ! defined $$offset ) {
|
|
74 | 106 |
sub WRITE {
|
75 | 107 |
# Get ourself + buffer + length + offset to write
|
76 | 108 |
my( $self, $buf, $len, $offset ) = @_;
|
|
109 |
|
|
110 |
# Check connection status
|
|
111 |
$self->_check_status( 'WRITE' );
|
77 | 112 |
|
78 | 113 |
# If we have nothing to offset, then start from the beginning
|
79 | 114 |
if ( ! defined $offset ) {
|