Perl: Wie man IO::Socket::INET-timeout nach X Sekunden?

Wenn Sie überprüfen Sie den code, den Sie sehen (kopiert habe ich es von meinem Ubuntu 10.04) :

        my $timeout = ${*$sock}{'io_socket_timeout'};
#       my $before = time() if $timeout;

        undef $@;
        if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
#            ${*$sock}{'io_socket_timeout'} = $timeout;
            return $sock;
        }

        return _error($sock, $!, $@ || "Timeout")
            unless @raddr;

#       if ($timeout) {
#           my $new_timeout = $timeout - (time() - $before);
#           return _error($sock,
#                         (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
#                         "Timeout") if $new_timeout <= 0;
#           ${*$sock}{'io_socket_timeout'} = $new_timeout;
#        }

Offenbar der timeout-Sachen auskommentiert ist, so dass expleins warum wird es ignoriert.

Fand ich eine post aus 2003, wo dies diskutiert wurde. Ein Vorschlag (unten) wurde um den sockel öffnen in einem eval-block wird beendet durch ein Alarmsignal :

eval { 
  local $SIG{ALRM} = sub { die 'Timed Out'; }; 
  alarm 3; 
  my $sock = IO::Socket::INET->new( 
    PeerAddr => inet_ntoa( gethostbyname($host) ), 
    PeerPort => 'whois', 
    Proto => 'tcp', 
    ## timeout => , 
  );
  $sock->autoflush;   
  print $sock "$qry\015\012"; 
  undef $/; $data = <$sock>; $/ = "\n"; 
  alarm 0; 
}; 
alarm 0; # race condition protection 
return "Error: timeout." if ( $@ && $@ =~ /Timed Out/ ); 
return "Error: Eval corrupted: $@" if $@; 

Nicht sehr elegant, aber wenn es funktioniert...

Lassen Sie uns überprüfen Sie mit einem langsamen server und ungeduldig client :

# Impatient Client
use IO::Socket::INET;

$sock = new IO::Socket::INET(
    PeerAddr => "localhost",
    PeerPort => "10007",
    Proto => 'tcp',
    Timeout => 2,
    );  

print <$sock>;

close($sock);


# SlowServer
use IO::Socket::INET;

$sock = new IO::Socket::INET(
    LocalAddr => "localhost",
    LocalPort => "10007",
    Proto => 'tcp',
    Listen => 1,
    Reuse => 1,
    );

$newsock = $sock->accept();
sleep 5;

#while (<$newsock>) {
#    print $_;
#}
print $newsock "Some Stuff";
close($newsock);
close($sock);

wenn wir dies ausführen:

pti@pti-laptop:~/playpen$ perl server.pl&
[1] 9130
pti@pti-laptop:~/playpen$ time perl test.pl
Some Stuff[1]+  Done                    perl server.pl

real    0m5.039s
user    0m0.050s
sys     0m0.030s

So ignoriert es die 2-Sekunden-timeout und läuft für die vollen 5 Sekunden.

Nun der andere ungeduldig client :

use IO::Socket::INET;
eval {
  local $SIG{ALRM} = sub { die 'Timed Out'; };
  alarm 2;
  $sock = new IO::Socket::INET(
    PeerAddr => "localhost",
    PeerPort => "10007",
    Proto => 'tcp',
    Timeout => 2,
    );

  print <$sock>;

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

~

und es läuft :

pti@pti-laptop:~/playpen$ perl server.pl&
[1] 9175
pti@pti-laptop:~/playpen$ time perl test2.pl
Error: timeout.Error: Eval corrupted: Timed Out at test2.pl line 3.

real    0m2.040s
user    0m0.020s
sys         0m0.010s

Yep, diese timeouts nach 2 Sekunden wie erwartet.