diff options
Diffstat (limited to 'Ivy.pm')
-rw-r--r-- | Ivy.pm | 67 |
1 files changed, 48 insertions, 19 deletions
@@ -154,6 +154,7 @@ sub _scanConnStatus ($$$@); # verifie les connections effectuees et sub _inetAdrByName ($$); # transforme une adresse inet native en chaine # $host:$port sub _getHostByAddr ($); +sub _getInetByAddr ($); sub _toBePruned ($$$); sub _parseIvyBusParam ($); # prends une adresse de bus de la forme # 143.196.53,DGAC-CENATLS:2010 et @@ -305,9 +306,11 @@ my $loopMode; # liste des bus actifs my %allBuses = (); -# cache des nom retournés par gethostbyaddr pour _getHostByAddr +# cache des nom et des adresse ip retournés par gethostbyaddr pour +# _getHostByAddr et _getInetByAddr my %hostNameByAddr = (); + my $pingId = 1; # identifiant d'un ping (renvoyé par le pong) #my $trace; @@ -1299,7 +1302,7 @@ sub getUuid ($) sub _getBonjour ($) { my $self = shift; - my $DTS = sprintf ("%2d:%2d:%2d", (localtime())[2,1,0]); +# my $DTS = sprintf ("%2d:%2d:%2d", (localtime())[2,1,0]); my $bonjourMsg = ''; @@ -1313,6 +1316,7 @@ sub _getBonjour ($) my $addr = (unpack_sockaddr_in ($inetAddr))[1]; + my $peerInet = _getInetByAddr ($addr); my $peerName = _getHostByAddr ($addr); # on force $peerPort a etre vu comme une valeur numerique @@ -1379,7 +1383,7 @@ sub _getBonjour ($) } # ouverture du canal de communication - my $appSock = IO::Socket::INET->new (PeerAddr => $peerName, + my $appSock = IO::Socket::INET->new (PeerAddr => $peerInet, PeerPort => $peerPort, Proto => 'tcp'); @@ -1392,7 +1396,7 @@ sub _getBonjour ($) binmode ($appSock); # on cree une entree pour $appSock dans la liste des regexp - $nameByHandle{$appSock}=_getHostByAddr($addr) .":$peerPort"; + $nameByHandle{$appSock}=_getInetByAddr($addr) .":$peerPort"; $self->[cnnxion]{"$addr:$peerPort"} = $udpAppName; $self->[sendRegList]{$appSock} = []; $self->[sendRegListSrc]{$appSock} = []; @@ -1461,6 +1465,11 @@ sub _getConnections ($) sub _getMessages ($$) { my ($self, $appSock) = @_; + unless (defined $appSock) { + carp "_getMessages : *UN*inititialized appSock, don't do anything\n" if $^W; + return; + } + my $bufferRef = \$self->[bufRecByCnnx]{$appSock}; my ($addr, $peerPort, $senderName); my $nlIndex; @@ -1516,7 +1525,7 @@ sub _getMessages ($$) # cleaning $sendername with previous \004 used for connection status # bindRegexp avancé : on envoie une liste nom adresse port au lieu du nom - $senderName = [$senderName, _getHostByAddr ($addr), $peerPort] + $senderName = [$senderName, _getInetByAddr ($addr), $peerPort] if ($self->[recCbList][$id]->[2] == CALL_BY_REF); if (ref($cb) ne 'CODE') { @@ -1538,8 +1547,8 @@ sub _getMessages ($$) } } else { #_sendErrorTo ($appSock, "REEGXP ID $id inconnue"); - carp ("Warning in Ivy::_getMessages, received an unknown message or double one shot message ". - "with id $id from $senderName :\n\"$mess\"") if $^W; + carp sprintf ("Warning in Ivy::_getMessages, received an unknown message or double one shot message ". + "with id $id from %s :\n\"$mess\"", _getHostByAddr ($addr)) if $^W; } } @@ -1555,7 +1564,7 @@ sub _getMessages ($$) # fois pour toute, et ainsi optimiser la vitesse de # filtrage des messages a envoyer # print "DBG> REGEXP from $senderName '$id' '$valeurs'\n"; - my $host = _getHostByAddr ($addr); + my $host = _getInetByAddr ($addr); if ($self->_toBePruned ($senderName, $valeurs)) { &_scanConnStatus ($self, $senderName, 'filtered', "$host:$peerPort" , $valeurs); next; @@ -1602,7 +1611,7 @@ sub _getMessages ($$) $self->[sendRegList]{$appSock}->[$id] = undef ; my $regexp = $self->[sendRegListSrc]{$appSock}->[$id]; $self->[sendRegListSrc]{$appSock}->[$id] = undef; - my $host = _getHostByAddr ($addr); + my $host = _getInetByAddr ($addr); &_scanConnStatus ($self, $senderName, 'unsubscribing', "$host:$peerPort" , $regexp); } @@ -1621,7 +1630,7 @@ sub _getMessages ($$) push @{$self->[appliList]{$senderName}}, $appSock; } - my $host = _getHostByAddr ($addr); + my $host = _getInetByAddr ($addr); $self->_scanConnStatus ($senderName, "new", "$host:$peerPort", undef); } @@ -1634,7 +1643,7 @@ sub _getMessages ($$) $senderName = $valeurs; $self->[cnnxion]{"$addr:$peerPort"} = "\004$valeurs"; - $nameByHandle{$appSock}=_getHostByAddr($addr) .":$peerPort"; + $nameByHandle{$appSock}=_getInetByAddr($addr) .":$peerPort"; } elsif ($type == DIRECT_MSG) { @@ -1744,7 +1753,7 @@ sub _inetAdrByName ($$) { my ($port) = $addrInet =~ /:(.*)/; my $addr = substr ($addrInet,0,4); - my $host = _getHostByAddr ($addr); + my $host = _getInetByAddr ($addr); return "$host:$port"; } # end _inetAdrByName @@ -1755,12 +1764,11 @@ sub _removeFileDescriptor ($$$) my ($self, $fd, $callBy) = @_; unless (defined $fd) { -# syswrite ($trace, "_removeFileDescriptor : *UN*inititialized fd, don't do anything\n"); + carp "_removeFileDescriptor : *UN*inititialized fd, don't do anything\n" if $^W; return; } - # on s'est deja occupe de lui return unless exists $self->[sockList]->{$fd}; my $diedAppName = _getNameByFileDes ($self, $fd); @@ -1771,7 +1779,7 @@ sub _removeFileDescriptor ($$$) # sinon le select merde salement sur ce coup my $peerPort = $fd->peerport() ; if ($peerPort == 0) { -# syswrite ($trace, "_removeFileDescriptor : peerport is NULL, don't do anything\n"); + carp "_removeFileDescriptor : peerport is NULL, don't do anything\n" if $^W; return; } # syswrite ($trace, sprintf ("_removeFileDescriptor : suppression dans le fdset de %s[%s]:%d\n", @@ -1810,7 +1818,7 @@ sub _removeFileDescriptor ($$$) # regexps par canal my $addr = substr ($addrInet,0,4); - my $host = _getHostByAddr ($addr); + my $host = _getInetByAddr ($addr); $self->_scanConnStatus ($diedAppName, "died", "$host:$peerPort", undef) ; } # end _removeFileDescriptor @@ -2211,6 +2219,26 @@ sub _getNameByFileDes ($$) } +sub _getInetByAddr ($) +{ + my $addr = shift; + + unless (defined $addr) { + warn "_getInetByAddr : no argument\n"; + return "0.0.0.0"; + } elsif ((length ($addr)) != 4) { + warn "_getInetByAddr : bad argument (len != 4)\n"; + return "BAD_ADDR"; + } + + + $hostNameByAddr{$addr} = [(gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr), + inet_ntoa($addr)] + unless exists $hostNameByAddr{$addr}; + + return $hostNameByAddr{$addr}->[1]; +} + sub _getHostByAddr ($) { my $addr = shift; @@ -2219,14 +2247,15 @@ sub _getHostByAddr ($) warn "_getHostByAddr : no argument\n"; return "EMPTY_ADDR"; } elsif ((length ($addr)) != 4) { - warn "_getHostByAddr : bad argument (len != 4)\n"; + warn "_getInetByAddr : bad argument (len != 4)\n"; return "BAD_ADDR"; } - $hostNameByAddr{$addr} = gethostbyaddr ($addr, AF_INET) || inet_ntoa($addr) + $hostNameByAddr{$addr} = [(gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr), + inet_ntoa($addr)] unless exists $hostNameByAddr{$addr}; - return $hostNameByAddr{$addr}; + return $hostNameByAddr{$addr}->[0]; } |