[perl] Broadcast UDP client/server

[micaro]

Buongiorno,
premetto che sono nuovo del PERL e quindi chiedo da subito umilmente scusa se utilizzerò termini sbagliati o non ben centrati!

Devo identificare in rete dei servers che rispondono, usando uno specifico messaggio, ad una chiamata broadcast UDP sulla porta 65535.
Devo utilizzare il protocollo UDP in quanto questi dispositivi potrebbero non avere indirizzo IP configurato.
Ho fatto molte ricerche (googlato) in rete. In molti siti, anche nell'ufficiale PERL, ci sono scripts che aiutano nel fare questa operazione. in particolare allego in fondo mi è sembrato il più rappresentativo e ben spiegato.
Purtroppo ogni script che ho provato presenta lo stesso problema: il comando recv si "pianta" (hang) e devo terminare l'esecuzione manualmente con ^C..
Potete dirmi dove sto sbagliando???

Grazie mille davvero se mi aiutate sono giorni che sto impazzendo!!!

michele

Aggiungo alcune informazioni:

-ho testato gli script con la mia macchina W32 + strawberry perl. Poi su una macchina Linux con Debian release 4.0..
-Ho disabilitato il firewall.
-Sulla macchina W32 ho fatto girare il software fornito dal costruttore che riesce benissimo a trovare i server anche con il firewall attivato (e il programma non ha creato nessuna eccezione nel firewall)
-Ho utilizzati Wireshark e ho visto che alla chiamata broadcast i server rispondono indirizzando il loro messaggio al socket che ho creato.
-Ho utilizzato il parametro blocking -> 1 con il solo risultato che il programma termina richiamando il messaggio di timeout.
-Ho fatto un server locale (sempre con uno script di Jeff Williams) in modo da testare sulla mia macchina lo script in "loop". Funziona solo se al posto di 255.255.255.255 come indirizzo metto 127.0.0.1.
-Se metto l'indirizzo di uno di questi servers al posto dell'indirizzo di broadcast recv funziona e riesco a ottenere la risposta, ma ovviamente non è quello lo scopo...

Ancora scusate se mi sono espresso male!


#!/usr/bin/perl -w
#---------------------------------------------------------------
# GR Perl Mongers
# Jeff Williams
# 11/23/1999
# Sockets: Simple UDP client - can not use a telnet to talk directly
# to server process so we use this client
#---------------------------------------------------------------

use IO::Socket;
use strict;

my($sock, $server_host, $msg, $port, $ipaddr, $hishost,
$MAXLEN, $server_port, $TIMEOUT);

#-- Define the port to listen on
$server_port = 65535;

#-- Listening on this PC. Must be changed for a real host
$server_host = "255.255.255.255";
#$server_host = shift; #<-???????

#-- Maximum message length - corresponds to value on server
$MAXLEN = 1024;

#-- Since we are getting a message from the server
#-- we have a timeout in case the expected datagram is not sent
$TIMEOUT = 180;

#-- Grab what we type as a parameter and send to the server
$msg = "@ARGV";

#-- Build the socket and bind to port
$sock = IO::Socket::INET->new(Proto => 'udp',
PeerPort => $server_port,
PeerAddr => $server_host,
#mod mic
#PeerAddr => inet_ntoa(INADDR_BROADCAST),
LocalPort => '65534',
Broadcast => 1,
#Blocking => 0
#fine mod mic
)
or die "Creating socket: $!\n";

#-- Send a msg to the server
$sock->send($msg) or die "send: $!";

#-- Alarm loop
if ($msg ne "quit"){
eval {
local $SIG{ALRM} = sub { die "alarm time out" };
alarm $TIMEOUT;

#-- Receive msg from the server
$sock->recv($msg, $MAXLEN) or die "recv: $!";

alarm 0;
1; # return value from eval on normalcy
} or die "recv from $server_host timed out after $TIMEOUT seconds.\n";

#-- Server response
($port, $ipaddr) = sockaddr_in($sock->peername);
$hishost = gethostbyaddr($ipaddr, AF_INET);
#-- This handles the problem of using the loopback address
if (not defined($hishost)){
$hishost = "127.0.0.1";
}
print "Server $hishost responded ``$msg''\n";
}

[micaro]

Bingo. Qualcosa che va (almeno nella mia configurazione).
Dopo svariate ricerche ho trovato due link che ritengo molto utili per il mio problema (vedi sotto)
Sono arrivato alla conclusione che IO::SOCKET non è la risposta giusta. Utilizzando Socket posso gestire le porte a più nasso livello..
Allego il mio primo script funzionante dove ho inserito (commentate) anche due istruzioni di set per le flags della socket in modo da renderla non blocking.
Non ho testato completamente la funzione non blocking però dovrebbe funzionare.
Ovviamente tale funzione serve nel caso non ci siano servers che rispondano al messaggio $datastring.
Ho messo anche due istruzioni "volanti" che stampano anche porta e indirizzo del server che risponde...
Lo script quindi riesce a funzionare solo partendo da una socket ($receiverSock) nota da interrogare.
Invia e riceve in UDP sulla stessa socket ($senderPort) un messaggio broadcast.
Sarò comunque grato a chiunque possa indicarmi eventuali difetti così da rendere ottimizzato lo script!!!!

Ecco i links:
http://stackoverflow.com/questions/8...g-to-broadcast
http://perldoc.perl.org/perlipc.html...essage-Passing

Ecco lo script

Facendo un po di mix fra i due... ho costruito quanto sotto.


#!/usr/bin/perl -w
# Michele Cavallaro
# 2010_07_16
# 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;
#
my ($sock, $iaddr, $proto, $port, $receiverPort, $senderPort, $paddr);
#
$iaddr = gethostbyname(hostname());
$proto = getprotobyname('udp');
$senderPort= 65534;
$receiverPort= 65535;
$paddr = sockaddr_in($senderPort, $iaddr);
#
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 = "X";
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 = '';
my $hispaddr = recv($sock, $datastring, 64, 0); # blocking recv
if (!defined($hispaddr)) {
print("recv failed: $!\n");
next;
sleep(2);
}
print "$datastring\n";
my ($port1, $ipaddr1) = sockaddr_in($hispaddr);
print "$port1"." ". inet_ntoa($ipaddr1)." \n";
sleep(2);
}

[micaro]

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);
}

[micaro]

Attenzione difetto del copia e incolla la riga 19 è

if(/inet addr: ([\d.]+)/){


(l'interprete ha sostituito i due punti parentesi tonda aperta con smile... per chiarezza)