Versione testata su Debian e fedora..



#!/usr/bin/perl -w
# Michele Cavallaro
# 2010_07_23
# Script per inviare un datastring in broadcast
# e ricevere la risposta dai server che interpretano la stringa
use strict;
use Socket;
#use diagnostic;
use Sys::Hostname;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
#
my ($sock, $iaddr, $proto, $port, $receiverPort, $senderPort, $paddr, $flags, $ifconfig, $interface, $address);
#
$interface="eth0";
# path to ifconfig
$ifconfig="/sbin/ifconfig";
my @lines=qx|$ifconfig $interface| or die("Can't get info from ifconfig: ".$!);
foreach(@lines){
if(/inet addr[\d.]+)/){
#print "$1\n";
$address="$1";
}
};

$iaddr = inet_aton($address);
$proto = getprotobyname('udp');
$senderPort= 65534;
$receiverPort= 65535;
$paddr = sockaddr_in($senderPort, $iaddr);
#
print STDERR "sender address.port=>"." "."$address"." "."$senderPort\n";
socket($sock, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";
setsockopt($sock, SOL_SOCKET, SO_BROADCAST, pack("l", 1)) or die "sockopt: $!";
$flags = fcntl($sock, F_GETFL, 0) or die "Can't get flags for the socket: $!\n";
$flags = fcntl($sock, F_SETFL, $flags | O_NONBLOCK) or die "Can't set flags for the socket: $!\n";
bind($sock, $paddr) || die "bind: $!";
#
while (1) {
my $datastring = "data to be send";
my $bytes = send($sock, $datastring, 0,
sockaddr_in($receiverPort, inet_aton('255.255.255.255')));
if (!defined($bytes)) {
print("$!\n");
} else {
print("sent $bytes bytes\n");
}
$datastring = '';
sleep(1);
my $hispaddr = recv($sock, $datastring, 64, 0); # blocking recv
if (!defined($hispaddr)) {
print("recv failed: $!\n");
sleep(2);
next;
}
print "received data=>"." "."$datastring\n";
my ($port1, $ipaddr1) = sockaddr_in($hispaddr);
print "receiver address=>"." ". inet_ntoa($ipaddr1)." "."$port1"." \n";
sleep(2);
}