Permalink
Browse files

Final, heavily tested fix for SSL sock leak.

Of note, the SSL socket handling has been refactored to use a subclassed IO::Socket::SSL Object, called Perlbal::SocketSSL2 (I hate this name, but I don't have a better idea yet, plus it works.) This means that we are no longer overwriting how IO::Socket::SSL works anymore (better compatability)

Also, the intended behavior has finally been reached; perlbal no longer leaks FDs when an SSL socket goes stale before handshake.
  • Loading branch information...
1 parent 3031ab7 commit 43b099383f0fadae9c371c944bee30c688eb8878 Jonathan Steinert committed Feb 12, 2011
Showing with 33 additions and 31 deletions.
  1. +3 −0 CHANGES
  2. +28 −29 lib/Perlbal/SocketSSL.pm
  3. +2 −2 lib/Perlbal/TCPListener.pm
View
@@ -1,3 +1,6 @@
+ -- Make SSL sockets time out if they go stayle, like we claimed was
+ fixed two versions ago, but this time we also clean up the FDs too.
+
1.78: 2011-01-22
-- Fix corruption of idle socket handlers introduced by SSL fix in 1.77.
View
@@ -3,11 +3,6 @@
# This is a simple class that extends Danga::Socket and contains an IO::Socket::SSL
# for the purpose of allowing non-blocking SSL in Perlbal.
#
-# WARNING: this code will break IO::Socket::SSL if you use it in any plugins or
-# have custom Perlbal modifications that use it. you will run into issues. This
-# is because we override the close method to prevent premature closure of the socket,
-# so you will end up with the socket not closing properly.
-#
# Copyright 2007, Mark Smith <mark@plogs.net>.
#
# This file is licensed under the same terms as Perl itself.
@@ -26,37 +21,14 @@ use Perlbal::Socket;
use base 'Danga::Socket';
use fields qw( listener create_time alive_time);
-# magic IO::Socket::SSL crap to make it play nice with us
-{
- no strict 'refs';
- no warnings 'redefine';
-
- # replace IO::Socket::SSL::close with our own code...
- my $orig = *IO::Socket::SSL::close{CODE};
- *IO::Socket::SSL::close = sub {
- my $self = shift()
- or return IO::Socket::SSL::_invalid_object();
-
- # if we have args, close ourselves (second call!), else don't
- if (exists ${*$self}->{__close_args}) {
- $orig->($self, @{${*$self}->{__close_args}});
- } else {
- ${*$self}->{__close_args} = [ @_ ];
- if (exists ${*$self}->{_danga_socket}) {
- ${*$self}->{_danga_socket}->close('intercepted_ssl_close');
- }
- }
- };
-}
-
Perlbal::Socket->set_socket_idle_handler('Perlbal::SocketSSL' => sub {
my Perlbal::SocketSSL $v = shift;
my $max_age = eval { $v->max_idle_time } || 0;
return unless $max_age;
# Attributes are in another class, don't violate object boundaries.
- $v->close("perlbal_timeout")
+ $v->{sock}->close(SSL_no_shutdown => 1, SSL_ctx_free => 1)
if $v->{alive_time} < $Perlbal::tick_time - $max_age;
});
@@ -158,4 +130,31 @@ sub max_idle_time {
return 60;
}
+package Perlbal::SocketSSL2;
+
+use strict;
+use warnings;
+
+use IO::Socket::SSL;
+
+use base 'IO::Socket::SSL';
+
+sub close {
+ my $self = shift
+ or return IO::Socket::SSL::_invalid_object();
+
+ # If we our Danga::Socket sibling has a sock then we're being called for the first time.
+ # NOTE: this isn't strictly safe, ->close can get called on a sock multiple times. We
+ # really could use a safe way to know if this handle is being called from the post-
+ # event-loop cleanup code in Danga::Socket.
+ if (my $ds = ${*$self}->{_danga_socket}) {
+ ${*$self}->{__close_args} = [ @_ ];
+ delete ${*$self}->{_danga_socket};
+ $ds->close('intercepted_ssl_close')
+ if $ds->sock;
+ } else {
+ return $self->SUPER::close(@{${*$self}->{__close_args}});
+ }
+}
+
1;
@@ -116,7 +116,7 @@ sub event_read {
if ($self->{sslopts}) {
# try to upgrade to SSL, this does no IO it just re-blesses
# and prepares the SSL engine for handling us later
- IO::Socket::SSL->start_SSL(
+ Perlbal::SocketSSL2->start_SSL(
$psock,
SSL_server => 1,
SSL_startHandshake => 0,
@@ -126,7 +126,7 @@ sub event_read {
# safety checking to ensure we got upgraded
return $psock->close
- unless ref $psock eq 'IO::Socket::SSL';
+ unless ref $psock eq 'Perlbal::SocketSSL2';
# class into new package and run with it
my $sslsock = new Perlbal::SocketSSL($psock, $self);

0 comments on commit 43b0993

Please sign in to comment.