diff options
| -rw-r--r-- | Ivy.pm | 106 | ||||
| -rw-r--r-- | debian/changelog | 13 | ||||
| -rwxr-xr-x | debian/rules | 4 |
3 files changed, 100 insertions, 23 deletions
@@ -1,7 +1,7 @@ # # Ivy, Perl interface # -# Copyright 1997-2001 +# Copyright 1997-2002 # Centre d'Études de la Navigation Aérienne # # Authors: Alexandre Bustico <bustico@cena.fr> @@ -28,6 +28,9 @@ # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, # or refer to http://www.gnu.org/copyleft/lgpl.html # +# $Id$ +# $Name$ +############################################################################# package Ivy ; @@ -38,12 +41,22 @@ use Time::Gettimeofday; use vars qw($VERSION); -$VERSION = '4.8.1'; + +# to compute the VERSION from the CVS tag (or if no tag, as the cvs file revision) +my $TAG= q$Name$; +my $REVISION = q$Revision$ ; +($VERSION) = $TAG =~ /^\D*([\d_]+)/ ; +if (defined $VERSION and $VERSION ne "_") { + $VERSION =~ s/_/\./g; +} +else { + $VERSION = $REVISION; +} ############################################################################# #### PROTOTYPES ##### ############################################################################# -sub init; # methode de classe, permet de renseigner +sub init; # methode de classe, permet de renseigner # tous les parametres globaux. Ces parametres # seront utilises par new si ils ne sont pas # donnes lors de l'appel de new. @@ -269,6 +282,7 @@ use constant sockList => $constantIndexer++; use constant threadList => $constantIndexer++; use constant appliList => $constantIndexer++; use constant sendRegList => $constantIndexer++; +use constant sendRegListSrc => $constantIndexer++; use constant topicRegexps => $constantIndexer++; use constant recCbList => $constantIndexer++; use constant directCbList => $constantIndexer++; @@ -427,6 +441,11 @@ sub new ($%) # au besoin $self->[sendRegList] = {}; + # tableau ass de liste du type + # sockId => "regexp" + # pour connaitre la valeur des regexp meme apres compilation + $self->[sendRegListSrc] = {}; + # liste des topics qu'on envoie si on # filtre les regexps $self->[topicRegexps] = []; @@ -449,7 +468,7 @@ sub new ($%) $self->[cnnxion] = {}; # tableau associatif, clef => file desc, - # valeur :buffer au cas ou la lacture ne se termine + # valeur :buffer au cas ou la lecture ne se termine # pas par \n, de maniere a resegmenter les messages $self->[buffByConn] = {}; @@ -649,6 +668,7 @@ sub bindRegexp my $self = ref($_[0]) eq __PACKAGE__ ? shift : $globalIvy; my ($regexp, $cb) = @_; + my $original_regexp = $regexp; # on substitue les meta caracteres des regexps perl : \d, \w, \s, \e # par les classes de caracteres corespondantes de maniere a ce # qu'une appli distante non perl comprenne ces regexp. @@ -661,10 +681,13 @@ sub bindRegexp | _substituteEscapedChar ('inside', $1) |xge; - + $regexp = _substituteEscapedChar ('outside', $regexp); # print ("DBG regexp = $regexp\n"); - + + eval {my $test = "a" =~ /$regexp/ } ; # testing the regexp for avoiding + if ($@) { warn "Warning in Ivy::bindRegexp, ill-formed regexp: '$original_regexp'" ; return }; + if ($cb) { my $id; # on rajoute le couple $regexp, $cb dans la liste des messages @@ -725,10 +748,12 @@ sub sendMsgs # pour tous les messages foreach my $msg (@msgs) { - study ($msg); + warn "Warning in Ivy::sendMsgs, a message contains a '\\n'. Skipping it:\n'$msg'\n" if ($msg =~ /\n/); - # pour routes les connections - foreach my $fd (keys %{$self->[sockList]}) { + study ($msg); + + # pour routes les connections + foreach my $fd (keys %{$self->[sockList]}) { # pour toutes les fonctions de filtrage de regexp foreach my $regexpFunc (@{$self->[sendRegList]{$fd}}) { @@ -749,6 +774,8 @@ sub sendAppNameMsgs # pour tous les messages foreach (@msgs) { + warn "Warning in Ivy::sendAppNameMsgs, a message contains a '\\n'. Skipping it:\n'$_'\n" if ($_ =~ /\n/); + my $msg = "$self->[appName] $_"; study ($msg); @@ -777,6 +804,8 @@ sub sendDirectMsgs my @fds = @{$self->[appliList]{$to}}; # pour tous les messages foreach my $msg (@msgs) { + warn "Warning in Ivy::sendDirectMsgs, a message contains a '\\n'. Skipping it:\n'$msg'\n" if ($msg =~ /\n/); + foreach my $fd (@fds) { send ($fd, sprintf (MSG_FMT, DIRECT_MSG, $id, "$msg"), 0) or $self->_removeFileDescriptor ($fd); @@ -1047,6 +1076,7 @@ sub _getBonjour ($) # on cree une entree pour $appSock dans la liste des regexp $self->[cnnxion]{"$addr:$peerPort"} = 1; $self->[sendRegList]{$appSock} = []; + $self->[sendRegListSrc]{$appSock} = []; $self->[buffByConn]{$appSock} = ''; $self->[sockList]{$appSock} = $appSock; &$fileEventFunc ($appSock, [\&_getMessages, $self, $appSock]) ; @@ -1083,6 +1113,7 @@ sub _getConnections ($) # on cree une entree pour $appSock dans la liste des regexp $self->[sendRegList]{$appSock} = []; + $self->[sendRegListSrc]{$appSock} = []; $self->[buffByConn]{$appSock} = ''; $self->[sockList]{$appSock} = $appSock; # on balance les regexps qui nous interessent a l'appli distante @@ -1115,6 +1146,7 @@ sub _getMessages ($$) } return; } + if (length ($self->[buffByConn]{$appSock})) { $buffer = $self->[buffByConn]{$appSock} . $buffer ; @@ -1131,7 +1163,7 @@ sub _getMessages ($$) $senderName = "NONAME" unless $senderName; foreach my $mess (@messages) { - # print "DBG>mess from $senderName *$mess*\n"; +# print "DBG>mess from $senderName '$mess'\n"; # on recupere les 3 champs : le type, le numero de regexp, les valeurs my ($type, $id, $valeurs) = $mess =~ /^(\d+) @@ -1151,6 +1183,10 @@ sub _getMessages ($$) if (my @cb = @{$self->[recCbList][$id]->[1]}) { my $cb = shift @cb; my $refcb = ref($cb); + + # cleaning $sendername with previous \004 used for connection status + if ($senderName =~ /\004(.*)/) {$senderName = $0;} + if ($refcb ne 'CODE') { my $method = shift @cb; # on split sur ETX @@ -1176,10 +1212,12 @@ sub _getMessages ($$) # ca permet de compiler les regexp avec 'once' donc une # fois pour toute, et ainsi optimiser la vitesse de # filtrage des messages a envoyer +# print "DBG>REGEXP from $senderName '$id' '$valeurs'\n"; next if $self->_toBePruned ($senderName, $valeurs); unless (defined $self->[sendRegList]{$appSock}->[$id]) { # si l'id de regexp n'etait pas utilisee c'est tout bon # on affecte la nouvelle regexp a un id + $self->[sendRegListSrc]{$appSock}->[$id] = $valeurs; $self->[sendRegList]{$appSock}->[$id] = eval <<'_EOL_'; sub { use strict; @@ -1207,8 +1245,16 @@ _EOL_ "$senderName : \"$valeurs\"\n"); } elsif ($type == DELREGEXP) { # D E L R E G E X P - # on vire la regexp des regexps vefifier - $self->[sendRegList]{$appSock}->[$id] = undef ; + # on vire la regexp des regexps verifiées + $self->[sendRegList]{$appSock}->[$id] = undef ; + my $regexp = $self->[sendRegListSrc]{$appSock}->[$id]; + # cleaning $sendername with previous \004 used for connection status + if ($senderName =~ /\004(.*)/) { + $senderName = $0; + } + $self->[sendRegListSrc]{$appSock}->[$id] = undef; + &_scanConnStatus ($self, $senderName, 'unsubscribing', $regexp); + } elsif ($type == ENDREGEXP) { # E N D R E G E X P # on envoie le message ready uniquement a celui qui nous @@ -1528,6 +1574,20 @@ sub _toBePruned ($$$) { my ($self, $from, $regexp) = @_; + # for message purposes, removing the \004 which indicates the connection status + + my ($cleaned_from) = $from =~ /\004?(.*)/ ; + # print "DBG> $from s'abonne à nouvelle regexp '$regexp'\n"; + + # testing the received regexp for avoiding illformed regexp + eval {my $test = "a" =~ /$regexp/ } ; + if ($@) { + warn "Warning in Ivy::_toBePruned, receiving ill-formed regexp: '$regexp' from '$cleaned_from'" ; + return 1}; + + + &_scanConnStatus ($self, $cleaned_from, 'subscribing', $regexp); + # si il n'y a pas de liste de sujets, on ne # filtre pas return 0 unless @{$self->[topicRegexps]}; @@ -1791,13 +1851,13 @@ before running. =item B<-statusFunc =E<gt> sub {}> -A callback which will be called every time an appli is connected or deconnected on the bus. The first 3 parameters are a reference to an array of connected appli, a reference to an array of not connected appli (according to the "-neededApp" argument of the new method/function), a reference to a hash table of connected appli (giving the number of such appli). These parameters are maintained for upwards compatibility but should no more be used, since the following three parameters are really easier to use: the name of an appearing/disapearing appli, its status either "new" or "died", and the hostname where this appli is running/dying. +A callback which will be called every time an appli is connected on the bus, deconnected from the bus or subscribes to a regexp. The first 3 parameters are a reference to an array of connected appli, a reference to an array of not connected appli (according to the "-neededApp" argument of the new method/function), a reference to a hash table of connected appli (giving the number of such appli). These 3 parameters are maintained for upwards compatibility but should no more be used, since the following three parameters are much easier to use: the name of an appearing/disapearing or subscribing/unsubscribing appli, its status either "new" or "died" or "subscribing" or "unsubscribing", and the hostname where this appli is running/dying OR the subscribed / unsubscribed regexp. Your callback could be: sub MyCallback { my ($ref_array_present, $ref_array_absent, $ref_hash_present, - $appname, $status, $host) = @_; + $appname, $status, $host_or_regexp) = @_; # $status is either new or died @@ -1808,10 +1868,16 @@ Your callback could be: } } if ($status eq "new") { - print "$appname connected from $host\n"; + print "$appname connected from $host_or_regexp\n"; } elsif ($status eq "died") { - print "$appname disconnected from $host\n"; + print "$appname disconnected from $host_or_regexp\n"; + } + elsif ($status eq "subscribing") { + print "$appname subscribes to $host_or_regexp\n"; + } + elsif ($status eq "unsubscribing") { + print "$appname unsubscribed to $host_or_regexp\n"; } } @@ -1821,7 +1887,7 @@ Example: Ivy->new(-ivyBus => '156,157:2204', -onDieFunc => [\&restorecontext], -neededApp => ["DataServer", "HMI"], - -statusFunc => \&startwhenpresents); + -statusFunc => \&MyCallback); =back @@ -2003,6 +2069,8 @@ Destroy the $ivyobj object. No other method should be applied to the reference o The stop method does not work! +In the statusFunc, an agent is identified by its name which is not garantted as unique + No other known bugs at this time. If you find one, please report them to the authors. =head1 SEE ALSO @@ -2012,11 +2080,11 @@ perl(1), perlre(1), ivyprobe.pl(1) =head1 AUTHORS Alexandre Bustico <bustico@cena.fr>, Herve Damiano <damiano@cena.fr>, -Stephane Chatty <chatty@cena.fr>, Christophe Mertz <mertz@@cena.fr> +Stephane Chatty <chatty@cena.fr>, Christophe Mertz <mertz@cena.fr> =head1 COPYRIGHT -CENA (C) 1997-2001 +CENA (C) 1997-2002 =head1 HISTORY diff --git a/debian/changelog b/debian/changelog index e14c0aa..4713347 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,16 @@ +ivy-perl (4.10) unstable; urgency=low + + * ivy-perl does no more allow subscription to illformed regular expressions + as for example 'zaza (' or '*' + * ivy-perl is now tolerant to illformed regular expressions subscribed + by other agent on the bus + * with the statusfunc, it is now possible to know every regexp + subscribed / unsubscribed by other agents + * the ivyprobe.pl application now displays all subscriptions / + unsubscriptions. It also allows unsubscription + + -- Christophe MERTZ <mertz@tls.cena.fr> Thu, 25 Apr 2002 15:33:34 +0200 + ivy-perl (4.9) unstable; urgency=low * correction par hervé d'un bug provoquant des "Segmentation fault" diff --git a/debian/rules b/debian/rules index 9314e97..4234a7a 100755 --- a/debian/rules +++ b/debian/rules @@ -14,12 +14,8 @@ archlib = `$(PERL) -MConfig -e 'print $$Config{installarchlib}'` build: $(checkdir) -# perl Makefile.PL INSTALLDIRS=vendor $(PERL) Makefile.PL INSTALLDIRS=vendor FULLPERL="PERL_DL_NONLAZY=0 /usr/bin/perl" $(MAKE) -# $(MAKE) OPTIMIZE="-O2 -g -Wall" -# perl Makefile.PL $(config) -# $(MAKE) $(MAKE) test touch build |