Beefy Boxes and Bandwidth Generously Provided by pair Networks Joe
Perl-Sensitive Sunglasses
 
PerlMonks  

alarm not working on windows machine

by Rahul Gupta (Sexton)
on Oct 18, 2013 at 12:20 UTC ( #1058745=perlquestion: print w/ replies, xml ) Need Help??
Rahul Gupta has asked for the wisdom of the Perl Monks concerning the following question:

I am using IO::Scoket module with tcp protocol.

server is running on linux box:

server code:
#!/usr/bin/perl -w use strict; use IO::Socket::INET; my $Receiving_Port = 7777; # flush after every write $| = 1; my ( $socket, $received_data ); my ( $peeraddress, $peerport ); $socket = new IO::Socket::INET ( LocalHost => '127.0.0.1', LocalPort => $Receiving_Port, Proto => 'tcp', Listen => 5, Reuse => 1 ) or die "ERROR in Socket Creation : $!\n"; $socket->listen(); $socket->autoflush(1); print "TCP Server Started\n"; my $addr; while (1) { $addr = $socket->accept(); print "$addr\n"; $peeraddress = $addr->peerhost(); $peerport = $addr->peerport() ; if ( $^O !~ m/mswin32/i ) { $SIG{CHLD} = 'IGNORE'; } while (<$addr>) { # Read all messages from client # Print received message $received_data = $_; chomp($received_data); my $exitCode = RunCommand( $received_data, $peeraddress, $peer +port ); #exit $exitCode; } } $socket->close(); sub RunCommand { my $Command_To_Send = shift; my $send_ip = shift; my $peerport = shift; # file handler which will have response values. if ( $Command_To_Send =~ m/Check Connectivity/i ) { print $addr "Connected to TCP socket server\n"; return 0; } return 0; }

client is running on windows machine.

Client code
#!perl -w use strict; use IO::Socket::INET; my $channel_id = open_channel("127.0.0.1", "7777"); sub open_channel { # create a connecting socket my $host = shift; my $port = shift; my $alrm_time_out = 5; if ( $host !~ m/(\d+)\.(\d+)\.(\d+).(\d+)/i ) { print "IP Address:'$host' is not a Valid IP-Address."; return 139; } my $socket = new IO::Socket::INET ( PeerHost => $host, PeerPort => $port, Proto => 'tcp', ); die "cannot connect to the server $!\n" unless $socket; if ( !defined $socket ) { print "Opening TCP Channel to host: $host and Port: $port Fail +ed !!"; return 138; } else { local $SIG{ALRM} = sub { close $ChannelID; print "=> Time-Out as no data received for '$alrm_time_out + sec'.!!\n"; }; $socket->send("Check Connectivity"); alarm $alrm_time_out; while (1) { my $recieved_data= <$socket>; if ( defined $recieved_data ) { chomp($recieved_data); if ($recieved_data =~ /Connected to TCP socket server/ +i){ print "TCP Connection established with Channel id: + '$socket'\n"; return $socket; alarm 0; } else{ print "Cannot craete connection with server\n"; alarm 0; return 137; } } } #$socket->close(); } }

Problem: when server doesn't respond in that case alarm should invoke at client side but things are not happening so. please help me how to kill the client process when server doesn't respond.

Comment on alarm not working on windows machine
Select or Download Code
Re: alarm not working on windows machine
by BrowserUk (Pope) on Oct 18, 2013 at 13:04 UTC

    alarm works on windows; but it will not interrupt pending IO.

    The simplest solution is to use IO::Select::canRead() something like this:

    #!perl -w use strict; use IO::Socket::INET; use IO::Select; my $channel_id = open_channel("127.0.0.1", "7777"); sub open_channel { # create a connecting socket my $host = shift; my $port = shift; my $timeout = 5; if ( $host !~ m/(\d+)\.(\d+)\.(\d+).(\d+)/i ) { print "IP Address:'$host' is not a Valid IP-Address."; return 139; } my $socket = new IO::Socket::INET ( PeerHost => $host, PeerPort => $port, Proto => 'tcp', ); die "cannot connect to the server $!\n" unless $socket; my $sel = IO::Socket->new( $socket ); if ( !defined $socket ) { print "Opening TCP Channel to host: $host and Port: $port Fail +ed !!"; return 138; } else { $socket->send("Check Connectivity"); while (1) { my @ready = $sel->can_read( $timeout ) or do{ print "=> Time-Out as no data received for '$timeo +ut sec'.!!\n"; last; }; my $recieved_data= <$socket>; if ( defined $recieved_data ) { chomp($recieved_data); if ($recieved_data =~ /Connected to TCP socket server/ +i){ print "TCP Connection established with Channel id: + '$socket'\n"; return $socket; } else{ print "Cannot craete connection with server\n"; return 137; } } } $socket->close(); } }

    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.

      Thanks for you reply.

      while executing your code i am getting this error.

      Odd number of elements in hash assignment at C:/Perl/lib/IO/Socket.pm +line 41. IO::Socket: Cannot configure a generic socket at test.pl line 25

      and when i changed

       my $sel = IO::Socket->new( $socket ); with  my $sel = IO::Socket::INET->new( $socket );

      then getting this error

      Can't call method "can_read" on an undefined value at test.pl line 35.

        My typo. This: my $sel = IO::Socket->new( $socket ); should have been: my $sel = IO::Select->new( $socket );.

        Try this:

        #!perl -w use strict; use IO::Socket::INET; use IO::Select; my $channel_id = open_channel("127.0.0.1", "7777"); sub open_channel { # create a connecting socket my $host = shift; my $port = shift; my $timeout = 5; if ( $host !~ m/(\d+)\.(\d+)\.(\d+).(\d+)/i ) { print "IP Address:'$host' is not a Valid IP-Address."; return 139; } my $socket = new IO::Socket::INET ( PeerHost => $host, PeerPort => $port, Proto => 'tcp', ); die "cannot connect to the server $!\n" unless $socket; my $sel = IO::Select->new( $socket ); if ( !defined $socket ) { print "Opening TCP Channel to host: $host and Port: $port Fail +ed !!"; return 138; } else { $socket->send("Check Connectivity"); while (1) { my @ready = $sel->can_read( $timeout ) or do{ print "=> Time-Out as no data received for '$timeo +ut sec'.!!\n"; last; }; my $recieved_data= <$socket>; if ( defined $recieved_data ) { chomp($recieved_data); if ($recieved_data =~ /Connected to TCP socket server/ +i){ print "TCP Connection established with Channel id: + '$socket'\n"; return $socket; } else{ print "Cannot craete connection with server\n"; return 137; } } } $socket->close(); } }

        Note: this is still untested code. The idea is that you should look at the docs for IO::Select and try to understand what the above code is suggesting.


        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.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (9)
As of 2014-04-18 03:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (461 votes), past polls