fix random SSL failures, spotted by mire
Apocalypse
10 years ago
| 27 | 27 | 'fileno' => $fileno, |
| 28 | 28 | 'status' => $res, |
| 29 | 29 | 'on_connect' => $connref, |
| 30 | 'ssl_started' => 0, | |
| 30 | 31 | }, $class; |
| 31 | 32 | |
| 32 | 33 | return $self; |
| 33 | 34 | } |
| 35 | ||
| 36 | # TODO should we make a convenience function to convert retval to string equivalents for easier debugging? | |
| 37 | # From OpenSSL 1.0.0d | |
| 38 | #define SSL_ERROR_NONE 0 | |
| 39 | #define SSL_ERROR_SSL 1 | |
| 40 | #define SSL_ERROR_WANT_READ 2 | |
| 41 | #define SSL_ERROR_WANT_WRITE 3 | |
| 42 | #define SSL_ERROR_WANT_X509_LOOKUP 4 | |
| 43 | #define SSL_ERROR_SYSCALL 5 /* look at error stack/return value/errno */ | |
| 44 | #define SSL_ERROR_ZERO_RETURN 6 | |
| 45 | #define SSL_ERROR_WANT_CONNECT 7 | |
| 46 | #define SSL_ERROR_WANT_ACCEPT 8 | |
| 34 | 47 | |
| 35 | 48 | sub _check_status { |
| 36 | 49 | my $self = shift; |
| 43 | 56 | $self->{'status'} = Net::SSLeay::accept( $self->{'ssl'} ); |
| 44 | 57 | } |
| 45 | 58 | |
| 46 | # Only process the stuff if we actually have a callback! | |
| 47 | return unless defined $self->{'on_connect'}; | |
| 48 | ||
| 49 | 59 | if ( $self->{'status'} <= 0 ) { |
| 50 | 60 | # http://www.openssl.org/docs/ssl/SSL_get_error.html |
| 51 | 61 | my $errval = Net::SSLeay::get_error( $self->{'ssl'}, $self->{'status'} ); |
| 52 | 62 | |
| 63 | # Handle the case of ERROR_WANT_READ and ERROR_WANT_WRITE | |
| 53 | 64 | # TODO should we skip ERROR_WANT_ACCEPT and ERROR_WANT_CONNECT ? |
| 54 | 65 | # also, ERROR_WANT_ACCEPT isn't exported by Net::SSLeay, huh? |
| 55 | if ( $errval != ERROR_WANT_READ and $errval != ERROR_WANT_WRITE ) { | |
| 66 | if ( $errval == ERROR_WANT_READ or $errval == ERROR_WANT_WRITE ) { | |
| 67 | # continue reading/writing from the socket until we connect or not... | |
| 68 | return 1; | |
| 69 | } else { | |
| 56 | 70 | # call the hook function for error connect |
| 57 | $self->{'on_connect'}->( $self->{'orig_socket'}, 0, $errval ); | |
| 71 | if ( defined $self->{'on_connect'} ) { | |
| 72 | $self->{'on_connect'}->( $self->{'orig_socket'}, 0, $errval ); | |
| 73 | } | |
| 74 | ||
| 75 | # don't try to read/write from the socket anymore! | |
| 76 | return 0; | |
| 58 | 77 | } |
| 59 | 78 | } elsif ( $self->{'status'} == 1 ) { |
| 79 | # SSL handshake is done! | |
| 80 | $self->{'ssl_started'} = 1; | |
| 81 | ||
| 60 | 82 | # call the hook function for successful connect |
| 61 | $self->{'on_connect'}->( $self->{'orig_socket'}, 1 ); | |
| 83 | if ( defined $self->{'on_connect'} ) { | |
| 84 | $self->{'on_connect'}->( $self->{'orig_socket'}, 1 ); | |
| 85 | } | |
| 86 | ||
| 87 | # we can now read/write from the socket! | |
| 88 | return 1; | |
| 62 | 89 | } |
| 63 | 90 | } |
| 64 | 91 | |
| 70 | 97 | # Get the pointers to buffer, length, and the offset |
| 71 | 98 | my( $buf, $len, $offset ) = \( @_ ); |
| 72 | 99 | |
| 73 | # Check connection status | |
| 74 | $self->_check_status if $self->{'status'} <= 0; | |
| 100 | # Check the status of the SSL handshake | |
| 101 | if ( ! $self->{'ssl_started'} ) { | |
| 102 | return if $self->_check_status == 0; | |
| 103 | } | |
| 75 | 104 | |
| 76 | 105 | # If we have no offset, replace the buffer with some input |
| 77 | 106 | if ( ! defined $$offset ) { |
| 79 | 108 | |
| 80 | 109 | # Are we done? |
| 81 | 110 | if ( defined $$buf ) { |
| 111 | # TODO do we need the same "flush is success" logic in WRITE? | |
| 112 | ||
| 82 | 113 | return length( $$buf ); |
| 83 | 114 | } else { |
| 84 | 115 | # Nah, clear the buffer too... |
| 90 | 121 | # Now, actually read the data |
| 91 | 122 | defined( my $read = Net::SSLeay::read( $self->{'ssl'}, $$len ) ) or return; |
| 92 | 123 | |
| 124 | # TODO do we need the same "flush is success" logic in WRITE? | |
| 125 | ||
| 93 | 126 | # Figure out the buffer and offset |
| 94 | 127 | my $buf_len = length( $$buf ); |
| 95 | 128 | |
| 110 | 143 | # Get ourself + buffer + length + offset to write |
| 111 | 144 | my( $self, $buf, $len, $offset ) = @_; |
| 112 | 145 | |
| 113 | # Check connection status | |
| 114 | $self->_check_status if $self->{'status'} <= 0; | |
| 146 | # Check the status of the SSL handshake | |
| 147 | if ( ! $self->{'ssl_started'} ) { | |
| 148 | # The normal syswrite() POE uses expects 0 here. | |
| 149 | return 0 if $self->_check_status == 0; | |
| 150 | } | |
| 115 | 151 | |
| 116 | 152 | # If we have nothing to offset, then start from the beginning |
| 117 | 153 | if ( ! defined $offset ) { |
| 128 | 164 | # The normal syswrite() POE uses expects 0 here. |
| 129 | 165 | return 0; |
| 130 | 166 | } else { |
| 167 | # We flushed some data, which means we finished the handshake! | |
| 168 | # This is IMPORTANT, as mire__@irc found out! | |
| 169 | # Otherwise openssl will zonk out and give us SSL_ERROR_SSL and things randomly break :( | |
| 170 | if ( ! $self->{'ssl_started'} ) { | |
| 171 | $self->{'ssl_started'} = 1; | |
| 172 | $self->{'status'} = 1; | |
| 173 | ||
| 174 | # call the hook function for successful connect | |
| 175 | if ( defined $self->{'on_connect'} ) { | |
| 176 | $self->{'on_connect'}->( $self->{'orig_socket'}, 1 ); | |
| 177 | } | |
| 178 | } | |
| 179 | ||
| 131 | 180 | # All done! |
| 132 | 181 | return $wrote_len; |
| 133 | 182 | } |