Bug #72509 for IO-Socket-SSL: Socket timeouts don't work when subclassed by Net::HTTPS

When IO::Socket::SSL is subclassed by Net::HTTPS, the overloading of the blocking method by Net::HTTPS causes timeouts to not be observed. This causes LWP::UserAgent to not observe timeouts for https: urls. I have attached a test script that demonstrates the problem. I have attached a proposed fix which protects IO::Socket::SSL from overloading of the blocking method by any subclass.

Only in ../IO-Socket-SSL-1.49-1timeout/: Makefile.old diff -ru ./SSL.pm ../IO-Socket-SSL-1.49-1timeout/SSL.pm --- ./SSL.pm 2011-10-28 01:13:14.000000000 -0700 +++ ../IO-Socket-SSL-1.49-1timeout/SSL.pm 2011-11-17 15:36:12.834132000 -0800 @@ -212,7 +212,7 @@ $self->SUPER::configure($arg_hash) || return $self->error("@ISA configuration failed"); - $self->blocking(0) if defined $blocking && !$blocking; + $self->SUPER::blocking(0) if defined $blocking && !$blocking; return $self; } @@ -376,7 +376,7 @@ my $timeout = exists $args->{Timeout} ? $args->{Timeout} : ${*$self}{io_socket_timeout}; # from IO::Socket - if ( defined($timeout) && $timeout>0 && $self->blocking(0) ) { + if ( defined($timeout) && $timeout>0 && $self->SUPER::blocking(0) ) { DEBUG(2, "set socket to non-blocking to enforce timeout=$timeout" ); # timeout was given and socket was blocking # enforce timeout with now non-blocking socket @@ -424,7 +424,7 @@ $! ||= ETIMEDOUT; delete ${*$self}{'_SSL_opening'}; ${*$self}{'_SSL_opened'} = -1; - $self->blocking(1); # was blocking before + $self->SUPER::blocking(1); # was blocking before return } @@ -448,7 +448,7 @@ # ssl connect successful delete ${*$self}{'_SSL_opening'}; ${*$self}{'_SSL_opened'}=1; - $self->blocking(1) if defined($timeout); # was blocking before + $self->SUPER::blocking(1) if defined($timeout); # was blocking before $ctx ||= ${*$self}{'_SSL_ctx'}; if ( $ctx->has_session_cache ) { @@ -533,7 +533,7 @@ my $timeout = exists $args->{Timeout} ? $args->{Timeout} : ${*$self}{io_socket_timeout}; # from IO::Socket - if ( defined($timeout) && $timeout>0 && $socket->blocking(0) ) { + if ( defined($timeout) && $timeout>0 && $socket->SUPER::blocking(0) ) { # timeout was given and socket was blocking # enforce timeout with now non-blocking socket } else { @@ -574,7 +574,7 @@ $! ||= ETIMEDOUT; delete ${*$self}{'_SSL_opening'}; ${*$socket}{'_SSL_opened'} = -1; - $socket->blocking(1); # was blocking before + $socket->SUPER::blocking(1); # was blocking before return } @@ -596,7 +596,7 @@ # socket opened delete ${*$self}{'_SSL_opening'}; ${*$socket}{'_SSL_opened'} = 1; - $socket->blocking(1) if defined($timeout); # was blocking before + $socket->SUPER::blocking(1) if defined($timeout); # was blocking before tie *{$socket}, "IO::Socket::SSL::SSL_HANDLE", $socket; @@ -632,7 +632,7 @@ sub read { my $self = shift; return $self->generic_read( - $self->blocking ? \&Net::SSLeay::ssl_read_all : \&Net::SSLeay::read, + $self->SUPER::blocking ? \&Net::SSLeay::ssl_read_all : \&Net::SSLeay::read, @_ ); } @@ -690,7 +690,7 @@ # if all data are written sub write { my $self = shift; - return $self->generic_write( scalar($self->blocking),@_ ); + return $self->generic_write( scalar($self->SUPER::blocking),@_ ); } # contrary to write syswrite() returns already if only @@ -723,18 +723,18 @@ # read all and split my $buf = ''; - my $was_blocking = $self->blocking(1); + my $was_blocking = $self->SUPER::blocking(1); while (1) { my $rv = $self->sysread($buf,2**16,length($buf)); if ( ! defined $rv ) { next if $!{EINTR} or $!{EAGAIN}; - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; return; } elsif ( ! $rv ) { last } } - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; if ( ! defined $/ ) { return $buf @@ -755,18 +755,18 @@ # read record of $size bytes die "bad value in ref \$/: $size" unless $size>0; my $buf = ''; - my $was_blocking = $self->blocking(1); + my $was_blocking = $self->SUPER::blocking(1); while ( $size>length($buf)) { my $rv = $self->sysread($buf,$size-length($buf),length($buf)); if ( ! defined $rv ) { next if $!{EINTR} or $!{EAGAIN}; - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; return; } elsif ( ! $rv ) { last } } - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; return $buf; } @@ -776,19 +776,19 @@ # no usable peek - need to read byte after byte die "empty \$/ is not supported if I don't have peek" if $delim1 ne ''; my $buf = ''; - my $was_blocking = $self->blocking(1); + my $was_blocking = $self->SUPER::blocking(1); while (1) { my $rv = $self->sysread($buf,1,length($buf)); if ( ! defined $rv ) { next if $!{EINTR} or $!{EAGAIN}; - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; return; } elsif ( ! $rv ) { last } index($buf,$delim0) >= 0 and last; } - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; return $buf; } @@ -796,7 +796,7 @@ # find first occurence of $delim0 followed by as much as possible $delim1 my $buf = ''; my $eod = 0; # pointer into $buf after $delim0 $delim1* - my $was_blocking = $self->blocking(1); + my $was_blocking = $self->SUPER::blocking(1); my $ssl = $self->_get_ssl_object or return; while (1) { @@ -814,7 +814,7 @@ ( my $pb = Net::SSLeay::peek( $ssl,$pending )) ne '' ) { $buf .= $pb } else { - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; return $buf eq '' ? ():$buf; }; if ( !$eod ) { @@ -850,7 +850,7 @@ last } } - $self->blocking(0) if ! $was_blocking; + $self->SUPER::blocking(0) if ! $was_blocking; return substr($buf,0,$eod); } @@ -1006,11 +1006,11 @@ if ( ! defined($start_handshake) || $start_handshake ) { # if we have no callback force blocking mode DEBUG(2, "start handshake" ); - my $blocking = $socket->blocking(1); + my $blocking = $socket->SUPER::blocking(1); my $result = ${*$socket}{'_SSL_arguments'}{SSL_server} ? $socket->accept_SSL(%to) : $socket->connect_SSL(%to); - $socket->blocking(0) if !$blocking; + $socket->SUPER::blocking(0) if !$blocking; return $result ? $socket : (bless($socket, $original_class) && ()); } else { DEBUG(2, "dont start handshake: $socket" );

#!/usr/bin/perl use IO::Socket::INET; use IO::Socket::SSL; use Net::HTTPS; my $server = IO::Socket::INET->new(LocalPort => 10002, Listen => 5, ReuseAddr => 1); my $client = IO::Socket::SSL->new(PeerAddr => "localhost:10002", Timeout => 4); print "IO::Socket::SSL completed\n"; my $client = Net::HTTPS->new(PeerAddr => "localhost:10002", Timeout => 4);