| Subject: | readline blocks in non-blocking mode |
Good day.
IO::Socket::SSL seems to block during readline() call in non-blocking
mode, unlike IO::Socket, which return EWOULDBLOCK or EAGAIN error if no
data available.
Test case included.
| Subject: | readline-nonblocking.t |
#!perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl t/readline.t'
use warnings;
use strict;
use Net::SSLeay;
use Socket;
use IO::Socket::SSL;
use Test::More tests => 4;
use Errno qw(EAGAIN EWOULDBLOCK EINTR);
# first create simple ssl-server
my $addr = '127.0.0.1';
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",
) || die $!;
pass("Server Initialization");
# add server port to addr
$addr .= ':' . (sockaddr_in(getsockname($server)))[0];
my $pid = fork();
if (!defined $pid) {
die $!; # fork failed
}
elsif ($pid) {
###### Server
alarm 1;
$SIG{ALRM} = sub {
server_die("timeout");
};
my $to_client = $server->accept
|| server_die("accept failed: " . $server->errstr());
$to_client->blocking(0);
# We don't have data at this point, readline should return error
my $line;
$line = <$to_client>;
ok !defined $line, "no data received";
ok $! == EAGAIN || $! == EWOULDBLOCK, "error code is correct";
$to_client->blocking(1);
print $to_client "start\n";
$to_client->blocking(0);
# Rececive line from client, non-blocking variant
my $data;
while (!defined ($data = <$to_client>)) {
if ($! and $! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK) {
server_die($!);
}
elsif (!$!) {
die "client disconnected";
}
}
is $data, "foo bar", "received line is correct";
wait;
exit;
}
close($server);
my $to_server = IO::Socket::SSL->new($addr)
|| die("connect failed: " . IO::Socket::SSL->errstr());
# wait for server command
<$to_server>;
print $to_server "foo bar";
$to_server->close;
sub server_die {
kill(9, $pid);
die shift;
}