r42139 - in /branches/upstream/libio-socket-ssl-perl/current: Changes MANIFEST META.yml SSL.pm t/memleak_bad_handshake.t

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Thu Aug 20 08:35:29 UTC 2009


Author: ansgar-guest
Date: Thu Aug 20 08:35:23 2009
New Revision: 42139

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=42139
Log:
[svn-upgrade] Integrating new upstream version, libio-socket-ssl-perl (1.30)

Added:
    branches/upstream/libio-socket-ssl-perl/current/t/memleak_bad_handshake.t
Modified:
    branches/upstream/libio-socket-ssl-perl/current/Changes
    branches/upstream/libio-socket-ssl-perl/current/MANIFEST
    branches/upstream/libio-socket-ssl-perl/current/META.yml
    branches/upstream/libio-socket-ssl-perl/current/SSL.pm

Modified: branches/upstream/libio-socket-ssl-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-ssl-perl/current/Changes?rev=42139&op=diff
==============================================================================
--- branches/upstream/libio-socket-ssl-perl/current/Changes (original)
+++ branches/upstream/libio-socket-ssl-perl/current/Changes Thu Aug 20 08:35:23 2009
@@ -1,3 +1,11 @@
+
+v1.30 2009.08.19
+- fix test t/memleak_bad_handshake.t
+v1.29 2009.08.19
+- fixed thanks for version 1.28
+v1.28 2009.08.19
+- fix memleak when SSL handshake failed.
+  Thanks richardhundtu[AT]gmail[DOT]com
 
 v1.27 2009.07.24
 - changed possible local/utf-8 depended \w in some regex against more

Modified: branches/upstream/libio-socket-ssl-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-ssl-perl/current/MANIFEST?rev=42139&op=diff
==============================================================================
--- branches/upstream/libio-socket-ssl-perl/current/MANIFEST (original)
+++ branches/upstream/libio-socket-ssl-perl/current/MANIFEST Thu Aug 20 08:35:23 2009
@@ -40,5 +40,6 @@
 t/auto_verify_hostname.t
 t/inet6.t
 t/testlib.pl
+t/memleak_bad_handshake.t
 util/export_certs.pl
 META.yml                                 Module meta-data (added by MakeMaker)

Modified: branches/upstream/libio-socket-ssl-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-ssl-perl/current/META.yml?rev=42139&op=diff
==============================================================================
--- branches/upstream/libio-socket-ssl-perl/current/META.yml (original)
+++ branches/upstream/libio-socket-ssl-perl/current/META.yml Thu Aug 20 08:35:23 2009
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                IO-Socket-SSL
-version:             1.27
+version:             1.30
 abstract:            Nearly transparent SSL encapsulation for IO::Socket::INET.
 license:             ~
 author:              

Modified: branches/upstream/libio-socket-ssl-perl/current/SSL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-ssl-perl/current/SSL.pm?rev=42139&op=diff
==============================================================================
--- branches/upstream/libio-socket-ssl-perl/current/SSL.pm (original)
+++ branches/upstream/libio-socket-ssl-perl/current/SSL.pm Thu Aug 20 08:35:23 2009
@@ -66,7 +66,7 @@
 	}) {
 		@ISA = qw(IO::Socket::INET);
 	}
-	$VERSION = '1.27';
+	$VERSION = '1.30';
 	$GLOBAL_CONTEXT_ARGS = {};
 
 	#Make $DEBUG another name for $Net::SSLeay::trace
@@ -787,8 +787,8 @@
 sub stop_SSL {
 	my $self = shift || return _invalid_object();
 	my $stop_args = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};
-	return $self->error("SSL object already closed") 
-		unless (${*$self}{'_SSL_opened'} == 1);
+	return $self->error("SSL object not open") 
+		if ! ${*$self}{'_SSL_opened'};
 
 	if (my $ssl = ${*$self}{'_SSL_object'}) {
 		my $shutdown_done;
@@ -862,7 +862,7 @@
 sub kill_socket {
 	my $self = shift;
 	shutdown($self, 2);
-	$self->close(SSL_no_shutdown => 1) if (${*$self}{'_SSL_opened'} == 1);
+	$self->close(SSL_no_shutdown => 1) if ${*$self}{'_SSL_opened'};
 	delete(${*$self}{'_SSL_ctx'});
 	return;
 }
@@ -1187,7 +1187,7 @@
 sub DESTROY {
 	my $self = shift || return;
 	$self->close(_SSL_in_DESTROY => 1, SSL_no_shutdown => 1) 
-		if (${*$self}{'_SSL_opened'} == 1);
+		if ${*$self}{'_SSL_opened'};
 	delete(${*$self}{'_SSL_ctx'});
 }
 

Added: branches/upstream/libio-socket-ssl-perl/current/t/memleak_bad_handshake.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libio-socket-ssl-perl/current/t/memleak_bad_handshake.t?rev=42139&op=file
==============================================================================
--- branches/upstream/libio-socket-ssl-perl/current/t/memleak_bad_handshake.t (added)
+++ branches/upstream/libio-socket-ssl-perl/current/t/memleak_bad_handshake.t Thu Aug 20 08:35:23 2009
@@ -1,0 +1,70 @@
+#!perl -w
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/nonblock.t'
+
+
+use Net::SSLeay;
+use Socket;
+use IO::Socket::SSL;
+use IO::Select;
+use Errno qw(EAGAIN EINPROGRESS );
+use strict;
+
+$|=1;
+use vars qw( $SSL_SERVER_ADDR );
+do "t/ssl_settings.req" || do "ssl_settings.req";
+
+if ( ! getsize($$) ) {
+	print "1..0 # Skipped: no usable ps\n";
+	exit;
+}
+
+my $server = IO::Socket::SSL->new(
+	LocalAddr => $SSL_SERVER_ADDR,
+	Listen => 2,
+	ReuseAddr => 1,
+);
+my $addr = $SSL_SERVER_ADDR.':'.$server->sockport;
+
+defined( my $pid = fork()) or do {
+	print "1..0 # Skipped: fork failed\n";
+	exit;
+};
+
+if ( $pid == 0 ) {
+	# server
+	while (1) {
+		# socket accept, client handshake and client close 
+		$server->accept;
+	}
+	exit
+}
+
+close($server);
+# plain non-SSL connect and close w/o sending data
+IO::Socket::INET->new( $addr ) or die $! for(1..100);
+my $size100 = getsize($pid);
+if ( ! $size100 ) {
+	print "1..0 # Skipped: cannot get size of child process\n";
+	exit
+}
+
+IO::Socket::INET->new( $addr ) or die $! for(100..200);
+my $size200 = getsize($pid);
+
+print "1..1\n";
+print "not " if $size100 != $size200;
+print "ok # check memleak failed handshake ($size100,$size200)\n";
+
+kill(9,$pid);
+wait;
+exit;
+
+
+sub getsize {
+	my $pid = shift;
+	open( my $ps,'-|','ps','-o','vsize','-p',$pid ) or return;
+	<$ps>; # header
+	return int(<$ps>); # size
+}
+




More information about the Pkg-perl-cvs-commits mailing list