Avatar of rangers80
rangers80
Flag 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('255.255.255.255') );
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_DHCP_MESSAGE_TYPE()       => DHCPDISCOVER(),
    DHO_HOST_NAME()               => 'Perl Test Client',
    DHO_VENDOR_CLASS_IDENTIFIER() => 'perl',
);

$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();
$ip_offerto=$resp->yiaddr();
print $ip_offerto;
$result = ($ip_offerto =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) ? "true":"false";
print $result;
close($socket);
}


my $nowtime = localtime(time);

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

prova();
if ( $result eq 'true') { 
......
}
else
{
------
}

Open in new window

DHCPProgrammingPerl

Avatar of undefined
Last Comment
Phil Phillips

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
ozo

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
rangers80

ASKER
ozo,
the issue is in this point:
$socket->recv( $buf, 4096) or die "recvfrom() failed:$!";
rangers80

ASKER
Dear team, any news?  I need a support as soon as possible.
rangers80

ASKER
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?
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Phil Phillips

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