Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Locked threads and tcp timeouts

by menth0l (Monk)
on Feb 16, 2012 at 12:04 UTC ( #954207=perlquestion: print w/ replies, xml ) Need Help??
menth0l has asked for the wisdom of the Perl Monks concerning the following question:

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?

Comment on Locked threads and tcp timeouts
Download Code
Re: Locked threads and tcp timeouts
by BrowserUk (Pope) on Feb 16, 2012 at 12:57 UTC

    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


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

    The start of some sanity?

      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.

        If it were me, I would use non-blocking I/O here as a matter of routine procedure, that is, if the exchange with the client under normal circumstances is not so intricate that you want to use a thread to most easily keep track of its individual state.   Physically speaking, the computer is moving a lot of packets, one at a time, through probably a single NIC card:   all of the business of “sockets” is a software, not a hardware artifice.   They are “slots in the mail room,” if you will, not actual things.   I think that you will most often be more pleased with the non-blocking design, than with one that uses threads.

Re: Locked threads and tcp timeouts
by zentara (Archbishop) on Feb 16, 2012 at 17:02 UTC
    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; }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

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

        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

Re: Locked threads and tcp timeouts
by Khen1950fx (Canon) on Feb 19, 2012 at 22:18 UTC
    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();

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://954207]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (10)
As of 2014-08-01 11:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Who would be the most fun to work for?















    Results (8 votes), past polls