diff options
Diffstat (limited to 'Ivy.pm')
| -rw-r--r-- | Ivy.pm | 97 |
1 files changed, 61 insertions, 36 deletions
@@ -84,7 +84,7 @@ sub start; # debut de l'integration au bus : sub DESTROY ($); # - envoie un BYE et clôt les connections -sub bindRegexp ($$$) ; # permet d'associer une regexp avec un callBack +sub bindRegexp ($$$;$) ; # permet d'associer une regexp avec un callBack # ou d'annuler une precedente association sub bindDirect; # permet d'associer un identifiant de msg direct @@ -142,10 +142,11 @@ sub _pong ($$); # (fd) sub _tkFileEvent ($$); # associe un fd a un callback pour la mainloop tk sub _scanAfter () ; # parse si il faut appeler un callback associe a un after sub _myCanRead (); # interface au select -sub _scanConnStatus ($$$$); # verifie les connections effectuees et +sub _scanConnStatus ($$$@); # verifie les connections effectuees et # appelle la fonction $statusFunc sub _inetAdrByName ($$); # transforme une adresse inet native en chaine # $host:$port +sub _getHostByAddr ($); sub _toBePruned ($$$); sub _parseIvyBusParam ($); # prends une adresse de bus de la forme # 143.196.53,DGAC-CENATLS:2010 et @@ -280,6 +281,8 @@ my $loopMode; # liste des bus actifs my %allBuses = (); +# cache des nom retournés par gethostbyaddr pour _getHostByAddr +my %hostNameByAddr = (); ############################################################################# #### CLEFS DES VARIABLES D'INSTANCE ##### @@ -551,14 +554,17 @@ sub new ($%) # toutes les applis necessaires ne sont pas presentes, # et des que toutes les applis necessaires sont # presentes, et si une appli necessaire se deconnecte - # les trois parametres passes à la callback sont : - # [liste des applis presentes], - # [liste des applis absentes], - # [table de hash, clefs = applis presentes, - # valeurs = nombre d'applis . - # normalement ce nombre devrait etre 1, sinon - # ca veut dire que plus d'une appli de meme nom - # tourne sur le meme bus : danger !! + # les parametres passes à la callback sont : + # °[liste des applis presentes], + # °[liste des applis absentes], + # °[table de hash, clefs = applis presentes, valeurs = nombre d'applis . + # normalement ce nombre devrait etre 1, sinon + # ca veut dire que plus d'une appli de meme nom + # tourne sur le meme bus : danger !! + # ° nom de l'appli qui genere l'evenement + # ° evenement : 'subscribing'|'filtered'|'unsubscribing'|'died'|'new' + # ° adresse + # ° regexp si c'est un abonnement, un desabonnement ou un filtered -blockOnSlowAgent => 1, # comportement lorque un ou plusieurs des agents connectés @@ -771,10 +777,12 @@ sub start ############### PROCEDURE BIND REGEXP -sub bindRegexp ($$$) +sub bindRegexp ($$$;$) { my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy; - my ($regexp, $cb) = @_; + my ($regexp, $cb, $callByRef) = @_; + + $callByRef = defined $callByRef ? 1 : 0; my $original_regexp = $regexp; # on substitue les meta caracteres des regexps perl : \d, \w, \s, \e @@ -810,7 +818,7 @@ sub bindRegexp ($$$) for ($id=0; $id <= ($#{$self->[recCbList]}+1); $id++) { last unless (defined $self->[recCbList][$id]) && @{$self->[recCbList][$id]->[1]}; } - $self->[recCbList][$id] = [$regexp, $cb]; + $self->[recCbList][$id] = [$regexp, $cb, $callByRef]; # on envoie les messages regexps aux processus deja connectes _sendLastRegexpToAllreadyConnected ($self, $id) ; @@ -1184,7 +1192,7 @@ sub _getBonjour ($) my $addr = (unpack_sockaddr_in ($inetAddr))[1]; - my $peerName = gethostbyaddr ($addr, AF_INET) || inet_ntoa($addr); + my $peerName = _getHostByAddr ($addr); # on force $peerPort a etre vu comme une valeur numerique my ($version, $peerPort, $udpAppName, $uuid) = @@ -1366,7 +1374,10 @@ sub _getMessages ($$) my $cb = shift @cb; # cleaning $sendername with previous \004 used for connection status - if ($senderName =~ /\004(.*)/) {$senderName = $0;} + $senderName = $0 if ($senderName =~ /\004(.*)/); + # bindRegexp avancé : on envoie une liste nom adresse port au lieu du nom + $senderName = [$senderName, _getHostByAddr ($addr), $peerPort] + if ($self->[recCbList][$id]->[2]); if (ref($cb) ne 'CODE') { my $method = shift @cb; @@ -1395,10 +1406,12 @@ sub _getMessages ($$) # filtrage des messages a envoyer # print "DBG> REGEXP from $senderName '$id' '$valeurs'\n"; if ($self->_toBePruned ($senderName, $valeurs)) { - &_scanConnStatus ($self, $senderName, 'filtered', $valeurs); + &_scanConnStatus ($self, $senderName, 'filtered', + join (':', _getHostByAddr ($addr), $peerPort), $valeurs); next; } else { - &_scanConnStatus ($self, $senderName, 'subscribing', $valeurs); + &_scanConnStatus ($self, $senderName, 'subscribing', + join (':', _getHostByAddr ($addr), $peerPort), $valeurs); } unless (defined $self->[sendRegList]{$appSock}->[$id]) { # si l'id de regexp n'etait pas utilisee c'est tout bon @@ -1450,9 +1463,9 @@ sub _getMessages ($$) $senderName = $0; } $self->[sendRegListSrc]{$appSock}->[$id] = undef; - &_scanConnStatus ($self, $senderName, 'unsubscribing', $regexp); - - } + &_scanConnStatus ($self, $senderName, 'unsubscribing', + join (':', _getHostByAddr ($addr), $peerPort), $regexp); + } elsif ($type == ENDREGEXP) { # E N D R E G E X P # on envoie le message ready uniquement a celui qui nous # a envoye le message endregexp @@ -1469,8 +1482,8 @@ sub _getMessages ($$) push @{$self->[appliList]{$senderName}}, $appSock; } - my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr); - $self->_scanConnStatus ($senderName, "new", "$host"); + my $host = _getHostByAddr ($addr); + $self->_scanConnStatus ($senderName, "new", "$host:$peerPort", undef); } elsif ($type == APP_NAME) { # etat Connecte @@ -1578,7 +1591,7 @@ sub _inetAdrByName ($$) { my ($port) = $addrInet =~ /:(.*)/; my $addr = substr ($addrInet,0,4); - my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr); + my $host = _getHostByAddr ($addr); return "$host:$port"; } # end _inetAdrByName @@ -1596,6 +1609,7 @@ sub _removeFileDescriptor ($$) # on vire ce fd des fd a scruter dans la bcle d'evenements # uniquement si on est dans le thread principal # sinon le select merde salement sur ce coup + my $peerPort = $fd->peerport() ; &$fileEventFunc ($fd, '') ; delete $self->[sendRegList]{$fd}; delete $self->[sockList]{$fd}; @@ -1626,8 +1640,8 @@ sub _removeFileDescriptor ($$) # regexps par canal my $addr = substr ($addrInet,0,4); - my $host = (gethostbyaddr ($addr, AF_INET))[0] || inet_ntoa($addr); - $self->_scanConnStatus ($diedAppName, "died", $host) ; + my $host = _getHostByAddr ($addr); + $self->_scanConnStatus ($diedAppName, "died", "$host:$peerPort", undef) ; } # end _removeFileDescriptor @@ -1785,9 +1799,9 @@ sub _scanAfter () ############### METHODE SCAN CONN STATUS -sub _scanConnStatus ($$$$) +sub _scanConnStatus ($$$@) { - my ($self, $appname, $status, $addr) = @_; + my ($self, $appname, $status, @addr) = @_; my (%readyApp, @nonReadyApp); @@ -1811,7 +1825,8 @@ sub _scanConnStatus ($$$$) # le 4eme arg est l'appli nouvelle, deconnecté, qui s'abonne ou se desabonne # le 5eme arg est le statut (actuellement: 'subscribing'|'filtered'|'unsubscribing'|'died'|'new') # le 6eme arg est l'addresse de la machine sur laquelle tourne l'agent - &{$self->[statusFunc]} ([keys %readyApp], \@nonReadyApp, \%readyApp, $appname, $status, $addr); + # le 7eme arg est la regexp si c'est un abonnement ou desabonnement + &{$self->[statusFunc]} ([keys %readyApp], \@nonReadyApp, \%readyApp, $appname, $status, @addr); } # end _scanConnStatus @@ -2023,6 +2038,16 @@ sub _getNameByFileDes ($$) } + +sub _getHostByAddr ($) +{ + my $addr = shift; + return $hostNameByAddr{$addr} if (exists $hostNameByAddr{$addr}) ; + + my $peerName = gethostbyaddr ($addr, AF_INET) || inet_ntoa($addr); + return ($hostNameByAddr{$addr}= $peerName); +} + 1; __END__ @@ -2187,7 +2212,7 @@ connected agents Ci, a reference to an array of not connected agents (according to the "-neededApp" argument of the new method / function), a reference to a hash table of connected agents Ci (giving the number of each agent). These 3 parameters are maintained for upwards -compatibility but should no more be used, since the following three +compatibility but should no more be used, since the following four parameters are much easier to use: the name of an appearing / disapearing or subscribing / filtered / unsubscribing agent C, its status either "new" or "died" or "subscribing" or "unsubscribing", and the hostname @@ -2201,7 +2226,7 @@ Your callback could be: sub MyCallback { my ($ref_array_present, $ref_array_absent, $ref_hash_present, - $appname, $status, $host_or_regexp) = @_; + $appname, $status, $host, $regexp) = @_; # $status is either new or died @@ -2212,19 +2237,19 @@ Your callback could be: } } if ($status eq "new") { - print "$appname connected from $host_or_regexp\n"; + print "$appname connected from $host\n"; } elsif ($status eq "died") { - print "$appname disconnected from $host_or_regexp\n"; + print "$appname disconnected from $host\n"; } elsif ($status eq "subscribing") { - print "$appname subscribes to $host_or_regexp\n"; + print "$appname subscribes to $regexp\n"; } elsif ($status eq "filtered") { - print "$appname subscribes to FILTERED $host_or_regexp check -filterRegexp option\n"; + print "$appname subscribes to FILTERED $regexp check -filterRegexp option\n"; } elsif ($status eq "unsubscribing") { - print "$appname unsubscribed to $host_or_regexp\n"; + print "$appname unsubscribed to $regexp\n"; } } @@ -2478,4 +2503,4 @@ CENA (C) 1997-2006 =head1 HISTORY -=cut +=cu |