Link to home
Get AccessLog in
Avatar of rangers80
rangers80Flag for Italy

asked on

timeout for perl script

I need to set up a timeout about this perl script.
The function recv might sent in hang the script if the are no ldhcp server listening.
use IO::Socket::INET;
use Net::DHCP::Packet;
use Net::DHCP::Constants;
my $result='false';

sub prova() {
my $br_addr = sockaddr_in( '67', inet_aton('') );
my $xid     = int( rand(0xFFFFFFFF) );
my $chaddr  = '00189BF9C1DG';

my $socket = IO::Socket::INET->new(
    Proto     => 'udp',
    Broadcast => 1,
    LocalPort => '68',
) or die "Can't create socket: $@\n";
print "inizio:\n";
my $discover_packet = Net::DHCP::Packet->new(
    Xid                           => $xid,
    Chaddr                        => $chaddr,
    Flags                         => 0x8000,
    DHO_HOST_NAME()               => 'Perl Test Client',

$socket->send( $discover_packet->serialize(), 0, $br_addr)
    or die "Error sending:$!\n";
my $buf = '';

$socket->recv( $buf, 4096) or die "recvfrom() failed:$!";
my $resp = new Net::DHCP::Packet($buf);
print "Details:\n" . $resp->toString();
print $ip_offerto;
$result = ($ip_offerto =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) ? "true":"false";
print $result;

my $nowtime = localtime(time);

print "\n";
print "\n";
print $nowtime;
print "\n";

if ( $result eq 'true') { 

Open in new window

Avatar of ozo
Flag of United States of America image

Link to home
This content is only available to members.
To access this content, you must be a member of Experts Exchange.
Get Access
Avatar of rangers80


the issue is in this point:
$socket->recv( $buf, 4096) or die "recvfrom() failed:$!";
Dear team, any news?  I need a support as soon as possible.
this code doesn't work on windows i did some research on this and found out that SIG doesn't work for windows(book programming Perl). could some one suggest how could I achieve this in windows?
You can try setting the recv timeout after creating the socket.  I'm not sure this will work in windows, but you can give it a try:

//Set a recv timeout of 5 seconds
$socket->setsockopt(SOL_SOCKET, SO_RCVTIMEO, 5000);

Open in new window

Also, I haven't been able to get setsockopt working properly on Linux or FreeBSD without doing the following, since perl doesn't seem to be packing the 'struct timeval' required by perl properly, so if the line above doesn't work, the following *might* work instead:

//Set a recv timeout of 5 seconds
$socket->setsockopt(SOL_SOCKET, SO_RCVTIMEO, pack('l!l!', 5, 0));

Open in new window