2008年11月19日星期三

Perl Socket设置有效的timeout

不论使用LWP还是IO::Socket,timeout参数都是一个古怪的问题,它要么不起作用,要么有很大的局限性,比如只有在目标地址能够连通,但 Socket无法建立的情况下才有效,如果完全连不上目标地址,程序就会阻塞,timeout设置的时间不起作用,这种情况一般叫做DNS解析错误,即使是用ip连接也一样。
要实现完全可控制的timeout连接,常见的办法是使用alarm:

#!/usr/bin/perl -w

use strict;
use IO::Socket::INET;

my $timeout = 5;

eval
{
local $SIG{ALRM} = sub { die 'Timed Out'; };
alarm $timeout;
my $sock = IO::Socket::INET->new(
PeerAddr => 'somewhere',
PeerPort => '80',
Proto => 'tcp',
## timeout => ,
);

$sock->autoflush(1);

print $sock "GET / HTTP/1.0\n\n";

undef $/;
my $data = <$sock>;
$/ = "\n";

print "Resp: $data\n";

alarm 0;
};

alarm 0; # race condition protection
print "Error: timeout." if ( $@ && $@ =~ /Timed Out/ );
print "Error: Eval corrupted: $@" if $@;


但这在Win32中似乎没有效果,其实比较合理的做法是在Socket创建时不设定目标地址,然后将Socket设置为非阻塞模式,最后再连接地址:

#!/usr/bin/perl

use strict;
use IO::Socket::INET;
use IO::Select;
use IO::Handle;

BEGIN
{
if($^O eq 'MSWin32')
{
eval '*EINPROGRESS = sub { 10036 };';
eval '*EWOULDBLOCK = sub { 10035 };';
eval '*F_GETFL = sub { 0 };';
eval '*F_SETFL = sub { 0 };';
*IO::Socket::blocking = sub
{
my ($self, $blocking) = @_;
my $nonblocking = $blocking ? 0 : 1;
ioctl($self, 0x8004667e, \$nonblocking);
};
}
else
{
require Errno;
import Errno qw(EWOULDBLOCK EINPROGRESS);
}
}

my $socket;
my $timeout = 5;

if (!($socket = IO::Socket::INET->new(
Proto => "tcp",
Type => SOCK_STREAM) ))
{
print STDERR "Error creating socket: $@";
}

$socket->blocking(0);

my $peeraddr;
if(my $inetaddr = inet_aton("somewhere"))
{
$peeraddr = sockaddr_in(80, $inetaddr);
}
else
{
print STDERR "Error resolving remote addr: $@";
}

$socket->connect($peeraddr);
$socket->autoflush(1);

my $select = new IO::Select($socket);

if($select->can_write($timeout))
{
my $req = "GET / HTTP/1.0\n\n";
print $socket $req;

if($select->can_read($timeout))
{
my $resp;
if($resp = scalar <$socket>)
{
chomp $resp;
print "Resp: $resp\n";
}
}
else
{
print "Response timeout.\n";
}
}
else
{
print "Connect timeout.\n";
}

close $socket;
exit;


由于在Win32中不能直接使用blocking(0),所以用ioctl进行设置,以上方法在Linux和Win32中都能正常工作,但如在Win32中把IO::Socket::INET换成IO::Socket::SSL就不行了,后来我去perlmonks问了这个问题,但并没有得到解决:
http://www.perlmonks.org/?node_id=676887

没有评论: