Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
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...
commit 43b099383f0fadae9c371c944bee30c688eb8878 1 parent 3031ab7
Jonathan Steinert authored
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
3  CHANGES
@@ -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
57 lib/Perlbal/SocketSSL.pm
@@ -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,29 +21,6 @@ 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;
@@ -56,7 +28,7 @@ Perlbal::Socket->set_socket_idle_handler('Perlbal::SocketSSL' => sub {
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;
View
4 lib/Perlbal/TCPListener.pm
@@ -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);
Please sign in to comment.
Something went wrong with that request. Please try again.