r74301 - in /trunk/libio-socket-ssl-perl: Changes META.yml SSL.pm debian/changelog t/inet6.t t/nonblock.t
carnil at users.alioth.debian.org
carnil at users.alioth.debian.org
Thu May 12 21:40:54 UTC 2011
Author: carnil
Date: Thu May 12 21:40:37 2011
New Revision: 74301
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=74301
Log:
New upstream release
Modified:
trunk/libio-socket-ssl-perl/Changes
trunk/libio-socket-ssl-perl/META.yml
trunk/libio-socket-ssl-perl/SSL.pm
trunk/libio-socket-ssl-perl/debian/changelog
trunk/libio-socket-ssl-perl/t/inet6.t
trunk/libio-socket-ssl-perl/t/nonblock.t
Modified: trunk/libio-socket-ssl-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libio-socket-ssl-perl/Changes?rev=74301&op=diff
==============================================================================
--- trunk/libio-socket-ssl-perl/Changes (original)
+++ trunk/libio-socket-ssl-perl/Changes Thu May 12 21:40:37 2011
@@ -1,4 +1,18 @@
+v1.43 2011.05.11
+- fix t/nonblock.t
+- stability improvements t/inet6.t
+v1.42 2011.05.10
+- add SSL_create_ctx_callback to have a way to adjust context on
+ creation. https://rt.cpan.org/Ticket/Display.html?id=67799
+- describe problem of fake memory leak because of big session cache
+ and how to fix it, see https://rt.cpan.org/Ticket/Display.html?id=68073
+v1.41 2011.05.09
+- fix issue in stop_SSL where it did not issue a shutdown of the
+ SSL connection if it first received the shutdown from the other
+ side. Thanks to fencingleo[AT]gmail[DOT]com for reporting
+- try to make t/nonblock.t more reliable, at least report the real
+ cause of ssl connection errors
v1.40 2011.05.02
- integrated patch from GAAS to get IDN support from URI.
https://rt.cpan.org/Ticket/Display.html?id=67676
Modified: trunk/libio-socket-ssl-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libio-socket-ssl-perl/META.yml?rev=74301&op=diff
==============================================================================
--- trunk/libio-socket-ssl-perl/META.yml (original)
+++ trunk/libio-socket-ssl-perl/META.yml Thu May 12 21:40:37 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: IO-Socket-SSL
-version: 1.40
+version: 1.43
abstract: Nearly transparent SSL encapsulation for IO::Socket::INET.
author:
- Steffen Ullrich & Peter Behroozi & Marko Asplund
@@ -17,7 +17,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.55_02
+generated_by: ExtUtils::MakeMaker version 6.54
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libio-socket-ssl-perl/SSL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libio-socket-ssl-perl/SSL.pm?rev=74301&op=diff
==============================================================================
--- trunk/libio-socket-ssl-perl/SSL.pm (original)
+++ trunk/libio-socket-ssl-perl/SSL.pm Thu May 12 21:40:37 2011
@@ -78,7 +78,7 @@
}) {
@ISA = qw(IO::Socket::INET);
}
- $VERSION = '1.40';
+ $VERSION = '1.43';
$GLOBAL_CONTEXT_ARGS = {};
#Make $DEBUG another name for $Net::SSLeay::trace
@@ -821,13 +821,14 @@
} else {
my $fast = $stop_args->{SSL_fast_shutdown};
my $status = Net::SSLeay::get_shutdown($ssl);
- if ( $status == SSL_RECEIVED_SHUTDOWN
- || ( $status != 0 && $fast )) {
- # shutdown done
+ if ( $fast && $status != 0) {
+ # shutdown done, either status has
+ # SSL_SENT_SHUTDOWN or SSL_RECEIVED_SHUTDOWN or both,
+ # so the handshake is at least in process
$shutdown_done = 1;
- } else {
+ } elsif ( ( $status & SSL_SENT_SHUTDOWN ) == 0 ) {
# need to initiate/continue shutdown
- local $SIG{PIPE} = sub{};
+ local $SIG{PIPE} = 'IGNORE';
for my $try (1,2 ) {
my $rv = Net::SSLeay::shutdown($ssl);
if ( $rv < 0 ) {
@@ -841,10 +842,15 @@
$shutdown_done = 1;
last;
} else {
- # shutdown partly finished (e.g. one direction)
+ # shutdown partly initiated (e.g. one direction)
# call again
}
}
+ } elsif ( $status & SSL_RECEIVED_SHUTDOWN ) {
+ # SSL_SENT_SHUTDOWN is done already (previous if-case)
+ # and because SSL_RECEIVED_SHUTDOWN is done also we
+ # consider the shutdown done
+ $shutdown_done = 1;
}
}
@@ -897,6 +903,13 @@
my $ssl = ${*$self}{'_SSL_object'};
return IO::Socket::SSL->error("Undefined SSL object") unless($ssl);
return $ssl;
+}
+
+# _get_ctx_object is for internal use ONLY!
+sub _get_ctx_object {
+ my $self = shift;
+ my $ctx_object = ${*$self}{_SSL_ctx};
+ return $ctx_object && $ctx_object->{context};
}
# default error for undefined arguments
@@ -1459,6 +1472,10 @@
Net::SSLeay::CTX_set_verify($ctx, $verify_mode, $verify_callback);
+ if ( my $cb = $arg_hash->{SSL_create_ctx_callback} ) {
+ $cb->($ctx);
+ }
+
$ctx_object = { context => $ctx };
$ctx_object->{has_verifycb} = 1 if $verify_callback;
DEBUG(3, "new ctx $ctx" );
@@ -1472,6 +1489,7 @@
if $Net::SSLeay::VERSION < 1.26;
$ctx_object->{session_cache} = IO::Socket::SSL::Session_Cache->new( $size );
}
+
return bless $ctx_object, $class;
}
@@ -1808,6 +1826,20 @@
Note that, contrary to versions of IO::Socket::SSL below v0.90, a global SSL context
will not be implicitly used unless you use the set_default_context() function.
+=item SSL_create_ctx_callback
+
+With this callback you can make individual settings to the context after it
+got created and the default setup was done.
+The callback will be called with the CTX object from Net::SSLeay as the single
+argument.
+
+Example for limiting the server session cache size:
+
+ SSL_create_ctx_callback => sub {
+ my $ctx = shift;
+ Net::SSLeay::CTX_sess_set_cache_size($ctx,128);
+ }
+
=item SSL_session_cache_size
If you make repeated connections to the same host/port and the SSL renegotiation time
@@ -2187,6 +2219,10 @@
Non-blocking and timeouts (which are based on non-blocking) are not
supported on Win32, because the underlying IO::Socket::INET does not support
non-blocking on this platform.
+
+If you have a server and it looks like you have a memory leak you might
+check the size of your session cache. Default for Net::SSLeay seems to be
+20480, see the example for SSL_create_ctx_callback for how to limit it.
=head1 LIMITATIONS
Modified: trunk/libio-socket-ssl-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libio-socket-ssl-perl/debian/changelog?rev=74301&op=diff
==============================================================================
--- trunk/libio-socket-ssl-perl/debian/changelog (original)
+++ trunk/libio-socket-ssl-perl/debian/changelog Thu May 12 21:40:37 2011
@@ -1,3 +1,9 @@
+libio-socket-ssl-perl (1.43-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Salvatore Bonaccorso <carnil at debian.org> Thu, 12 May 2011 23:38:54 +0200
+
libio-socket-ssl-perl (1.40-1) unstable; urgency=low
* New upstream release
Modified: trunk/libio-socket-ssl-perl/t/inet6.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libio-socket-ssl-perl/t/inet6.t?rev=74301&op=diff
==============================================================================
--- trunk/libio-socket-ssl-perl/t/inet6.t (original)
+++ trunk/libio-socket-ssl-perl/t/inet6.t Thu May 12 21:40:37 2011
@@ -43,7 +43,6 @@
my $server = IO::Socket::SSL->new(
LocalAddr => $addr,
Listen => 2,
- ReuseAddr => 1,
SSL_cert_file => "certs/server-cert.pem",
SSL_key_file => "certs/server-key.pem",
) || do {
@@ -53,7 +52,8 @@
ok("Server Initialization at $addr");
# add server port to addr
-$addr.= ':'.$server->sockport;
+$addr = "[$addr]:".$server->sockport;
+print "# server at $addr\n";
my $pid = fork();
if ( !defined $pid ) {
Modified: trunk/libio-socket-ssl-perl/t/nonblock.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libio-socket-ssl-perl/t/nonblock.t?rev=74301&op=diff
==============================================================================
--- trunk/libio-socket-ssl-perl/t/nonblock.t (original)
+++ trunk/libio-socket-ssl-perl/t/nonblock.t Thu May 12 21:40:37 2011
@@ -36,13 +36,10 @@
# create Server socket before forking client, so that it is
# guaranteed to be listening
#################################################################
-my %extra_options = $Net::SSLeay::VERSION>=1.16 ?
- (
- SSL_key_file => "certs/client-key.enc",
- SSL_passwd_cb => sub { return "opossum" }
- ) : (
- SSL_key_file => "certs/client-key.pem"
- );
+my %tls_options = (
+ SSL_version => 'TLSv1',
+ SSL_cipher_list => 'HIGH',
+);
# first create simple non-blocking tcp-server
@@ -124,9 +121,8 @@
# upgrade to SSL socket w/o connection yet
if ( ! IO::Socket::SSL->start_SSL( $to_server,
SSL_startHandshake => 0,
- SSL_version => 'TLSv1',
- SSL_cipher_list => 'HIGH',
- %extra_options
+ %extra_options,
+ %tls_options,
)) {
diag( 'start_SSL return undef' );
print "not ";
@@ -149,7 +145,7 @@
} elsif ( $SSL_ERROR == SSL_WANT_WRITE ) {
IO::Select->new($to_server)->can_write(30) && next; # retry if can write
}
- diag( "failed to connect: ".$to_server->errstr );
+ diag( "failed to connect: $@" );
print "not ";
last;
}
@@ -183,29 +179,36 @@
$test_might_fail = 1;
}
+ my $can;
WRITE:
for( my $i=0;$i<50000;$i++ ) {
my $offset = 0;
while (1) {
+ if ( $can && ! IO::Select->new($to_server)->$can(30)) {
+ diag("fail $can");
+ print "not ";
+ last WRITE;
+ };
my $n = syswrite( $to_server,$msg,length($msg)-$offset,$offset );
if ( !defined($n) ) {
diag( "\$!=$! \$SSL_ERROR=$SSL_ERROR send=$bytes_send" );
if ( $! == EAGAIN ) {
if ( $SSL_ERROR == SSL_WANT_WRITE ) {
diag( 'wait for write' );
+ $can = 'can_write';
$attempts++;
- IO::Select->new($to_server)->can_write(30);
- diag( "can write again" );
} elsif ( $SSL_ERROR == SSL_WANT_READ ) {
diag( 'wait for read' );
- IO::Select->new($to_server)->can_read(30);
+ $can = 'can_read';
+ } else {
+ $can = 'can_write';
}
} elsif ( ( $! == EPIPE || $! == ECONNRESET ) && $bytes_send > 30000 ) {
diag( "connection closed hard" );
last WRITE;
} else {
print "not ";
- last WRITE;
+ last WRITE;
}
next;
} elsif ( $n == 0 ) {
@@ -228,13 +231,10 @@
}
ok( "syswrite" );
- if ( ! $attempts ) {
- if ( $test_might_fail ) {
- ok( " write attempts failed, but OK nevertheless because setsockopt failed" );
- } else {
- print "not " if !$attempts;
- }
+ if ( ! $attempts && $test_might_fail ) {
+ ok( " write attempts failed, but OK nevertheless because setsockopt failed" );
} else {
+ print "not " if !$attempts;
ok( "multiple write attempts" );
}
@@ -247,6 +247,13 @@
############################################################
# SERVER == parent process
############################################################
+ my %extra_options = $Net::SSLeay::VERSION>=1.16 ?
+ (
+ SSL_key_file => "certs/client-key.enc",
+ SSL_passwd_cb => sub { return "opossum" }
+ ) : (
+ SSL_key_file => "certs/client-key.pem"
+ );
# pendant to tests in client. Where client is slow (sleep
# between plain text sending and connect_SSL) I need to
@@ -260,7 +267,7 @@
my $from_client = $server->accept or print "not ";
ok( "tcp accept" );
$from_client || do {
- diag( "failed to accept: $!" );
+ diag( "failed to tcp accept: $!" );
next;
};
@@ -268,9 +275,9 @@
$from_client->blocking(0);
# read plain text data
- my $buf;
- while (1) {
- sysread( $from_client, $buf,9 ) && last;
+ my $buf = '';
+ while ( length($buf) <9 ) {
+ sysread( $from_client, $buf,9-length($buf),length($buf) ) && next;
die "sysread failed: $!" if $! != EAGAIN;
IO::Select->new( $from_client )->can_read(30);
}
@@ -286,9 +293,8 @@
SSL_ca_file => "certs/test-ca.pem",
SSL_use_cert => 1,
SSL_cert_file => "certs/client-cert.pem",
- SSL_version => 'TLSv1',
- SSL_cipher_list => 'HIGH',
- %extra_options
+ %extra_options,
+ %tls_options,
)) {
diag( 'start_SSL return undef' );
print "not ";
@@ -306,17 +312,17 @@
my $attempts = 0;
while ( 1 ) {
$from_client->accept_SSL && last;
- diag( $SSL_ERROR );
if ( $SSL_ERROR == SSL_WANT_READ ) {
$attempts++;
IO::Select->new($from_client)->can_read(30) && next; # retry if can read
} elsif ( $SSL_ERROR == SSL_WANT_WRITE ) {
$attempts++;
IO::Select->new($from_client)->can_write(30) && next; # retry if can write
- }
- diag( "failed to accept: ".$from_client->errstr );
- print "not ";
- last;
+ } else {
+ diag( "failed to ssl accept ($test): $@" );
+ print "not ";
+ last;
+ }
}
ok( "ssl accept handshake done" );
@@ -331,25 +337,33 @@
IO::Select->new( $from_client )->can_read(30);
( sysread( $from_client, $buf,10 ) == 10 ) || print "not ";
- diag($buf);
+ #diag($buf);
ok( "received client message" );
sleep(5);
my $bytes_received = 10;
# read up to 30000 bytes from client, then close the socket
+ my $can;
READ:
while ( ( my $diff = 30000 - $bytes_received ) > 0 ) {
+ if ( $can && ! IO::Select->new($from_client)->$can(30)) {
+ diag("failed $can");
+ print "not ";
+ last READ;
+ }
my $n = sysread( $from_client,my $buf,$diff );
if ( !defined($n) ) {
diag( "\$!=$! \$SSL_ERROR=$SSL_ERROR" );
if ( $! == EAGAIN ) {
if ( $SSL_ERROR == SSL_WANT_READ ) {
$attempts++;
- IO::Select->new($from_client)->can_read(30);
+ $can = 'can_read';
} elsif ( $SSL_ERROR == SSL_WANT_WRITE ) {
$attempts++;
- IO::Select->new($from_client)->can_write(30);
+ $can = 'can_write';
+ } else {
+ $can = 'can_read';
}
} else {
print "not ";
@@ -366,10 +380,10 @@
}
$bytes_received += $n;
- diag( "read of $n bytes" );
- }
-
- diag( "read $bytes_received" );
+ #diag( "read of $n bytes" );
+ }
+
+ diag( "read $bytes_received ($attempts r/w attempts)" );
close($from_client);
}
More information about the Pkg-perl-cvs-commits
mailing list