Locked threads and tcp timeouts

[menth0l]

Is there a way to timeout a print/read operations on tcp socket on ActiveState Perl 5.12?

my $sock = new IO::Socket::INET(
    LocalHost => $address,
    LocalPort => 0,
    Proto     => 'tcp',
    Listen    => 10,
    Reuse     => 1,
);

my $s = $sock->accept;

# how to timeout this?
my $message = <$s>;

In above example i would like to wait max 3 seconds for a message and then close this connection. I found that these solutions don't work:
1. Timeout option in socket constructor is related to connect/accept calls so it's useless for me
2. trick with eval/$SIG{ALRM}/alarm() don't work on ActiveState Perl (AFAIK ALRM signal is not supported)
Is there any other way?

This brings me to another question, threads-related. Let's assume that my thread is performing a "blocking" operation like: executing a SQL procedure, reading from socket (as in above example) or is locked at a semaphore. How can i break execution of that thread? Sending signals won't work since they are processed only after the blocking operation is completed. Is that even possible?

[BrowserUk]

1. Timeout option in socket constructor is related to connect/accept calls so it's useless for me

   See how to set socket recv timeout in architecture independent manner? for how to set the recieve timeout.

2. trick with eval/$SIG{ALRM}/alarm() don't work on ActiveState Perl (AFAIK ALRM signal is not supported)

   alarm *does* work on win32 (since 5.8.0 I think), but it doesn't interrupt reads because of SAFE SIGNALS

3. Is there any other way?

   You could also resort to non-blocking IO. See How to set sockets non-blocking on Windows

[menth0l]

See how to set socket recv timeout in architecture independent manner? for how to set the recieve timeout.

I have read this thread but it didn't do any good for me. Suggested line:

setsockopt( $client, SOL_SOCKET, SO_RCVTIMEO, pack('L!L!', +10, 0) );

didn't help, perl still blocks at reading from socket. Maybe the 64-bit env is the reason?

You could also resort to non-blocking IO. See How to set sockets non-blocking on Windows

Thanks, i'll look into it.

[zentara]

How can i break execution of that thread? Sending signals won't work since they are processed only after the blocking operation is completed. Is that even possible?

You might try the following, and if that dosn't work, because of the needed SIGINT, the only sure fire way I know would be to fork off the code that can block, run a timer on it, and kill -9 it's $pid when the timer expires.

#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;

my $timer_go:shared = 0;

my $worker = threads->create(\&worker);
my $timer = threads->create(\&timer,$worker)->detach();

print "hit enter to start\n";
<>;
$timer_go=1;


while( (scalar threads->list) > 0   ){
 print scalar threads->list,"\n"; 
 sleep 1;
foreach my $thread (threads->list) {
   if( $thread->is_joinable ){ $thread->join;}
   }
}

print "worker joined, all done\n";
exit;


sub timer {
  my $worker = shift;
   while(1){     
       if($timer_go){
        my $count = 0;
             while(1){ 
                  $count++;
                  if($count > 5){    
                         print "timed out\n";
                          # Send a signal to a thread
                         $worker->kill('INT');
                         return; # will destroy a detached thread
                        } 
                  sleep 1;
                  print "timing $count\n";
            }
       }else{sleep 1}
    }
}

sub worker {
       $|++;
       $SIG{INT} = sub{ warn "Caught Zap!\n"; threads->exit() };
       # threads->exit() will exit thread only

      while(1){sleep 1;  next}

      return;
}

[BrowserUk]

This will not work if the thread is in a blocking IO read state. Ie. The OPs problem.

[nikosv]

would a more drastic approach work ? like getting the underlying Win32 handle ($thr->_handle()) of the worker thread (since threads in Windows are created with CreateThread after all), and kill the thread by passing the handle to the TerminateThread api call ?

a note to the OP, when killing threads associated with calls to the dbms i.e sql execution, might lead to locked resources i.e tables or rows since there is no proper clean up

[Khen1950fx]

The timeout option, while it maybe seem useless, is still necessary in order for the script to work properly. On my ActivePerl, I couldn't get it to timeout without it. Also, are you sure that alarm isn't supported by your version of ActivePerl? I didn't encounter any problems using it.

#!/usr/bin/perl -l

use POSIX qw(SIGALRM);
sub Begin { 
    eval {
        use strict;
        use warnings;
        POSIX::sigaction(SIGALRM,
            POSIX::SigAction->new(sub { die; }))
            || die "Error setting SIGALRM handler: $!";
            alarm 3;
    };
}

use strict;
use warnings;
use sigtrap;
use IO::Socket;

$|=1;

my ($socket, $client);

my $host   = '192.168.1.255';
my $port   = '5500';
my $listen = 10;

$socket = IO::Socket::INET->new(
    LocalHost => $host,
    LocalPort => $port,
    Proto     => 'tcp',
    Listen    => $listen,
    ReuseAddr => 1,
    Blocking  => 1,
    Timeout   => 3,
) or die "Couldn't create socket: $!";
print "Waiting for a connection...";

while ($client = $socket->accept()) {
    my $message = <$socket>;
    $client->autoflush(1);
    print $message;
    close $client;    
}
$socket->close();