Memory leak when destroying with incomplete handshake

[olegwtf]

This was originally found in Mojolicious: https://github.com/mojolicious/mojo/issues/1469 But then I tracked this down to IO::Socket::SSL. If we'll destroy object for which server didn't respond with initial handshake this will produce memory leak. I can reproduce this with such server:

use strict;
use IO::Socket;
use POSIX 'WNOHANG';

$SIG{CHLD} = sub { 1 while waitpid(-1, WNOHANG) > 0;  };

my $srv = IO::Socket::INET->new(Listen => 1, LocalPort => 1081) or die $@;

while (1) {
    my $c = $srv->accept or next;

    my $child = fork;

    if ($child == 0) {
        $c->sysread(my $buf, 1024);
        sleep 3;
        exit;
    }
}

and such client:

use strict;
use IO::Socket::SSL;
use IO::Socket::INET;
use IO::Select;
use Time::HiRes 'time';

use constant TIMEOUT => 1;

warn $$;

my $sel_for_read = IO::Select->new;
my $sel_for_write = IO::Select->new;
my %sockets;

for (1..100) {
    make_socket();
}

while (1) {
    my ($readable, $writable) = IO::Select->select($sel_for_read, $sel_for_write, undef, 0.5);
    $readable ||= [];
    $writable ||= [];

    my @want_read;
    my @want_write;

    for my $socket (@$readable, @$writable) {
        remove_socket($socket);

        if ($socket->connect_SSL) {
            # SSL handshake done
            warn 'connected';
            delete $sockets{fileno $socket};
            make_socket();
            next;
        }

        if ($SSL_ERROR == SSL_WANT_READ) {
            push @want_read, $socket;
        }
        elsif ($SSL_ERROR == SSL_WANT_WRITE) {
            push @want_write, $socket;
        }
        else {
            # unexpected error
            warn 'unexpected: ', $SSL_ERROR;
            delete $sockets{fileno $socket};
            make_socket();
        }
    }

    # timeout check
    my $time = time;
    for my $socket ($sel_for_read->handles, $sel_for_write->handles) {
        if ($time - $sockets{fileno $socket} > TIMEOUT) {
            warn 'timeout';
            remove_socket($socket);
            delete $sockets{fileno $socket};
            make_socket();
        }
    }

    # add again for next iteration
    $sel_for_read->add(@want_read);
    $sel_for_write->add(@want_write);
}

sub make_socket {
    my $socket = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 1081, Blocking => 0) or die $@;
    IO::Socket::SSL->start_SSL($socket, SSL_startHandshake => 0) or die $SSL_ERROR;
    $sockets{fileno $socket} = time;
    $sel_for_write->add($socket);
}

sub remove_socket {
    my $socket = shift;

    $sel_for_read->remove($socket);
    $sel_for_write->remove($socket);
}

Memory usage of this client script grows without a stop, however I can see that IO::Socket::SSL::DESTROY called and size of script variables is constant.

[olegwtf]

This may be a fix

@@ -2076,8 +2076,7 @@
     if (my $ssl = ${*$self}{_SSL_object}) {
        delete $SSL_OBJECT{$ssl};
        if (!$use_threads or delete $CREATED_IN_THIS_THREAD{$ssl}) {
-           $self->close(_SSL_in_DESTROY => 1, SSL_no_shutdown => 1)
-               if ${*$self}{'_SSL_opened'};
+           $self->close(_SSL_in_DESTROY => 1, SSL_no_shutdown => 1);
        }
     }
     delete @{*$self}{@all_my_keys};

[noxxi]

Thank you for your bug report and proposed fix. It should be fixed in 8bc7d93 based on your idea.

[olegwtf]

Looks fixed. Thanks. Waiting on cpan.

[noxxi]

The changes are in the just released version 2.067. Thanks again for your help.