Perl Socket设置有效的timeout-HVH
不论使用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 = ;
[*] $/ = "\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;
[*] importErrno 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 )
[*] {
[*] 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
页:
[1]