| Subject: | Non-blocking sockets with Net::Server and SSL are blocking |
Net::Server with SSL enabled breaks non-blocking sockets.
I attached two versions of a simple client/server pair, one with SSL and one without.
Both times, the server is supposed to report "doing something else". This works fine on the non-ssl version, but fails with SSL.
Here is the (in my opinion) relevant list of versions:
* ActivePerl 5.18
* Net::Server 2.008
* Net::SSLeay 1.68
* IO::Socket::SSL 2.012
Things i noticed:
* Net::Server::TiedHandle (in Net::Server.pm) calls read() instead of sysread(), even though i call sysread in my code.
* $self->blocking in IO::Socket::SSL is set, even though i called blocking(0) on the filehandle.
* I could use eval/alarm to implement timeouts, but that does limit my throughput a lot.
* IO::Select with can_read(0) seems to also block.
I have also written a step-by-step reproduction of this problem on PerlMonks:
http://www.perlmonks.org/?node_id=1122895
| Subject: | testclient.pl |
#!/usr/bin/env perl
use strict;
use warnings;
use IO::Socket::INET;
# create a connecting socket
my $peerhost = 'localhost';
my $peerport = 8000;
my $socket = new IO::Socket::INET (
PeerHost => $peerhost,
PeerPort => $peerport,
Proto => 'tcp',
);
binmode($socket, ':bytes');
$socket->blocking(0);
for(my $i = 0; $i < 5; $i++) {
syswrite($socket, chr($i));
sleep(2);
}
| Subject: | testclient_ssl.pl |
#!/usr/bin/env perl
use strict;
use warnings;
use IO::Socket::SSL;
# create a connecting socket
my $peerhost = 'localhost';
my $peerport = 8000;
my $socket = new IO::Socket::SSL (
PeerHost => $peerhost,
PeerPort => $peerport,
Proto => 'tcp',
SSL_verify_mode => SSL_VERIFY_NONE,
);
binmode($socket, ':bytes');
$socket->blocking(0);
for(my $i = 0; $i < 5; $i++) {
syswrite($socket, chr($i));
sleep(2);
}
| Subject: | testserver.pl |
#!/usr/bin/env perl
use strict;
use warnings;
package TestServer;
use base qw(Net::Server);
sub process_request {
my ($self) = @_;
binmode(STDIN, ':bytes');
STDIN->blocking(0);
while(1) {
my $buf;
sysread(STDIN, $buf, 1);
if(defined($buf) && length($buf)) {
my $num = ord($buf);
print STDERR "GOT $num\n";
last if($num == 4);
} else {
print STDERR "...doing something else...\n";
sleep(1);
}
}
print STDERR "Done.\n";
}
TestServer->run(port => 8000);
| Subject: | testserver_ssl.pl |
#!/usr/bin/env perl
use strict;
use warnings;
package TestServer;
use base qw(Net::Server);
sub process_request {
my ($self) = @_;
binmode(STDIN, ':bytes');
STDIN->blocking(0);
while(1) {
my $buf;
sysread(STDIN, $buf, 1);
if(defined($buf) && length($buf)) {
my $num = ord($buf);
print STDERR "GOT $num\n";
last if($num == 4);
} else {
print STDERR "...doing something else...\n";
sleep(1);
}
}
print STDERR "Done.\n";
}
TestServer->run(port => 8000,
proto => 'ssl',
SSL_key_file => 'key.pem',
SSL_cert_file => 'cert.pem');