Perl Socket设置有效的timeout-HVH

q66262

　　不论使用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;
  
•     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 )
  
•     {
  
•         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