Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

alarm not working

by anshumangoyal (Scribe)
on Jul 11, 2012 at 08:19 UTC ( [id://981047]=perlquestion: print w/replies, xml ) Need Help??

anshumangoyal has asked for the wisdom of the Perl Monks concerning the following question:

I have a code where I send command to another machine and wait for it's response over UDP. Now, I want when the response from remote machine stops coming for 'time-out' number of seconds i should close the socket and come out. Here is the code/function i am using. Problem is alarm is not triggered and the program remains in infinite loop. Can any one help.
sub ReceiveResponse { my $port = shift; my $time_out = 1; print "FW Machine: Waiting for Command Response On Port $recv_port +\n"; eval { local $SIG{ALRM} = sub { die "Timed Out"; }; my $socket_resp = IO::Socket::INET->new(LocalPort => $recv_por +t, Proto => 'udp', Timeout => undef); alarm 10; while (1) { my $recieved_data; $socket_resp->recv($recieved_data,1024); my $peer_address = $socket_resp->peerhost(); my $peer_port = $socket_resp->peerport(); if ($peer_address eq $send_ip_address) { my $desti = GetIP(); chomp($recieved_data); print "$peer_address:$peer_port > $desti:$recv_port => + $recieved_data\n"; if ($recieved_data =~ m/^done/i) { last; } } } $socket_resp->close(); alarm 0; }; alarm 0; if ($@ =~ /Timed Out/i) { print "Timed-Out Receiving Data from UDP\n"; } }

Replies are listed 'Best First'.
Re: alarm not working
by aitap (Curate) on Jul 11, 2012 at 09:19 UTC
    The following code works normally:
    #!/usr/bin/perl eval { local $SIG{ALRM} = sub { die "Timed Out"; }; alarm 3; sleep 1 while 1; alarm 0; }; alarm 0; if ($@ =~ /Timed Out/i) { print "Timed-Out waiting for infinite loop to finish\n"; }
    So I guess, your problem is that $socket_resp->recv($recieved_data,1024); blocks until it receives 1024 bytes. Try adding Blocking => 0 to IO::Socket::INET->new() arguments. You would also probably want to substitute my $port = shift; with my $recv_port = shift; (use warnings; warned about it).
    Sorry if my advice was wrong.
      Blocking does not resolve the problem. Here is the code, I am still facing the issue the program is not killed after alarm but sits back waiting and waiting.
      my $socket_resp = IO::Socket::INET->new(LocalPort => $response_por +t, Proto => 'udp', Blocking => 1, Timeout => undef); print "FW Machine: Waiting for Command Response On Port $response_ +port\n"; eval { local $SIG{ALRM} = sub { die "Timed Out"; }; alarm 10; while (1) { my $recieved_data; $socket_resp->recv($recieved_data, 1024); alarm 10; my $peer_address = $socket_resp->peerhost(); my $peer_port = $socket_resp->peerport(); if ($peer_address eq $send_ip_address) { my $desti = GetIP(); chomp($recieved_data); print "$peer_address:$peer_port > $desti:$response_por +t => $recieved_data\n"; if ($recieved_data =~ m/^done/i) { last; } } } alarm 0; }; alarm 0; if ($@ =~ /Timed Out/i) { print "Timed-Out waiting for infinite loop to finish\n"; } $socket_resp->close();

        alarm() on Windows cannot interrupt system calls, so there should be another answer.(see Alphabetical Listing of Perl Functions)

        Can you try the third method from Re: what does timeout mean in IO::Socket::INET ?? It seems to be the right thing.

        Also, I may have misunderstood somethng, but Blocking is set to 1 in your code. If all else fails, the following (ugly) kludge can help:

        my $socket_resp = IO::Socket::INET->new(LocalPort => $response_port, P +roto => 'udp', Blocking => 0, Timeout => undef); ... $received_data=&timeout_recv($socket,1024,10); ... sub timeout_recv { my $return; my $buf; my $cnt=0; for (1..$_[2]) { # $_[2] is timeout $_[0]->recv($buf,$_[1]-$cnt) // 0; # $_[1] is count of bytes to rece +ive $cnt += length $buf; $return .= $buf; return $return if $cnt == $_[1]; sleep 1; # the ugliest line } die "Timed Out"; }

        Sorry if my advice was wrong.
Re: alarm not working
by BrowserUk (Patriarch) on Jul 11, 2012 at 09:28 UTC

    What OS are you on?

      I am on Windows OS.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (6)
As of 2024-04-23 17:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found