Initial revision

3 files changed, 2650 insertions, 0 deletions

diff --git a/src/Ivy2.pm b/src/Ivy2.pm
new file mode 100644
index 0000000..ebcb4ba
--- /dev/null
+++ b/src/Ivy2.pm
@@ -0,0 +1,1845 @@
+#
+#	Ivy, Perl interface 
+# 
+#	Copyright 1997-2000
+#	Centre d'Études de la Navigation Aérienne
+#
+#	Authors: Alexandre Bustico <bustico@tls.cena.fr>
+#		 Stéphane Chatty <chatty@tls.cena.fr>
+#                Hervé Damiano <damiano@tls.cena.fr>
+#
+#	All functions
+#
+#	$Id$
+#
+#      Please refer to the debian/copyright file for the
+#      copyright notice regarding this software
+#
+
+package Ivy2 ;
+
+use Sys::Hostname;
+use IO::Socket;
+use strict ;
+use Time::Gettimeofday ;
+
+
+use vars qw($VERSION);
+$VERSION = '4.3';
+
+#############################################################################
+####                    PROTOTYPES                                      #####
+#############################################################################
+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.
+
+
+sub new ($%);           # verifie la validite de tous les parametres,
+			# cree et retourne un objet Ivy. Les parametres
+			# appName, networks, messWhenReady, peuvent
+			# etre donnes, meme si ils ont deja ete
+			# donnes dans init, dans ce cas, ce sont ceux
+			# de new qui prevalent
+
+sub start ($);		# debut de l'integration au bus :
+		 	# - cree la socket d'application, recupere le no 
+			#   de port
+		 	# - cree la socket supervision
+		 	# - envoie le "no de port"
+		 	# - bind le file descriptor de la socket de 
+			#   supervision a la fonction getBonjour pour 
+			#   traiter les bonjours
+		 	# - bind le fd de connection sur la fonction 
+			#   getConnections
+			#   pour etablir les connections "application"
+	   
+sub DESTROY ($);		# - envoie un BYE et clot les connections
+
+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
+			# avec une fonction de callBack, ou de l'annuler
+ 
+sub sendMsgs ($@) ;	# envoie une liste de messages
+sub sendAppNameMsgs ($@) ;	# envoie une liste de messages precedes
+				# du nom de l'application
+sub sendDirectMsgs ($$$@); # envoie une liste de messages directs a une appli
+sub sendDieTo ($$);	 # envoie un <<kill>>  a une appli
+sub ping ($$$);		  # teste qu'une appli soit encore vivante
+sub mainLoop ();        # la mainloop locale (sans tk)
+sub stop ();		# methode de classe : on delete les bus, mais 
+			# on reste dans la mainloop
+sub exit ();		# methode de classe : on delete tous les
+			# bus (donc on ferme proprement toutes les
+			# connexions).
+			# Si on est en mainloop locale  on sort de la 
+			# mainloop, le code qui suit l'appel mainLoop 
+			# sera execute.
+			# par contre si on est en mainloop Tk,
+			# il faut en plus detruire la mainwindow
+			# pour sortir de la mainloop;
+sub after ($$;$);		# temps en millisecondes, callback
+sub repeat ($$;$);	# temps en millisecondes, callback
+sub afterCancel ($;$); # l'id d'un cancel ou d'un repeat
+sub fileEvent ($$;$); # associe un fd a un callback pour la mainloop locale
+
+
+################ PRIVEE ####################################################
+sub _getBonjour ($); # lit le (ou les) bonjour(s) sur le canal de supervision
+		# et se connecte, verifie qu'il ne se reponds pas lui
+		# meme, ni qu'il ne repond pas a un service deja connecte
+
+sub _getConnections ($); # est appele lors d'une demande de connection :
+		    # accepte la connection et mets a jour  @sendRegList
+		    # rajoute le fd du canal aux fd a scruter dans la
+		    # boucle d'evenements
+
+sub _getMessages ($$);   # est appele lorqu'un message arrive
+
+sub _sendWantedRegexp ($$); # envoie les regexp  a l'appli distante
+
+sub _sendLastRegexpToAllreadyConnected ($$) ; # envoie la derniere regexp
+					    # pushee dans @recCbList
+					    # a toutes les applis deja 
+					    # connectees
+sub _removeFileDescriptor ($$);    # on vire un fd et les structures associees
+sub _sendErrorTo ($$$); #(fd, error) envoie un message d'erreur a un fd
+sub _sendDieTo ($$); #(fd) envoie un message de demande de suicide a un fd
+sub _sendMsgTo ($$$);  # (fd, message)
+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 
+		     # appelle la fonction $statusFunc 
+sub _inetAdrByName ($$); # transforme une adresse inet native en chaine 
+			 # $host:$port
+sub _toBePruned ($$$);
+sub _parseIvyBusParam ($); # prends une adresse de bus de la forme
+			   # 143.196.53,DGAC-CENATLS:2010 et
+			   # renvoie une liste de deux elements :
+		           # un numero de port et une ref sur une 
+			   # liste d'adresses addr_inet
+
+sub _substituteEscapedChar ($$); #permet de transormer une regexp etendue 
+				# 'perl' en regexp de base
+
+#############################################################################
+####                    CONSTANTES                                      #####
+#############################################################################
+use constant MSG_FMT => "%d %d\002%s\n";
+
+# par defaut, on diffuse le bonjour en local
+use constant BROADCAST_ADDRS => "127.255.255.255" ;
+use constant BROADCAST_PORT => "2010";
+
+use constant BYE	 => 0;
+use constant REGEXP	 => 1;
+use constant MSG	 => 2;
+use constant ERROR	 => 3;
+use constant DELREGEXP	 => 4;
+use constant ENDREGEXP	 => 5;
+use constant APP_NAME    => 6;
+use constant DIRECT_MSG	 => 7;
+use constant DIE	 => 8;
+use constant PING	 => 9;
+use constant PONG	 => 10;
+use constant IVY_PROTOCOLE_VERSION => 3;
+
+use constant AFTER	=> 0;
+use constant REPEAT	=> 1;
+use constant MAX_TIMOUT => 1000;
+
+# pour pouvoir employer les regexps perl. Attention lors de l'utilisation
+# ne pas mettre un \n dans une chaine entre "" car l'\n sera interprete.
+use constant REG_PERLISSISME => ('w' => '[a-zA-Z0-9_]',
+				 'W' => '[^a-zA-Z0-9_]',
+				 's' => '[		]',
+				 'S' => '[^		]',
+				 'd' => '[0-9]',     
+				 'D' => '[^0-9]',
+				 'n' => '', # Il ne faut pas mettre d'\n : 
+				            # c'est un delimiteur pour le bus
+				 'e' => '[]') ;
+
+#############################################################################
+####                    VARIABLES de CLASSE                             #####
+#############################################################################
+
+
+# optimisation : si l'on connait les sujets des messages
+# qu'on envoie, cette variable contient une liste de
+# sujets qui doivent matcher les regexps d'abonnement
+# pour que celle ci se soient pas eliminees
+my @topicRegexps;
+
+# les adresses de reseau sur lesquelles ont broadcaste
+# suivies du No de port :
+# exemples :	"143.196.1.255,143.196.2.255:2010"
+#		"DGAC-CENATLS-PII:DGAC-CENATLS:2010"
+#		":2010" <= dans ce cas c'est la valeur
+# de reseau de broadcast par defaut qui est prise : 127.255.255.255
+# c.a.d local a la machine
+my $ivyBus ;
+
+# le nom de l'appli pour le bus
+my $appName ;
+
+# message a envoyer a un canal lorsqu'on
+# a recu le message endregexp.
+my $messWhenReady ;
+
+# fonction de cb appelee lorsque l'appli a recu l'ordre
+# de quitter, on peut dans ce callback fermer
+# proprement les ressources avant de sortir.
+# ps : ne pas fasire d'exit dans le callback,
+# c'est le bus qui s'en charge
+my $onDieFunc;
+
+
+# permet de donner des valeurs successives aux constantes permettant
+# d'acceder aux differents champs de l'objet
+my $constantIndexer =0;
+
+# pointeur sur la fonction permettant d'associer
+# des callbacks a un file desc, (ainsi que de les enlever)
+my $fileEventFunc;      
+
+# dans le cas ou l'on soit dans une mainLoop
+# locale, cette var pointe une un objet
+# de type IO::Select;
+my $localLoopSel;      
+
+# table d'ass. handle -> callback
+my %localBindByHandle;  
+
+# tableau d'ass [AFTER ou REPEAT, 
+#   timeTotal, deadLine, [callback, arg, arg, ...]]
+my %afterList=();       
+
+my $afterId = 0;	
+
+# timeout le plus petit pour le select
+my $selectTimout = MAX_TIMOUT;  
+
+
+# liste des bus actifs
+my %allBuses = ();
+
+
+#############################################################################
+####                    CLEFS DES VARIABLES D'INSTANCE                  #####
+####									#####
+#### l'objet Ivy sera 'blessed' sur une reference sur un array et non	#####
+#### sur une table de hash comme pratique courament de facon a		#####
+#### 1/ optimiser au niveau vitesse					#####
+#### 2/ avoir des clefs sous forme de symboles (use constant...)	#####
+####	et nom des clefs sous forme de chaines de caracteres		#####
+####	de facon a eviter des erreurs					#####
+####									#####
+####									#####
+#############################################################################
+use constant servPort		=> $constantIndexer++;		
+use constant neededApp 		=> $constantIndexer++;		
+use constant statusFunc 	=> $constantIndexer++;		
+use constant supSock  		=> $constantIndexer++;		
+use constant connSock 		=> $constantIndexer++;		
+use constant sockList  		=> $constantIndexer++;	
+use constant queueList  	=> $constantIndexer++;	
+use constant threadList  	=> $constantIndexer++;	
+use constant appliList  	=> $constantIndexer++;   
+use constant sendRegList  	=> $constantIndexer++;	
+use constant topicRegexps  	=> $constantIndexer++;  
+use constant recCbList  	=> $constantIndexer++;	
+use constant directCbList 	=> $constantIndexer++;  
+use constant cnnxion   		=> $constantIndexer++;	
+use constant buffByConn   	=> $constantIndexer++;
+use constant broadcastPort  	=> $constantIndexer++;  
+use constant broadcastBuses	=> $constantIndexer++; 
+use constant appName		=> $constantIndexer++; 
+use constant messWhenReady 	=> $constantIndexer++; 
+
+#############################################################################
+####                    METHODES        PUBLIQUES                     #####
+#############################################################################
+sub init ($%) 
+{
+  my ($class, %options) = @_;  
+
+  # valeurs par defaut pour le parametre : variable d'environnement
+  # ou valeur cablee, a defaut
+  my $default_ivyBus = defined $ENV{"IVYBUS"} ? $ENV{"IVYBUS"} : "";
+
+  my %defaultOptions = ( #PARAMETRES OBLIGATOIRES
+			-loopMode         => undef, 
+			# TK ou LOCAL
+			
+			-appName	  => undef, 
+			# nom de l'appli
+			
+			# PARAMETRES FACULTATIFS (avec valeurs par defaut)
+			
+			# les adresses de reseau sur lesquelles ont broadcaste
+			# suivies du No de port :
+			# exemples :	"143.196.1.255,143.196.2.255:2010"
+			#		"DGAC-CENATLS-PII:DGAC-CENATLS:2010"
+			#		":2010" <= dans ce cas c'est la valeur
+			# de reseau de broadcast par defaut qui est prise : 
+			# 127.255.255.255  c.a.d local a la machine
+			-ivyBus		=> $default_ivyBus,
+
+			-messWhenReady    => "_APP NAME READY",
+			# message de synchro a envoyer quand pret
+			
+			-onDieFunc	=> [sub {}],
+			# fonction de cb appelee lorsque l'appli a recu l'ordre
+			# de quitter, on peut dans ce callback fermer
+			# proprement les ressources avant de sortir.
+			# ps : ne pas fasire d'exit dans le callback,
+			# c'est le bus qui s'en charge
+
+			-pruneRegexp => [],
+		     # optimisation : si l'on connait les sujets des messages
+		     # qu'on envoie, on fournit la liste des sujets
+		     # et les regexps qui ne matchent pas
+		     # ces sujets sont eliminees. 
+		       ) ;
+  
+  
+  foreach my $opt  (keys %defaultOptions) {
+    # si un parametre n'a pas ete defini
+    next if defined $options{$opt} ;
+    # est-il facultatif
+    if (defined $defaultOptions{$opt}) {
+      $options{$opt} = $defaultOptions{$opt} ;
+    }
+    else {
+      # parametre obligatoire
+      die "ERREUR Ivy::init vous devez specifier ".
+	"l'option $opt\n";
+    }
+  }
+  
+  foreach my $opt  (keys %options) {
+    die "ERREUR Ivy::init option $opt inconnue\n" unless
+      exists ($defaultOptions{$opt});
+  }
+  
+  my $loopMode =	$options{-loopMode};
+  $ivyBus =		$options{-ivyBus} ne "" ? $options{-ivyBus} : undef;
+  $appName =		$options{-appName} ;
+  $messWhenReady =       
+    $options{-messWhenReady} eq "_APP NAME READY" ?
+      "$appName READY" : $options{-messWhenReady};
+
+  $onDieFunc =	   $options{-onDieFunc} ;
+  @topicRegexps = @{$options{-pruneRegexp}};
+
+  if ($loopMode =~ /local/i) {
+    # mode boucle d'evenement locale
+    use IO::Select;
+    $fileEventFunc = \&fileEvent ;
+    $localLoopSel = IO::Select->new ();
+  } elsif ($loopMode =~ /tk/i) {
+    # mode boucle d'evenement de TK
+    $fileEventFunc = \&_tkFileEvent ;
+  } else {
+    die "l'argument \"mainloop mode\" doit etre TK ou LOCAL\n";
+  }
+
+ $SIG{'PIPE'}	= 'IGNORE' ;  
+}
+
+############# METHODE DE CLASSE NEW
+sub new ($%) 
+{
+  my ($class, %options) = @_;  
+  my $self = [];
+  $#{$self} = $constantIndexer; # on predimensionne le tableau
+  bless ($self, $class);
+
+  # on verifie que la methode de classe init ait ete appelee 
+  unless ((defined $appName) && ($appName ne '')) {
+    die  "ERREUR Ivy::new vous devez initialiser le module via Ivy->init ()";
+  }
+
+  # No de port tcp du serveur
+  $self->[servPort] = '';
+
+  # liste des applis necessaires a l'appli locale
+  $self->[neededApp] = [];
+
+  # callback prenant en param 2 refs sur des listes :
+  # [applis presentes, appli absentes]
+  # cette fonction est appelee :
+  # - tout les pollingTime tant que toutes les applis
+  #   ne sont pas presentes
+  # - des que toutes les applis sont presentes
+  # - lorsqu'une appli se deconnecte
+  $self->[statusFunc] = '';
+
+  # callback prenant en param 1 refs sur une liste :
+  #  [ref sur fonction, parametres]
+
+  # socket de supervision en lecture/ecriture
+  $self->[supSock] = '';
+
+  # socket de connexion tcp
+  $self->[connSock] = '';
+
+  # tab ass : nom du fd => fd
+  $self->[sockList] = {};
+
+  # tab ass : nom de l'appli => fd
+  $self->[appliList] = {};
+
+  # tableau ass de liste  du type
+  # sockId => [fonction, fonction, ...]
+  # pour savoir quoi envoyer a qui
+  # les fonctions anonymes sont compilees 
+  # dynamiquement a la reception des messages REGEXP
+  # et filtrent les mess a envoyer et les envoient
+  # au besoin
+  $self->[sendRegList] = {};
+
+  # liste des topics qu'on envoie si on 
+  # filtre les regexps
+  $self->[topicRegexps] = [];
+
+  # liste de ref sur des couples 
+  # (regexp,callBack) les callbacks
+  # sont appeles lors de
+  # la reception de messages en fonction
+  # du numero de regexp.
+  $self->[recCbList] = [];
+
+  # liste de callBack pour les messages directs
+  $self->[directCbList] = [];
+
+  # tableau ass : clef = nom:numero_de port
+  # permet de verifier qu'on ne se connecte pas
+  # sur nous meme et qu'on ne se reconnecte
+  # pas sur un service en cas de bonjours repetes
+  # valeur : nom de l'application
+  $self->[cnnxion] = {};
+
+  # tableau associatif, clef => file desc,
+  # valeur :buffer au cas ou la lacture ne se termine
+  # pas par \n, de maniere a resegmenter les messages
+  $self->[buffByConn] = {};
+
+  
+  my %defaultOptions = ( 
+			-appName	  =>  $appName,
+			# nom de l'appli
+			
+			# PARAMETRES FACULTATIFS (avec valeurs par defaut)
+			-messWhenReady    => $messWhenReady,
+			# message de synchro a envoyer quand pret
+			
+
+			# PARAMETRES FACULTATIFS (avec valeurs par defaut)
+			
+			# les adresses de reseau sur lesquelles ont broadcaste
+			# suivies du No de port :
+			# exemples :	"143.196.1.255,143.196.2.255:2010"
+			#		"DGAC-CENATLS-PII:DGAC-CENATLS:2010"
+			#		":2010" <= dans ce cas c'est la valeur
+			# de reseau de broadcast par defaut qui est prise : 
+			# 127.255.255.255  c.a.d local a la machine
+			-ivyBus		=> $ivyBus,
+			
+			-neededApp	  => [],
+			# liste des appplis necessaires
+			
+			-statusFunc	 => sub {},
+			# fonction de callBack qui sera appelee tant que
+			# 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 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 !!
+
+			-pruneRegexp => [@topicRegexps],
+		     # optimisation : si l'on connait les sujets des messages
+		     # qu'on envoie, on fournit la liste des sujets
+		     # et les regexps qui ne matchent pas
+		     # ces sujets sont eliminees. 
+		       ) ;
+  
+  
+  foreach my $opt  (keys %defaultOptions) {
+    # si un parametre n'a pas ete defini
+    next if defined $options{$opt} ;
+    # est-il facultatif
+    if (defined $defaultOptions{$opt}) {
+      $options{$opt} = $defaultOptions{$opt} ;
+    } else {
+      # parametre obligatoire
+      die "ERREUR Ivy::new vous devez specifier ".
+	"l'option $opt\n";
+    }
+  }
+  
+  foreach my $opt  (keys %options) {
+    die "ERREUR Ivy::start option $opt inconnue\n" unless
+      exists ($defaultOptions{$opt});
+  }
+  
+
+
+  $self->[appName] =    $options{-appName} ;
+  $self->[messWhenReady] =    $options{-messWhenReady} ;
+  @{$self->[neededApp]} =           @{$options{-neededApp}} ;
+  $self->[statusFunc] =          $options{-statusFunc} ;
+  $self->[topicRegexps] = $options{-pruneRegexp} ;
+  $allBuses{$self}  = $self;
+
+  ($self->[broadcastPort], $self->[broadcastBuses]) = 
+    _parseIvyBusParam ($options{-ivyBus});
+
+  
+  return ($self);
+}
+
+############### METHODE	IVY DESTROY
+sub DESTROY ($)
+{
+  my $self = shift;
+  return unless exists $allBuses{$self};
+
+  # print ("DBG DESTROY appele sur l'objet $self\n");
+
+  # pour toutes les connections
+  foreach my $fd (values %{$self->[sockList]}) {
+    next unless exists ($self->[queueList]->{$fd});
+
+    foreach my $fd (values %{$self->[sockList]}) {
+      send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0) 
+	or $self->_removeFileDescriptor ($fd);
+    }
+  }
+
+  #  on clos la socket de signalisation (UDP)
+  # print "DBG> fermeture de supSock\n";
+  $self->[supSock]->close() if $self->[supSock];
+  delete $allBuses{$self};
+
+  # on clos la socket de connection 
+  # print "DBG> fermeture de connSock\n";
+  $self->[connSock]->close() if  $self->[connSock];
+  undef (@$self);
+}
+
+############### METHODE DE CLASSE STOP
+sub stop ()
+{
+  foreach my $bus (values %allBuses) {
+    $bus->DESTROY();
+  }  # pour toutes les connections
+}
+
+
+############## METHODE DE CLASSE EXIT
+sub exit () 
+{
+  Ivy::stop ();
+  if (defined $localLoopSel) {
+    # boucle locale, on sait faire
+    # printf ("DBG> undefining localLoopSel\n");
+    undef  $localLoopSel;
+  }
+  else {
+    Tk::exit ();
+  }
+}
+
+############### PROCEDURE	BUS START
+sub start ($) 
+{
+  my $self = shift;
+
+    # cree la socket de connexion, recupere le no de port
+    my $connSock = $self->[connSock] = IO::Socket::INET->new(Listen => 128,
+							     Proto    => 'tcp',
+							     Reuse   => 1) ;
+    # on memorise tout ca, ce qui evitera par la suite de se
+    # repondre a soi-meme. On le fait sous nos deux noms :
+    # le nom de machine et 'localhost'
+    my $hostAddr = (gethostbyname (hostname()))[4] ;
+    my $localhostAddr = (gethostbyname ('localhost'))[4] ;
+    $self->[cnnxion]->{"$hostAddr:". $connSock->sockport} = "\004";
+    $self->[cnnxion]->{"$localhostAddr:". $connSock->sockport} = "\004";
+    
+    # cree la socket de broadcast
+    $self->[supSock] = IO::Socket::INET->new
+      (LocalPort  => $self->[broadcastPort],
+       Proto      => 'udp',
+       Type       => SOCK_DGRAM,
+       Reuse      => 1);
+    
+    $self->[supSock]->sockopt (SO_BROADCAST, 1);
+
+    
+    # et on envoie envoie le bonjour : "no de version no de port"
+    my $bonjourMsg = sprintf ("%d %d\n", IVY_PROTOCOLE_VERSION, $connSock->sockport());
+    
+    foreach my $netBroadcastAddr (@{$self->[broadcastBuses]}) {
+	send ($self->[supSock], $bonjourMsg, 0, $netBroadcastAddr) or 
+	    warn "Ivy::start envoi du bonjour a echoue sur : $!\n";
+    }    
+    # callback pour traiter la reception des bonjours
+    &$fileEventFunc ($self->[supSock], [\&_getBonjour, $self]) ;
+    
+    # callback pour traiter les demandes de cxion
+    &$fileEventFunc ($self->[connSock], [\&_getConnections, $self]) ;
+}
+
+	   
+############### PROCEDURE	BIND REGEXP	   
+sub bindRegexp ($$$) {
+  my ($self, $regexp, $cb) = @_;
+
+  # 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.
+  $regexp =~ s|
+    (
+     (?<!\\) \[	# le premier crochet ouvrant non precede d'un \ 
+     .*? 		# ce qu'il y a dans le crochet, en mode frugal
+     (?<!\\) \]	# le premier crochet fermant non precede d'un \ 
+    )
+      |
+	_substituteEscapedChar ('inside', $1)
+	  |xge;
+  
+  $regexp = _substituteEscapedChar ('outside', $regexp);
+  # print ("DBG regexp = $regexp\n");
+  
+  if ($cb) {
+    my $id;
+    # on rajoute le couple $regexp, $cb dans la liste des messages
+    # qu'on prend
+    
+    # on commence par tester si on a un id libere dans le tableau
+    for ($id=0; $id <= ($#{$self->[recCbList]}+1); $id++)  {
+      last unless  (defined $self->[recCbList][$id]) && @{$self->[recCbList][$id]->[1]};
+    }
+    $self->[recCbList][$id] =  [$regexp, $cb];
+
+    # on envoie les messages regexps aux processus deja connectes
+    _sendLastRegexpToAllreadyConnected ($self, $id) ;
+  }
+  else {
+    
+    # on vire le callback, et on se desabonne de cette regexp
+    for (my $id=0; $id <= $#{$self->[recCbList]}; $id++)  {
+      
+      next unless (defined $self->[recCbList][$id]) &&
+	@{$self->[recCbList][$id]->[1]};
+      
+      if ($self->[recCbList][$id]->[0] eq $regexp) {
+	
+	$self->[recCbList][$id]->[1] = [];
+	# on envoie le mesage delregexp
+	foreach my $fd (values %{$self->[sockList]}) {
+	  send ($fd, sprintf (MSG_FMT, DELREGEXP, $id), 0)
+	    or $self->_removeFileDescriptor ($fd); 
+	}
+      }
+    }
+  }
+}
+
+############### METHODE	BIND REGEXP	   
+sub bindDirect ($$$)	   
+{
+  my ($self, $id, $cb) = @_;
+  
+  if ($cb) {
+    # on rajoute la $cb dans la liste des messages
+    # qu'on prend
+    $self->[directCbList][$id] =  $cb;
+  } else {
+    # on vire le callback
+    undef $self->[directCbList][$id];
+  }
+}
+	   
+############### PROCEDURE	SEND MSGS	    
+sub sendMsgs ($@)
+{
+  use attrs qw(locked);
+
+  my ($self, @msgs) = @_;
+  my $total = 0;
+
+  # pour tous les messages
+  foreach my $msg (@msgs) {
+    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}}) {
+	$total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
+      }
+    }
+  }
+  #    print "DBG> sended $total times\n";
+  return $total;
+}
+
+############### PROCEDURE	SEND MSGS	    
+sub sendAppNameMsgs ($@)
+{
+  use attrs qw(locked);
+
+  my ($self, @msgs) = @_;
+  my $total = 0;
+
+  # pour tous les messages
+  foreach (@msgs) {
+    my $msg = "$self->[appName] $_";
+    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}}) {
+	$total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
+      }
+    }
+  }
+  #    print "DBG> sended $total times\n";
+  return $total;
+}
+
+
+
+############### PROCEDURE	SEND DIRECT MSGS	    
+sub sendDirectMsgs ($$$@)
+{
+  my ($self, $to, $id, @msgs) = @_;
+    
+  if (defined ($self->[appliList]{$to})) {
+    my @fds = @{$self->[appliList]{$to}};
+    # pour tous les messages
+    foreach my $msg (@msgs) {
+      foreach my $fd (@fds) {
+	send ($fd, sprintf (MSG_FMT, DIRECT_MSG, $id, "$msg"), 0)
+	  or $self->_removeFileDescriptor ($fd); 
+      }
+    }
+    return 1;
+  } else {
+    warn "Ivy::sendDirectMsgs appli $to inconnue\n";
+    return 0;
+  }
+}
+
+
+############### METHOD	SEND DIE TO	    
+sub sendDieTo ($$)
+{
+  use attrs qw(locked);
+  my ($self, $to) = @_;
+    
+  if (defined ($self->[appliList]{$to})) {
+    my @fds = @{$self->[appliList]{$to}};
+
+    warn "Attention : Ivy::sendDieTo gros BUG \@fds est vide \n" 
+      if (scalar (@fds) == 0);
+
+    # pour tous les messages
+    foreach my $fd (@fds) {
+      $self->_sendDieTo($fd);
+    }
+    return 1;
+  }
+  else {
+    warn "Ivy::sendDieTo appli $to inconnue\n" if $^W;
+    return 0;
+  }
+}
+
+
+############### METHOD	PING    
+sub ping ($$$)
+{
+  use attrs qw(locked);
+
+  my ($self, $to, $timeout) = @_;
+    
+  if (defined ($self->[appliList]{$to})) {
+
+    my @fds = @{$self->[appliList]{$to}};
+
+    # pour tous les messages
+    foreach my $fd (@fds) {
+      send ($fd, sprintf (MSG_FMT, PING, 0, " "), 0)
+	or $self->_removeFileDescriptor ($fd); 
+    }
+  }
+}
+
+###############   METHODE     MAINLOOP
+sub mainLoop ()
+{
+  die "Erreur Ivy->mainLoop, Ivy doit etre initialise en mode".
+    " loopMode local\n"   unless defined  $localLoopSel;
+
+  my ($fd, @ready, @allDesc);
+  
+  while (defined  $localLoopSel) {
+    @ready = IO::Select::can_read ($localLoopSel, $selectTimout) ;
+    _scanAfter () ;
+
+    foreach my $fd (@ready) {
+      if (ref $localBindByHandle{$fd} eq 'CODE') {
+	&{$localBindByHandle{$fd}} ;
+      }
+      else {
+	my ($cb, @arg) = @{$localBindByHandle{$fd}} ;
+	&$cb (@arg)
+      }
+    }
+  }
+}
+ 
+
+############### METHODE	AFTER	
+sub after ($$;$)
+{
+  # test du premier argument au cas ou la fonction soit
+  # appelee de maniere objet : premier argument = class ou une instance
+  # de classe
+  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
+
+  my ($timeAfter,  $cbListRef) = @_;   
+  $timeAfter /= 1000;
+  $selectTimout = $timeAfter if $timeAfter < $selectTimout;
+
+  # si la valeur de timout est negative : c'est un after sinon
+  # c'est un repeat
+  $afterList{++$afterId} = [AFTER, $timeAfter, 
+			    timeofday()+$timeAfter, $cbListRef];
+
+  return ($afterId);
+}
+
+############### METHODE	REPEAT
+sub repeat ($$;$)
+{
+  # test du premier argument au cas ou la fonction soit
+  # appelee de maniere objet : premier argument = class ou une instance
+  # de classe
+
+  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
+  # on passe le temps en secondes pour le select
+  my ($timeAfter,  $cbListRef) = @_;
+  $timeAfter /= 1000;
+  $selectTimout = $timeAfter if $timeAfter < $selectTimout;
+
+  $afterList{++$afterId}= [REPEAT, $timeAfter, timeofday()+$timeAfter, 
+			   $cbListRef];
+  return ($afterId);
+}
+
+############### METHODE	AFTER CANCEL	
+sub afterCancel ($;$)
+{
+  # test du premier argument au cas ou la fonction soit
+  # appelee de maniere objet : premier argument = class ou une instance
+  # de classe
+  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
+  
+  my $id = shift;
+    
+  if (defined ($id) && defined $afterList{$id}) {
+    if ($afterList{$id}->[1] <= $selectTimout) {
+      delete $afterList{$id} ;
+      # le timout de l'after/repeat etait le plus petit des timout
+      # on cherche donc le plus petit parmi ceux qui restent;
+      $selectTimout = MAX_TIMOUT;
+      foreach my $af (values %afterList) {
+	$selectTimout = $af->[1] if $af->[1] < $selectTimout ;
+      }
+    }
+    else {
+      delete $afterList{$id} ;
+    }
+  }
+}
+
+############### METHODE	FILE EVENT 	
+sub fileEvent ($$;$)
+{
+  # test du premier argument au cas ou la fonction soit
+  # appelee de maniere objet : premier argument = class ou une instance
+  # de classe
+  shift if ((ref ($_[0]) eq 'Ivy') || ($_[0] eq 'Ivy')) ;
+  
+  my ($fd, $cb) = @_;
+  
+  
+  unless (defined $localLoopSel) {
+    die ("Erreur Ivy::fileEvent : Ivy::fileEvent n'est utilisable qu'en ".
+	 "mode mainLoop	LOCALE\n");
+  } 
+
+  if ($cb) {
+    # adding the handler
+    $localBindByHandle{$fd} = $cb;
+    $localLoopSel->add ($fd);
+  } else  {
+    # deleting the handler
+    delete $localBindByHandle{$fd};
+    # print ("DBG: Ivy::fileEvent : removing fd from the select\n");
+    $localLoopSel->remove ($fd);
+  }
+}
+
+#############################################################################
+####                     METHODES       PRIVEES                       #####
+#############################################################################
+
+
+############### METHODE	GET BONJOUR 	
+sub _getBonjour ($)
+{
+  my $self = shift;
+
+  my $bonjourMsg = '';
+
+  # l'hote distant
+  my $inetAddr = $self->[supSock]->recv ($bonjourMsg, 1024, 0);
+
+  unless (length $inetAddr) {
+    warn "Attention : Ivy::_getBonjour recv error, bonjour non traite\n";
+    return;
+  }
+  
+  my $addr = (unpack_sockaddr_in ($inetAddr))[1];
+  
+  my $peerName = gethostbyaddr ($addr, AF_INET);
+  print "peerName=$peerName\n";
+  # on force $peerPort a etre vu comme une valeur numerique
+  my ($version, $peerPort) = $bonjourMsg =~ /^(\d+)\s+(\d+)/;
+
+  unless (defined ($version) && defined ($peerPort)) {
+    warn "Attention : Ivy::_getBonjour  format du message bonjour incorrect\n".
+      "message = $bonjourMsg\n" ;
+    return;
+  }
+
+  if ($version != IVY_PROTOCOLE_VERSION) {
+    warn "Attention : Ivy::_getBonjour VERSION: demande de connexion de ".
+      "$peerName\n version courrante : " . IVY_PROTOCOLE_VERSION . ", recue : $version\n" ;
+    return;
+  }
+    
+  # on verifie qu'on ne se repond pas et qu'on ne
+  # se reconnecte pas a un process deja connecte
+  if (exists ($self->[cnnxion]{"$addr:$peerPort"})) {
+    #print "DBG> : bonjour de $peerName:$peerPort : DEJA CONNECTE\n" ;
+    return ;
+  }
+  else {
+    #print "DBG> : reception de $peerName : bonjour $peerPort\n" ;
+  }
+   
+# on verifie que l'adresse fasse partie de l'ensemble de reseau
+  # definis par ivybus
+  my $addrInIvyBus = 0;
+  my @ivyBusAddrList = map ( (unpack_sockaddr_in ($_))[1], 
+				@{$self->[broadcastBuses]});
+  # Bon dans cette version on reponds aux bonjour emis par 
+  # la machine locale, on ne peut donc pas avoir
+  # une appli qui ne causerait qu'a des machines sur une
+  # autre reseau, si ca embete qqun, qu'il me le dise
+  push (@ivyBusAddrList, pack ("CCCC", 127,255,255,255));
+  push (@ivyBusAddrList, (gethostbyname (hostname()))[4]);
+    foreach my $ivyBusAddr (@ivyBusAddrList) {
+    $addrInIvyBus = 1 unless (grep ($_ != 0, unpack ("CCCC", 
+			      ($addr & $ivyBusAddr) ^ $addr)));
+  }
+
+  if ($addrInIvyBus == 0) {
+    warn "bonjour de $peerName ignore, ne fait pas partie des ivyBus\n" if $^W;
+    return;
+  }
+
+  # ouverture du canal de communication
+  my $appSock = IO::Socket::INET->new (PeerAddr => $peerName,
+				       PeerPort => $peerPort,
+				       Proto    => 'tcp');
+  
+  if ($appSock) {
+    # on cree une entree pour $appSock dans la liste des regexp
+    $self->[cnnxion]{"$addr:$peerPort"} = 1;
+    $self->[sendRegList]{$appSock} = [];
+    $self->[buffByConn]{$appSock} = '';
+    $self->[sockList]{$appSock} = $appSock;
+    &$fileEventFunc ($appSock, [\&_getMessages, $self, $appSock]) ;
+
+    # on balance les regexps qui nous interessent a l'appli distante
+    $self->_sendWantedRegexp ($appSock);
+  }
+  else {
+    warn "Attention Ivy::_getBonjour impossible de se connecter au serveur" .
+      "$peerName:$peerPort\n" ;
+  }
+}
+
+
+############### PROCEDURE	GET CONNECTIONS
+sub _getConnections ($)
+{
+  my $self = shift;
+  print "_getConnections\n";
+  my $appSock = $self->[connSock]->accept();
+
+  unless (defined $appSock) {
+    warn "Attention Ivy::_getConnections, \$appSock not defined\n";
+    return;
+  }
+  else {
+    printf "accepting connection from %s:%d\n", 
+    (gethostbyaddr ($appSock->peeraddr(),AF_INET))[0],
+    $appSock->peerport() if $^W;
+  }
+	
+  # callback pour traiter la reception des messages
+  &$fileEventFunc ($appSock, [\&_getMessages,  $self, $appSock]) ;
+
+  # on cree une entree pour $appSock dans la liste des regexp
+  $self->[sendRegList]{$appSock} = [];
+  $self->[buffByConn]{$appSock} = '';
+  $self->[sockList]{$appSock} = $appSock;
+  # on balance les regexps qui nous interessent a l'appli distante
+  $self->_sendWantedRegexp ($appSock);
+}
+
+
+############### METHODE	GET MESSAGES
+sub _getMessages ($$)
+{
+    my ($self, $appSock) = @_;
+    my $mess;
+    my $buffer = '';
+    my ($addr, $peerPort, $senderName);
+
+    # on recupere le message
+    recv ($appSock, $buffer, 65536, 0) ;
+    unless (length $buffer) {
+      # message null : broken pipe, ça s'est deconnecte a l'autre bout
+      # on vire ce fd de la boucle d'evenements
+      # print ("DBG : _getMessages, recv err, calling removeFileDesc.\n");
+      # Bon la il faudra un jour clarifier ce bordel, lister toutes
+      # les facons dont un couple d'applis connectee peuevent sortir et
+      # eviter les dead lock qui doivent subsister.
+      if (defined ($localLoopSel)) {
+	$self->_removeFileDescriptor ($appSock);
+      }
+      else {
+	$self->_removeFileDescriptor ($appSock);
+      }
+      return;
+    }
+    
+    if (length ($self->[buffByConn]{$appSock})) {
+	$buffer = $self->[buffByConn]{$appSock} . $buffer ;
+	$self->[buffByConn]{$appSock} = '';
+    }
+    my @messages = split ('\n', $buffer) ;
+    $self->[buffByConn]{$appSock} = pop (@messages) unless
+      ($buffer =~ /\n$/) ;
+
+    #     if (defined $appSock->peername) {
+    $addr = $appSock->peeraddr(); 
+    $peerPort = $appSock->peerport() ;
+    $senderName = $self->[cnnxion]{"$addr:$peerPort"} ;
+    $senderName = "NONAME" unless $senderName;
+
+    foreach my $mess (@messages) {
+      #	 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+) 
+	\s+
+	  (\d+)
+	    \002
+	      (.*)/x ;
+	
+	# si ca a chie on rale
+      (warn "Attention Ivy::_getMessages malformated message $mess\n" and return) unless defined $type ;
+      
+      # sinon on fait en fonction du type de message
+      if ($type == MSG) {				       # M S G
+	# on recupere le couple call back, regexp correspondant
+	# a l'identifiant et on appelle la fonction avec les parametres
+	# traites par la regexp
+	if (my @cb = @{$self->[recCbList][$id]->[1]}) {
+	  my $cb = shift @cb;
+	  my $refcb = ref($cb);
+	  if ($refcb ne 'CODE') {
+	    my $method = shift @cb;
+	    # on split sur ETX
+	    $cb->$method($senderName, @cb, split ("\003", $valeurs)) ;
+	  }
+	  else {
+	    &$cb ($senderName, @cb, split ("\003", $valeurs)) ;
+	  }
+	}
+	else {
+	  #_sendErrorTo ($appSock, "REEGXP ID $id inconnue");
+	  warn ("Attention Ivy::_getMessages reception d'un message ".
+		"MSG : id $id inconnu de $senderName :\n«$mess»");
+	}
+      }
+      elsif ($type == BYE) {
+	#print "reception d'un bye\n";
+	$self->_removeFileDescriptor ($appSock);		        # B Y E
+      }
+      elsif ($type == REGEXP) {			        # R E G E X P 
+	# on ajoute une fonction traitant la regexp et envoyant le
+	# message sur le bon fd dans la liste des fonctions de filtrage
+	# ca permet de compiler les regexp avec 'once' donc une
+	# fois pour toute, et ainsi optimiser la vitesse de
+	# filtrage des messages a envoyer
+	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->[sendRegList]{$appSock}->[$id] = eval <<'_EOL_';
+	  sub  {
+	    use strict;
+	    if (my @args = ${$_[0]} =~ /($valeurs)/o) {
+	      shift @args;
+	      $args[$#args] .= "\003" if @args;
+	      send ($appSock, sprintf (MSG_FMT,
+				       MSG, $id, join ("\003",@args)), 0)
+		or $self->_removeFileDescriptor ($appSock) ;
+	      #print join (' ', "DBG > J'envoie MSG", $id, @args, "\n");
+	      return 1;
+	    }
+	  };
+_EOL_
+        } 
+	else {
+	  # l'id de la regexp etait deja utilise, 
+	  # et n'a pas ete libere par un message delregexp,
+	  # on renvoie donc un message d'erreur
+	  $self->_sendErrorTo($appSock, "ID $id deja utilisee");
+	}
+      }
+      elsif ($type == ERROR) {				# E R R O R
+	warn ("Attention Ivy::_getMessages ERREUR recue de ".
+	    "$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 ;
+      }
+      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
+	$self->_sendMsgTo ($appSock, $self->[messWhenReady]);
+
+	# on passe de l'etat Connecte a l'etat Ready
+	$self->[cnnxion]{"$addr:$peerPort"} =~ s/^\004//;
+	$senderName = $self->[cnnxion]{"$addr:$peerPort"};
+
+	unless (exists $self->[appliList]{$senderName}) {
+	  $self->[appliList]{$senderName} = [$appSock];
+	}
+	else {
+	  push @{$self->[appliList]{$senderName}},  $appSock;
+	}
+
+	$self->_scanConnStatus ();
+      }
+      elsif ($type == APP_NAME) {	
+	# etat Connecte
+	if (($self->[appName] eq $valeurs) && $^W) {
+	  warn "\033[1mATTENTION : Ivy::_getMessages une instance de ".
+	    "$self->[appName] existe deja\033[m\n" ;
+	}
+
+	$senderName = $valeurs;
+	$self->[cnnxion]{"$addr:$peerPort"} = "\004$valeurs";	
+      }
+      elsif ($type == DIRECT_MSG) {
+
+	if (defined $self->[directCbList][$id]) {
+	  my @cb = @{$self->[directCbList][$id]};
+	  my $cb = shift @cb;
+	  my $refcb = ref($cb);
+	  if ($refcb ne 'CODE') {
+	    my $method = shift @cb;
+	    $cb->$method(@cb, $valeurs);
+	  }
+	  else {
+	    &$cb (@cb, $valeurs);
+	  }
+	}
+	else {
+	  $self->_sendErrorTo ($appSock, "DIRECT ID $id inconnue");
+	  warn "Attention Ivy::_getMessages reception d'un message ".
+	    "DIRECT d'id $id inconnue de $senderName :\n«$mess»";
+	}
+      } elsif ($type == DIE) {
+	# il faut quitter
+	# on commence par appeler la callback de fin
+	my @cb = @{$onDieFunc};
+	my $cb = shift @cb;
+	my $refcb = ref($cb);
+	if ($refcb ne 'CODE') {
+	  my $method = shift @cb;
+	  $cb->$method(@cb);
+	}
+	else {
+	  &$cb (@cb);
+	}
+	# on avertit les autres qu'on se barre
+	my $adr = $self->_inetAdrByName ($senderName) ;
+	warn "Attention Ivy::_getMessages reception d'un ordre " .
+	  "de suicide de $senderName ($adr) ... exiting\n" if $^W;
+	# adios
+	Ivy::exit ();
+
+      }
+      elsif ($type == PING) {
+	# si on recois un ping, on envoie un pong
+	$self->_pong ($appSock);
+      }
+      elsif ($type == PONG) {
+	return PONG;
+      }
+      else  {
+	_$self->sendErrorTo ($appSock, "TYPE DE MESS $type inconnu");
+	warn ("reception d'un message de type $type inconnu de " . 
+	      "$senderName :\n«$mess»");
+      }
+    } 
+    return 0;
+  }
+
+############### METHODE	SEND WANTED REGEXP	
+sub _sendWantedRegexp ($$)
+{
+  my ($self, $appSock) = @_;
+  
+  # on envoie le message "Nom appli"
+  send ($appSock, sprintf (MSG_FMT, APP_NAME, 0, $self->[appName]), 0)
+    or $self->_removeFileDescriptor ($appSock) ;
+  
+  # on envoie les regexps
+  for (my $id = 0; $id <= $#{$self->[recCbList]}; $id++) {
+    next unless defined $self->[recCbList][$id]->[1]->[0];
+
+    send ($appSock,
+	  sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]),
+	  0) or $self->_removeFileDescriptor ($appSock) ;
+    #	print sprintf ("DBG > %s %d %s\n", 
+    #			 'REGEXP', $id, $self->[recCbList][$id]->[0]);
+  }
+  # on envoie le message de fin d'envoi de regexps
+  send ($appSock, sprintf (MSG_FMT, ENDREGEXP, 0, ""), 0)  
+    or $self->_removeFileDescriptor ($appSock) ;
+}
+
+############### METHODE	SEND LAST REGEXP TO ALLREADY CONNECTED
+sub _sendLastRegexpToAllreadyConnected ($$)
+{
+  my ($self, $id) = @_;
+  
+  foreach my $fd (values %{$self->[sockList]}) {
+    send ($fd, sprintf (MSG_FMT, REGEXP, $id, $self->[recCbList][$id]->[0]), 
+	  0) or $self->_removeFileDescriptor ($fd) ;
+  }
+}
+
+############### METHODE	INET ADR BY NAME
+sub _inetAdrByName ($$) {
+
+  my ($self, $appName) = @_;
+  
+  my $addrInet = (grep ($self->[cnnxion]{$_} eq $appName,
+			keys %{$self->[cnnxion]}))[0];
+  
+  return ("unknow") unless defined $addrInet;
+  my ($addr,$port) = $addrInet =~ /(.{4}):(.*)/;
+  
+  my $host = (gethostbyaddr ($addr, AF_INET))[0] ;
+  return "$host:$port";
+}
+
+
+############### PROCEDURE	REMOVE FILE DESCRIPTOR
+sub _removeFileDescriptor ($$)
+{
+  my ($self, $fd) = @_;
+  
+  my $diedAppName;
+  
+  # on s'est deja occupe de lui
+  return unless exists $self->[sockList]->{$fd};
+  #  printf ("DBG> _removeFileDescriptor IN thread  %s\n", ${Thread->self});
+  
+  # on efface les structures de donnees associees au fd
+  # 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
+  &$fileEventFunc ($fd, '') ;
+  delete $self->[sendRegList]{$fd};
+  delete $self->[sockList]{$fd};
+  delete $self->[buffByConn]->{$fd};
+  
+  $fd->close();
+  
+ EXT_LOOP:
+  foreach my $name (keys %{$self->[appliList]}) {
+    foreach my $fdp (@{$self->[appliList]{$name}}) {
+      if ($fd eq $fdp) {
+	$diedAppName = $name;
+	@{$self->[appliList]{$name}} =
+	  grep ($_ ne $fdp, @{$self->[appliList]{$name}});
+	if (scalar (@{$self->[appliList]{$name}}) == 0) {
+	  delete $self->[appliList]->{$name}
+	}
+	last EXT_LOOP;
+      }
+    }
+  }
+  
+  unless (defined $diedAppName) {
+    warn "Ivy::__removeFileDescriptor : deconnection de NONAME\n" if $^W;
+    return;
+  }
+  
+  my $addrInet = (grep ($self->[cnnxion]{$_} eq $diedAppName,
+			keys %{$self->[cnnxion]}))[0];
+  
+  unless (defined $addrInet) {
+    die "ERREUR _removeFileDescriptor deconnection de $diedAppName ".
+      "addrInet not defined\n";
+    return;
+  }
+  
+  #printf "DBG> _removeFileDescriptor : deconnection de %s ($diedAppName)\n", _inetAdrByName ($diedAppName);
+  
+  delete $self->[cnnxion]{$addrInet};
+  
+  # on vire l'entree correspondant a ce canal dans la liste des
+  # regexps par canal
+  $self->_scanConnStatus () ;
+}
+
+
+############### METHODE	SEND ERROR TO
+sub _sendErrorTo ($$$)
+{
+  my ($self, $fd, $error) = @_;
+  
+  send ($fd, join (' ', ERROR, "0\002$error\n"), 0) 
+    or $self->_removeFileDescriptor ($fd);
+}
+
+
+############### METHODE	PONG
+sub _pong ($$)
+{
+  my ($self, $fd) = @_;
+
+  send ($fd, join (' ', PONG, "0\002 \n"), 0) 
+    or $self->_removeFileDescriptor ($fd);
+}
+
+
+############### METHODE	SEND ERROR TO
+sub _sendDieTo ($$)
+{
+  my ($self, $fd) = @_;
+  
+  send ($fd, join (' ', DIE, "0\002\n"), 0) 
+    or $self->_removeFileDescriptor ($fd);
+}
+
+
+############### METHODE	SEND MSG TO
+sub _sendMsgTo ($$$)
+{
+  my ($self, $fd, $msg) = @_;
+
+  # pour toutes les fonctions de filtrage de regexp
+  foreach my $regexpFunc (@{$self->[sendRegList]{$fd}}) {
+    &{$regexpFunc} (\$msg) if defined $regexpFunc;
+  }
+}
+
+
+############### PROCEDURE TK FILE EVENT	
+sub _tkFileEvent ($$)
+{
+  my ($fd, $cb) = @_;
+    
+  Tk::fileevent ('', $fd, 'readable', $cb) ;
+}
+
+
+############### PROCEDURE SCAN AFTER
+sub _scanAfter ()
+{
+  my $stamp = timeofday ();
+  $selectTimout = MAX_TIMOUT;
+  foreach my $afk (keys %afterList) {
+    my $af = $afterList{$afk};
+    # si ce timer est a declencher
+    if ($af->[2] <= $stamp) {
+      # on traite : le temps de declencher le cb est arrive
+      if (ref  $af->[3] eq 'CODE') {
+	&{$af->[3]};
+      }
+      else {
+	my ($cb, @args) = @{$af->[3]};
+	&$cb (@args);
+      }
+      # si c'est un repeat on le reconduit
+      if ($af->[0]) {
+	$af->[2] = $stamp + $af->[1] ;
+	$selectTimout = $af->[1] if $af->[1] < $selectTimout;
+      } 
+      else {
+	# si c'est un after on le vire
+	afterCancel ($afk);
+      }
+    }
+    else {
+      my $timeTotrigg = $af->[2] - $stamp;
+      $selectTimout = $timeTotrigg if $timeTotrigg < $selectTimout;
+    }
+  }
+}
+
+
+############### METHODE	SCAN CONN STATUS	
+sub _scanConnStatus ($)
+{
+  my $self = shift;
+
+  my (%readyApp, @nonReadyApp);
+
+  foreach (values %{$self->[cnnxion]}) {
+    next if $_ eq "1";
+    $readyApp{$_}++ unless /^\004/; # connecte mais pas ready
+  }
+	
+  foreach (@{$self->[neededApp]}) {
+    push (@nonReadyApp, $_) unless exists $readyApp{$_};
+  }
+  
+  # par compatibilite avec l'ancienne version, on envoie comme
+  # deux premiers arguments une ref sur la liste des applis presentes,
+  # la liste des applis absentes, mais on rajoute comme troisieme
+  # argument une ref sur une table de hash : comme clef les
+  # applis presentes, comme valeur le nombre d'applis ayant ce nom,
+  # de facon a detecter plus facilement quand il y a trop d'applis
+  # de meme nom sur le meme bus.
+  &{$self->[statusFunc]} ([keys %readyApp], \@nonReadyApp, \%readyApp);
+}
+
+
+############### METHODE	TO BE PRUNED
+sub _toBePruned ($$$)
+{
+  my ($self, $from, $regexp) = @_;
+
+  # si il n'y a pas de liste de sujets, on ne
+  # filtre pas
+  return 0 unless @{$self->[topicRegexps]};
+  
+  unless ($regexp =~ /^\^/) {
+    #print "DBG> regexp non ANCREE de $from : $regexp\n";
+    return (0);
+  }
+  
+  if ($regexp =~ /^\^(\w+)/) {
+    my $topic = $1;
+    if (grep (/$topic/, @{$self->[topicRegexps]})) {
+      # on a trouve ce topic : on ne filtre pas la regexp
+      #print "DBG> on garde de $from : $regexp\n";
+      return (0);
+    }
+    #print "DBG> on ELIMINE de $from : $regexp\n";	
+    return (1);
+  }
+  else {
+    #print "DBG> on garde de $from : $regexp\n";
+    return (0);
+  }
+}
+
+
+############### PROCEDURE PARSE IVY BUS PARAM
+sub _parseIvyBusParam ($) 
+{
+  my $ivyBus = shift;
+
+  my ($ivyNetworks, $ivyPort) = $ivyBus =~ /^(.*):(.*)/;
+
+  die ("Erreur Ivy::_parseIvyBusParam format de l'adresse ou ".
+       "no de port incorrect : $ivyBus\n")
+    unless  $ivyPort =~ /^\d+$/;
+
+  my @ivyAddrInet = ();
+
+  $ivyNetworks =~ s/ //g;
+  my @broadcastAddrs = split (',', $ivyNetworks);
+
+  foreach my $netAddr (@broadcastAddrs) {
+    $netAddr = BROADCAST_ADDRS if 
+    (($netAddr eq '') || ($netAddr =~ /^127/) || 
+     ($netAddr =~ /^loopback/));
+
+    # deux cas de figure : on a un nom de sous reseau, ou
+    # une adresse ip de la forme \d+.\d+....
+    my $netAddrInet;
+
+    if ($netAddr !~ /^(\d+\.)+\d+/) {
+      # on a un nom de reseau, il faut trouver son adresse ip
+      # on contourne un bug : Si les adresses sont incompletes
+      # dans la map network : 143.196.53 au lieu de 143.196.53.255
+      # getbyname renvoie une adresse de type 0.143.196.53.
+      # on doit donc faire un decalage des octets vers la gauche,
+      # chaque 0 qui sort a gauche est remplace par un 255 a droite.
+      my $networkAddr = getnetbyname ($netAddr);
+      unless (defined $networkAddr) {
+	warn ("Ivy::_parseIvyBusParam reseau inconnu :  $netAddr\n");
+	next;
+      }
+
+      my @dummyNetAddr = unpack ("CCCC", pack ('N', $networkAddr));
+      while (!$dummyNetAddr[0]) {
+	# tant que le premier octet est 0, on decale vers la gauche et
+	# ont fait rentrer un 255 sur la droite
+	shift @dummyNetAddr; 
+	push (@dummyNetAddr, 255);
+      } 
+      $netAddrInet = pack ("CCCC", @dummyNetAddr);
+    } else { 
+      # on a deja une adresse ip, on rajoute les .255
+      # a la fin s'ils ont etes omis.
+      ($netAddr .= ".255.255.255") =~ s/^((\d+\.){3}\d+).*/$1/;
+      $netAddrInet =  inet_aton ($netAddr);
+    }
+    
+    push (@ivyAddrInet,  pack_sockaddr_in ($ivyPort, $netAddrInet));	
+  }
+  return ($ivyPort, \@ivyAddrInet);
+}
+  
+############# Procedure _SUBSTITUTE ESCAPED CHAR
+sub _substituteEscapedChar ($$)
+{
+  my ($scope, $reg) = @_;
+
+  my %escapeRegexp = REG_PERLISSISME;
+  # Si on fait la substitution dans une classe de caractere
+  # on elimine les crochets.
+  grep ($escapeRegexp{$_} =~ s/[\[\]]//g, keys %escapeRegexp) 
+    if ($scope eq 'inside') ;
+
+  $reg =~ s/\\([wWsSdDne])/$escapeRegexp{$1}/ge;
+  return $reg;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Ivy - Perl extension for implementing a software bus
+
+=head1 SYNOPSIS
+
+use Ivy;
+
+=head1 DESCRIPTION
+
+The Ivy perl module implements a software bus to provide with an easy
+communication between applications. Messages are broadcasted as ASCII strings
+over a network defined by a list of domains and a port.
+Messages are received if they match a regular expressions and if your application
+is on the same network as remote ones.
+Before receive or send message you must call 'init', and 'new' class methods,
+followed by 'start' method.
+When you quit your application don't forget to call 'exit' class methods.
+
+=head1 CLASS METHODS
+
+=head2 Ivy->init(...)
+
+Allows one to define global parameters which may be used as default ones
+at object creation time.
+
+Parameters are :
+
+=over 4
+
+=item B<-loopMode =E<gt> 'TK'|'LOCAL'>
+
+Mode of events loop among TK or LOCAL. According to this mode, you must
+use Ivy->mainLoop or Tk::MainLoop(3)
+
+=item B<-appName =E<gt> 'your app ivy name'>
+
+Name of your application used to identify on ivy bus.
+
+=item B<-ivyBus =E<gt> 'domain 1,...,domain n:port number'>
+
+A list of domains, followed by port number where to broadcast messages.
+Default is 127.255.255.255:2010
+
+=item B<-messWhenReady =E<gt> 'your message when ready'>
+
+Synchronisation message sent when application is ready to receive and send
+messages.
+
+=item B<-onDieFunc =E<gt> [\&yourdiefunc, @parameters]>
+
+=item B<-onDieFunc =E<gt> [$an_object, \&a_method, @parameters]>
+
+A callback or method to call when application receive die message.
+Don't make an exit in callback, ivy we'll do it for you.
+
+Prototype of your callback must be :
+
+sub MyCallback {
+  my @parameters = @_;
+
+  ...
+}
+
+Prototype of your method must be :
+
+sub MyMethod {
+  my ($self, @parameters) = @_;
+
+  ...
+}
+
+=item B<-pruneRegexp =E<gt> ['subject 1', ..., 'subject n']>
+
+Optimize communication using this option. Regexps which don't match these subjects are removed.
+
+Example :
+
+	Ivy->init(-loopMode =E<gt> 'TK',
+		  -appName =E<gt> 'MyWonderfulApp',
+                  -onDieFunc =E<gt> [\&restorecontext]);
+
+=back
+
+=head2 Ivy->new(...);
+
+Check parameters, and create an ivy bus object. You must call Ivy->init before
+this one.
+
+Parameters are :
+
+=over 4
+
+=item B<-appName =E<gt> 'your app ivy name'>
+
+Name of your application used to identify on ivy bus.
+
+=item B<-ivyBus =E<gt> 'domain 1,...,domain n:port number'>
+
+A list of domains, followed by port number where to broadcast messages.
+Default is 127.255.255.255:2010
+
+=item B<-messWhenReady =E<gt> 'your message when ready'>
+
+Synchronisation message sent when application is ready to receive and send
+messages.
+
+=item B<-onDieFunc =E<gt> [\&yourdiefunc, @parameters]>
+
+=item B<-onDieFunc =E<gt> [$an_object, \&a_method, @parameters]>
+
+A callback or method to call when application receive die message.
+Don't make an exit in callback, ivy we'll do it for you.
+Prototype of your callback must be :
+
+	sub MyCallback {
+	  my @parameters = @_;
+	  ...
+	}
+
+Prototype of your method must be :
+
+	sub MyMethod {
+	  my ($self, @parameters) = @_;
+	  ...
+	}
+
+=item B<-pruneRegexp =E<gt> ['subject 1', ..., 'subject n']>
+
+Optimize communication using this option. Regexps which don't match these subjects are removed.
+
+=item B<-neededApp =E<gt> ['app 1', ..., 'app n']>
+
+A list of application your own one needs to correctly run.
+
+=item B<-statusFunc =E<gt> sub {}>
+
+A callback which will be called until every needed app is present on bus.
+
+Your callback could be :
+
+	sub MyCallback {
+	  my ($present, $absent, %present) = @_;
+	
+	  foreach my $remoteapp (keys %present) {
+	    if ($present{$remoteapp} > 1) {
+	      print "n apps $remoteapp are presents on bus\n";
+	    }
+	  }
+
+Example :
+
+	Ivy->new(-ivyBus => '156.255.255.255,157.255.255.255:2204',
+                 -onDieFunc => [\&restorecontext],
+                 -neededApp => ["DataServer", "HMI"],
+                 -statusFunc => \&startwhenpresents);
+
+=back
+
+=head2 Ivy->mainLoop;
+
+Local main events loop. Use it if you don't use Tk library.
+
+=head2 $ivyobj->stop;
+
+=head1 OBJECT METHODS
+
+=head2 $ivyobj->start;
+
+You must call it after you are ready to communicate through ivy bus
+and before you really communicate.
+
+=head2 $ivyobj->sendMsgs(@messages);
+
+Send a list of messages
+
+Example :
+
+	$ivyobj->sendMsgs("Hello World", "Don't Bother", "Y2K is behind us");
+
+=head2 $ivyobj->sendAppNameMsgs(@messages);
+
+Send a list of messages precedeed by ivy application name.
+
+Example :
+
+	$ivyobj->sendMsgs("Hello World");
+	# it will send "$appName Hello World" over ivy bus
+
+=head2 $ivyobject->bindRegexp($regexp, [\&callback, @cb_parameters]);
+
+=head2 $ivyobject->bindRegexp($regexp, [$an_obj, \&method, @cb_parameters]);
+
+Allow one to associate a message which matches a regular expression and a
+callback or method. See perlre(1), to find how to write regexps.
+Use the bracketing construct ( ... ), so that ivy perl will call
+callback with matched patterns as parameters.
+
+Example :
+
+	$ivyobject->bindRegexp("\w+ (\d+)", [\&callback, @cb_parameters]);
+	# You callback will be called with one more parameter which will be
+	# a number precedeed by a word, because of bracketed regexp.
+
+Your callback and method protos must be :
+
+	sub cb {
+	  my ($sendername, @cb_parameters,
+		 @matched_regexps_in_brackets) = @_;
+	  ...
+	}
+
+	sub method {
+	  my ($self, $sendername, @cb_parameters,
+		 @matched_regexps_in_brackets) = @_;
+	  ...
+	}
+
+=head2 $ivyobj->sendDirectMsgs($to, $id, @msgs);
+
+Send a message but Ask Alex to find what are $to and $id
+
+=head2 $ivyobj->bindDirect($regexp, $id, [\&callback, @cb_parameters]);
+
+=head2 $ivyobj->bindDirect($regexp, $id, [$an_obj, \&method, @cb_parameters]);
+
+Same as bindRegexp method but Ask Alex to find what is $id.
+
+=head2 $ivyobj->sendDieTo($to)
+
+send a die message to $to application name.
+
+=head2 $ivyobj->ping($to, $timeout);
+
+send a ping message and wait until timeout to receive a pong.
+
+=head2 $after_id = $ivyobj->after($timeAfter, \@callbacks_list);
+
+Call a list of callbacks after $timeAfter mseconds.
+
+=head2 $repeat_id = $ivyobj->repeat($timeAfter, \@callbacks_list);
+
+Repeat calls of a list of callbacks after $timeAfter mseconds.
+
+=head2 $ivyobj->afterCancel($after_or_repeat_id);
+
+Cancel an after callback call.
+
+=head2 $ivyobj->fileEvent($fd, $cb);
+
+Ask Alex
+
+=head2 $ivyobj->DESTROY;
+
+=head1 BUGS
+
+No know bugs at this time. Report them to author.
+
+=head1 SEE ALSO
+
+perl(1), perlre(1)
+
+=head1 AUTHORS
+
+Alexandre Bustico <bustico@tls.cena.fr>, Herve Damiano <damiano@tls.cena.fr>
+
+=head1 COPYRIGHT
+
+CENA (C) 1997-2000
+
+=head1 HISTORY
+
+=cut
diff --git a/src/ivymon b/src/ivymon
new file mode 100755
index 0000000..e6f3ceb
--- /dev/null
+++ b/src/ivymon
@@ -0,0 +1,755 @@
+#!/usr/bin/perl
+
+use Tk;
+use Tk::Font;
+use Ivy;
+use strict 'vars';
+use Getopt::Long;
+use vars qw/$opt_help $opt_b $opt_history/;
+
+# geometrie
+my $appliFrameWidth = 150;
+my $appliFrameHeight = 200;
+my $bindingsFrameWidth = 400;
+
+
+my $ivy_port = "127.255.255.255:2010";
+my $history = 10000;
+
+# divers
+my %connectedClients;
+my %clientsIndex;
+my %bindings;
+my %bindingsIndex;
+my $selectedClient;
+
+my $duration = 0;
+my $time = 0;
+my $fmtduration = '00:00';
+my $bytes = 0 ;
+my $messagesNumber = 0;
+my $bindingsFlag = 0;
+my $stopFlag = 0;
+
+my $mw = MainWindow->new;
+$mw->geometry('850x768');
+$mw->minsize(850, 768);
+
+
+if (not GetOptions('-help', '-history=s', '-b=s') or $opt_help) {
+    print "Usage: ivymon [options]\n";
+    print "Options : \n";
+    print "      -s <[addr]:port>    bus port(default $ivy_port)\n";
+    print "      -history <number>   messages history length (default $history)\n";
+    print "      -help               help message \n";
+    exit ;
+}
+
+$ivy_port = $opt_b if $opt_b and
+    $opt_b =~ /^(\d+\.\d+\.\d+\.\d+)?(,\d+\.\d+\.\d+\.\d+)*:\d+/;
+$history = $opt_history if $opt_history;
+$mw->title("IvyMon ($ivy_port)");
+
+#----------------------------------------------------------------------------------
+# La Frame de gauche prend toute la hauteur de l'appli et est composee d'une frame
+# ou sont affiches les Messages et une frame ou sont saisis les Abonnements et les
+# instructions de Recherche
+#----------------------------------------------------------------------------------
+my $frame1left =
+    $mw->Frame()->pack(-fill => 'both',
+		       -expand => 1,
+		       -side => 'left');
+
+my $frame11messages =
+    $frame1left->Frame()->pack(-fill => 'both',
+			       -expand => 1,
+			       -padx => 5, -pady => 5);
+my $frame12 =
+      $frame1left->Frame(-height => $appliFrameHeight)->pack(-fill => 'both',
+							     -side => 'bottom',
+							     -expand => 0);
+my $frame121bindings =
+      $frame12->Frame(-height => $appliFrameHeight,
+		      -relief => 'groove',
+		      -borderwidth => 3,
+		      -width => $bindingsFrameWidth)->pack(-fill => 'both',
+							   -ipady => 20, -ipadx => 20, 
+							   -padx => 5, -pady => 5,
+							   -side => 'left',
+							   -expand => 0);
+my $frame122search =
+      $frame12->Frame(-relief => 'groove',
+		      -borderwidth => 3,
+		      -height => $appliFrameHeight)->pack(-fill => 'both',
+							  -padx => 5, -pady => 5,
+							  -side => 'left',
+							  -expand => 0);
+     
+
+#----------------------------------------------------------------------------------
+# La Frame de droite prend toute la hauteur de l'appli et est composee d'une frame
+# ou sont affiches les Applications connectees et une frame contenant les boutons
+# de commande
+#----------------------------------------------------------------------------------
+my $frame2right =
+    $mw->Frame(-width => $appliFrameWidth)->pack(-fill => 'both',
+						 -expand => 0,
+						 -side => 'right');
+my $frame21appli =
+    $frame2right->Frame(-width => $appliFrameWidth)->pack(-fill => 'both',
+							  -expand => 1,
+							  -padx => 5, -pady => 5);
+						   
+my $frame21control =
+    $frame2right->Frame(-width => $appliFrameWidth,
+			-height => $appliFrameHeight)->pack(-fill => 'both',
+							    -expand => 0,
+							    -padx => 5, -pady => 5);
+#----------------------------------------------------------------------------------
+# Description de la zone Messages
+#----------------------------------------------------------------------------------
+my $messagesLabel =
+    $frame11messages->Label(-text => "Messages :")->pack(-side => 'top',
+							 -anchor => 'w');
+
+my $textFont = $mw->fontCreate('H_Normal',
+			       -family => 'Helvetica',
+			       -size => 10);
+my $textItalicFont = $mw->fontCreate('H_Italic',
+				     -family => 'Helvetica',
+				     -size => 10,
+				     -slant => 'italic');
+my $textBoldFont = $mw->fontCreate('H_Bold',
+				   -family => 'Helvetica',
+				   -size => 10,
+				   -weight => 'bold');
+
+my $messagesText =
+    $frame11messages->Scrolled(Text,
+			       -scrollbars => 'e',
+			       -font => 'H_Bold',
+			       -spacing1 => 2,
+			       -spacing2 => 0,
+			       -spacing3 => 2,
+			       -state => 'disabled')->pack(-fill => 'both',
+							   -expand => 1,
+							   -side => 'bottom');
+my $messagesBg = $messagesText->cget(-background);
+$messagesText->tagConfigure('sender',
+			    -background => 'gray50',
+			    -foreground => 'gray90');
+$messagesText->tagConfigure('info', -foreground => 'sienna');
+$messagesText->bind('<KeyPress>', sub {
+    my $index = $messagesText->index('insert');
+    #print "index = $index\n";
+    $messagesText->tagAdd('info', "$index - 1 chars", $index);
+});
+
+#----------------------------------------------------------------------------------
+# Description de la zone Clients
+#----------------------------------------------------------------------------------
+my $clientsLabel =
+    $frame21appli->Label(-text => "Applications :")->pack(-side => 'top',
+							  -anchor => 'w');
+my $clientsListbox =
+    $frame21appli->Listbox()->pack(-fill => 'both',
+				   -expand => 1,
+				   -side => 'bottom');
+$clientsListbox->bind('<1>', [\&selectClient]);
+
+#----------------------------------------------------------------------------------
+# Description de la zone Abonnements
+#----------------------------------------------------------------------------------
+my $bindingsLabel =
+    $frame121bindings->Label(-text => 'Bindings : ')->pack(-side => 'top',
+							   -anchor => 'w');
+
+my $bindingsEntry =
+    $frame121bindings->Entry(-width => 50)->pack(-fill => 'x',
+						 -ipady => 3,
+						 -expand => 0,
+						 -padx => 5, -pady => 5);
+$bindingsEntry->bind('<Escape>' => [\&addBindingExpression]);
+$bindingsEntry->bind('<Return>' => [\&addBinding, 1]);
+$bindingsEntry->focus;
+
+my $frame1211 =
+    $frame121bindings->Frame()->pack(-fill => 'x',
+				     -side => 'bottom',
+				     -expand => 1);
+my $bindingsList =
+    $frame1211->Listbox(-width => 40)->pack(-fill => 'y',
+					    -side => 'left',
+					    -expand => 1);
+$bindingsList->bind('<1>', [\&selectBinding]);
+
+my $frame12111 =
+    $frame1211->Frame()->pack(-fill => 'y',
+			      -side => 'right',
+			      -expand => 1);
+my $bindingsClear =
+    $frame12111->Button(-text => 'Clear',
+			-command => [\&clearBinding])->pack(-fill => 'both',
+							    -side => 'top',
+							    -expand => 1);
+my $bindingsAdd =
+    $frame12111->Button(-text => 'Add',
+			-command => [\&addBinding])->pack(-fill => 'both',
+							  -side => 'top',
+							  -expand => 1);
+my $bindingsChange =
+    $frame12111->Button(-text => 'Change',
+			-state => 'disabled',
+			-command => [\&changeBinding])->pack(-fill => 'both',
+							     -side => 'bottom',
+							     -expand => 1);
+my $bindingsRemove =
+    $frame12111->Button(-text => 'Remove',
+			-state => 'disabled',
+			-command => [\&removeBinding])->pack(-fill => 'both',
+							     -side => 'bottom',
+							     -expand => 1);
+						     
+#----------------------------------------------------------------------------------
+# Description de la zone Recherche
+#----------------------------------------------------------------------------------
+my $searchLabel =
+    $frame122search->Label(-text => 'Search : ')->pack(-side => 'top',
+							 -anchor => 'w');
+my $searchEntry =
+    $frame122search->Entry(-width => 20)->pack(-fill => 'x',
+					       -ipady => 3,
+					       -expand => 0,
+					       -padx => 5, -pady => 5);
+$searchEntry->bind('<Return>' => [\&searchNext, 1]);
+
+my $frame1222 =
+    $frame122search->Frame()->pack(-fill => 'x',
+				   -padx => 10, -pady => 10,
+				   -side => 'bottom',
+				   -expand => 0);
+my $frame1221 =
+    $frame122search->Frame()->pack(-fill => 'x',
+				   -padx => 10,
+				   -side => 'bottom',
+				   -expand => 0);
+my $searchPrev =
+    $frame1221->Button(-text => 'Previous',
+		       -height => 3,
+		       -width => 4,
+		       -command => [\&searchPrev])->pack(-fill => 'x',
+							 -side => 'left',
+							 -expand => 1);
+my $searchNext =
+    $frame1221->Button(-text => 'Next',
+		       -width => 4,
+		       -height => 3,
+		       -command => [\&searchNext])->pack(-fill => 'x',
+							 -side => 'right',
+							 -expand => 1);
+my $searchClear =
+    $frame1222->Button(-text => 'Clear',
+		       -width => 4,
+		       -height => 3,
+		       -command => [\&clearSearch])->pack(-fill => 'x',
+							  -side => 'left',
+							  -expand => 1);
+my $searchAll =
+    $frame1222->Button(-text => 'All',
+		       -width => 4,
+		       -height => 3,
+		       -command => [\&searchAll])->pack(-fill => 'x',
+							-side => 'right',
+							-expand => 1);
+
+
+#----------------------------------------------------------------------------------
+# Description de a la zone Commande
+#----------------------------------------------------------------------------------
+# les champs de statistiques
+my $frame211control =
+    $frame21control->Frame()->pack(-side => 'top',
+				   -fill => 'both',
+				   -expand => 1);
+my $frame2111control =
+    $frame211control->Frame()->pack(-side => 'left',
+				    -padx => 5,
+				    -fill => 'both',
+				    -expand => 1);
+my $frame2112control =
+    $frame211control->Frame()->pack(-side => 'right',
+				    -fill => 'both',
+				    -expand => 1);
+    
+
+$frame2111control->Label(-text => "Duration :")->pack(-side => 'top',
+						      -pady => 3,
+						      -anchor => 'w',
+						      );
+$frame2111control->Label(-text => "Messages :")->pack(-side => 'top',
+						      -pady => 2,
+						      -anchor => 'w');
+$frame2111control->Label(-text => "Bytes :")->pack(-side => 'top',
+						   -pady => 3,
+						   -anchor => 'w');
+$frame2112control->Label(-textvariable => \$fmtduration)->pack(-side => 'top',
+							    -pady => 3,
+							    -anchor => 'w');
+$frame2112control->Label(-textvariable => \$messagesNumber)->pack(-side => 'top',
+								  -pady => 3,
+								  -anchor => 'w');
+$frame2112control->Label(-textvariable => \$bytes)->pack(-side => 'top',
+							 -pady => 3,
+							 -anchor => 'w');
+
+# les boutons 
+my $frame212control =
+    $frame21control->Frame()->pack(-side => 'bottom',
+				   -pady => 8,
+				   -fill => 'both',
+				   -expand => 1);
+my $frame2121control =
+    $frame212control->Frame()->pack(-side => 'left',
+				    -fill => 'both',
+				    -ipady => 10,
+				    -padx => 5, -pady => 5,
+  				    -expand => 1);
+my $frame2122control =
+    $frame212control->Frame()->pack(-side => 'right',
+				    -padx => 5, -pady => 5,
+				    -ipady => 10,
+				    -fill => 'both',
+  				    -expand => 1);
+my $startButton =
+    $frame2121control->Button(-height => 3,
+			      -width => 6,
+			      -command => [\&start, 1],
+			      -state => 'disabled',
+			      -text => 'Start')->pack(-fill => 'both',
+  						      -side => 'top',
+  						      -expand => 0);
+my $clearButton =
+    $frame2121control->Button(-height => 3,
+			      -width => 6,
+			      -command => [\&clearMessages],
+			      -text => "Clear")->pack(-fill => 'both',
+  						      -side => 'bottom',
+  						      -expand => 0);
+
+my $stopButton =
+    $frame2122control->Button(-height => 3,
+			      -width => 6,
+			      -command => [\&stop, 1],
+			      -text => 'Stop')->pack(-fill => 'both',
+						     -side => 'top',
+						     -expand => 0);
+my $exitButton =
+    $frame2122control->Button(-height => 3,
+			      -width => 6,
+			      -command => [\&bye],
+			      -text => 'Exit')->pack(-fill => 'both',
+						     -side => 'bottom',
+						     -expand => 0);
+					    
+
+
+
+#----------------------------------------------------------------------------------
+# Demarrage d'Ivy et abonnements
+#----------------------------------------------------------------------------------
+
+Ivy->init(-loopMode => 'TK',
+          -appName => "IVYMON",
+          -ivyBus => $ivy_port,
+          );   
+my $ivy = Ivy->new(-statusFunc  => \&checkClientsStatus);
+$ivy->start;
+
+$mw->repeat(1000, \&updateDuration);
+
+MainLoop;
+
+#==================================================================================
+#                                FONCTIONS IVY
+#==================================================================================
+sub addIvyBinding {
+    my $binding = shift;
+    #print "in addIvyBinding $binding\n";
+    return if $stopFlag;
+    $ivy->bindRegexp($binding, [\&updateMessages]);
+}
+
+sub removeIvyBinding {
+    my $binding = shift;
+     $ivy->bindRegexp($binding);
+}
+
+sub stopIvyBindings {
+    for (keys(%bindings)) {
+	$ivy->bindRegexp($_);
+    }
+}
+
+sub startIvyBindings {
+    for (keys(%bindings)) {
+	$ivy->bindRegexp($_, [\&updateMessages]);
+    }
+}
+
+#==================================================================================
+#                                 CALLBACK TK
+#==================================================================================
+
+#----------------------------------------------------------------------------------
+# Fonctions associees a la liste des applications connectees
+#----------------------------------------------------------------------------------
+sub checkClientsStatus {
+    my ($present, $absent) = @_;
+    #print "in checkClientsStatus\n";
+    my %present;
+    for (@$present) {
+	$present{$_} = 1;
+	unless ($connectedClients{$_}) {
+	    $connectedClients{$_} = 1;
+	    &addClient($_);
+	}
+    }
+    for (keys(%connectedClients)) {
+	unless ($present{$_}) {
+	    delete $connectedClients{$_};
+	    &removeClient($_);
+	}
+    }
+}
+
+sub addClient {
+    my $client = shift;
+    $clientsListbox->insert('end', $client);
+    &clientsGenList;
+
+}
+
+sub removeClient {
+    my $client = shift;
+    my $index = $clientsIndex{$client};
+    $clientsListbox->delete($index) if $index >= 0;
+    &clientsGenList;
+}
+
+sub clientsGenList {
+    my $i = 0;
+    for ($clientsListbox->get(0, 'end')) {
+	$clientsIndex{$_} = $i++;
+    }
+}
+
+sub selectClient {
+    $messagesText->tagConfigure($selectedClient, -background => $messagesBg)
+	if $selectedClient;
+    my $selindex = $clientsListbox->curselection;
+    my $client = $clientsListbox->get($selindex);
+    if ($selectedClient eq $client) {
+	$selectedClient = undef;
+	$clientsListbox->selectionClear($selindex);
+	return;
+    }
+    $messagesText->tagConfigure($client, -background => 'gray70');
+    $selectedClient = $client;
+}
+#----------------------------------------------------------------------------------
+# Fonctions associees a la gestion de l'affichage des messages
+#----------------------------------------------------------------------------------
+sub updateMessages {
+    my ($sender, $message) = @_;
+    return unless $message;
+    return if ($message =~ /READY$/);
+    chomp($message);
+    my $text = "$sender $message\n";
+    $messagesText->configure(-state => 'normal');
+    # on teste la taille de la fenetre de messages
+    my ($linesNb) = split(/\./, $messagesText->index('end'));
+    #print "linesNb=$linesNb history=$history\n";
+    if ($linesNb > $history) {
+	my $dl = $linesNb - $history;
+	$messagesText->delete('1.0', "1.0 + $dl lines");
+    }
+    # on extrait les index de debut et de fin de l'application emettrice
+    my $index1 = $messagesText->index('end');
+    $index1 = "$index1 - 1 lines";
+    my $senderlen = length($sender);
+    my $index2 = "$index1 + $senderlen chars";
+    $messagesText->insert('end', $text);
+    $messagesText->tagAdd('sender', $index1, $index2);
+    # on extrait les index de debut et de fin du message
+    my $msglen = length($message);
+    $index1 = "$index2 + 1 chars";
+    $index2 = "$index1 + $msglen chars";
+    $messagesText->tagAdd($sender, $index1, $index2);
+    $messagesText->configure(-state => 'disabled');
+    $messagesText->see('end');
+    $messagesNumber++;
+    $bytes += length($message);
+    $mw->update;
+}
+
+sub printInfo {
+    my $info = shift;
+    $messagesText->insert('end', "<< $info >>\n");
+    my $index = $messagesText->index('end');
+    my $len = length($info) + 7;
+    my $index1 = "$index - 1 lines";
+    my $index0 = "$index1 - $len chars";
+    $messagesText->tagAdd('info', $index0, $index1);
+    $messagesText->see('end');
+    $messagesText->markSet('insert', 'end');
+}
+
+sub addBindingExpression {
+    $bindingsEntry->insert('insert', '(.*)');
+    $bindingsEntry->xview('end');
+}
+
+sub clearMessages {
+    &stop;
+    $messagesText->configure(-state => 'normal');
+    $messagesText->delete('0.0', 'end');
+    $messagesText->configure(-state => 'disabled');
+    &start;
+}
+
+#----------------------------------------------------------------------------------
+# Fonctions associees a la gestion des abonnements
+#----------------------------------------------------------------------------------
+
+sub clearBinding {
+    # on vide la le champ de saisie
+    $bindingsEntry->delete(0, 'end');
+    # on enleve la selection dans la listbox
+    $bindingsList->selectionClear(0, 'end');
+    # on desactive les boutons Change et Remove
+    $bindingsChange->configure(-state => 'disabled');  
+    $bindingsRemove->configure(-state => 'disabled');
+}
+
+sub addBinding {
+    my $entry = $bindingsEntry->get;
+    return unless $entry;
+    return if $bindings{$entry};
+    $bindingsList->insert('end', $entry);
+    # on ajoute l'abonnement ivy
+    &addIvyBinding($entry);
+    # on remet a jour la liste des bindings
+    &bindingsGenList;
+}
+
+sub selectBinding {
+    my $selindex = $bindingsList->curselection;
+    my $selected = $bindingsList->get($selindex);
+    # on active les boutons Change et Remove
+    $bindingsChange->configure(-state => 'normal');  
+    $bindingsRemove->configure(-state => 'normal');  
+    # on met a jour le champ de saisie
+    $bindingsEntry->delete(0, 'end');
+    $bindingsEntry->insert(0, $selected);
+}
+
+sub removeBinding {
+    my $selindex = $bindingsList->curselection;
+    return if $selindex eq "";
+    my $selected = $bindingsList->get($selindex);
+    # on supprime l'abonnement ivy
+    &removeIvyBinding($selected);
+    # on enleve l'item de la liste
+    $bindingsList->delete($selindex);
+    # on remet a jour la liste des bindings
+    &bindingsGenList;
+    # on desactive les boutons Change et Remove
+    $bindingsChange->configure(-state => 'disabled');  
+    $bindingsRemove->configure(-state => 'disabled');
+    # on vide le champ de saisie
+    $bindingsEntry->delete(0, 'end');
+    
+}
+
+sub changeBinding {
+    my $selindex = $bindingsList->curselection;
+    return if $selindex eq "";
+    my $selected = $bindingsList->get($selindex);
+    my $newbinding = $bindingsEntry->get;
+    return unless $newbinding;
+    return if $bindings{$newbinding};
+    # on supprime l'abonnement ivy
+    &removeIvyBinding($selected);
+    # on ajoute le nouvel abonnement ivy
+    &addIvyBinding($selected);
+    # on enleve la selection de la liste
+    $bindingsList->selectionClear(0, 'end');
+    # on met a jour l'item de la liste
+    $bindingsList->delete($selindex);
+    $bindingsList->insert($selindex, $newbinding);
+    # on remet a jour la liste des bindings
+    &bindingsGenList;
+    # on desactive les boutons Change et Remove
+    $bindingsChange->configure(-state => 'disabled');  
+    $bindingsRemove->configure(-state => 'disabled');
+    
+}
+
+sub bindingsGenList {
+    my $i = 0;
+    my $found = 0;
+    for (keys %bindingsIndex) {
+	delete $bindingsIndex{$_};
+	delete $bindings{$_};
+    }
+    for ($bindingsList->get(0, 'end')) {
+	$found = 1;
+	$bindingsIndex{$_} = $i++;
+	$bindings{$_} = 1
+    }
+    $bindingsFlag = $found;
+    #print "bindingsFlag = $bindingsFlag\n";
+}
+
+#----------------------------------------------------------------------------------
+# Fonctions associees au panneau de recherche
+#----------------------------------------------------------------------------------
+my $searchIndex;
+sub clearSearch {
+    # on vide la le champ de saisie
+    $searchEntry->delete(0, 'end');
+    &highlightStringOff;
+}
+
+sub searchNext {
+    my $string = $searchEntry->get;
+    my $strlen = length($string);
+    return unless $string;
+    my $index0 = ($searchIndex) ? "$searchIndex + 1 chars": '0.0';
+    my $index = $messagesText->search(-forwards, $string, $index0);
+    $searchIndex = $index;
+    return unless $index;
+    &highlightStringOff;
+    &highlightString($index, "$index + $strlen chars");
+    $messagesText->see($index);
+    
+}
+
+sub searchPrev {
+    my $string = $searchEntry->get;
+    my $strlen = length($string);
+    return unless $string;
+    #my $index0 = ($searchIndex) ? "$searchIndex - 1 chars": '0.0';
+    my $index0 = ($searchIndex) ? $searchIndex : '0.0';
+    my $index = $messagesText->search(-backwards, $string, $index0);
+    $searchIndex = $index;
+    return unless $index;
+    &highlightStringOff;
+    &highlightString($index, "$index + $strlen chars");
+    $messagesText->see($index);
+    
+}
+
+sub searchAll {
+    my $string = $searchEntry->get;
+    my $strlen = length($string);
+    return unless $string;
+    $messagesText->tagConfigure('found',
+				-background => 'sienna',
+				-foreground => 'ivory');
+    my $index = '0.0';
+    while ($index) {
+	$index = $messagesText->search(-forwards, $string, $index, 'end');
+	return unless $index;
+	$messagesText->tagAdd('found', $index, "$index + $strlen chars");
+	$index = "$index + 1 chars";
+    }
+
+}
+
+sub highlightString {
+    my ($i1, $i2) = @_;   
+    $messagesText->tagConfigure('found',
+				-background => 'sienna',
+				-foreground => 'ivory');
+    $messagesText->tagAdd('found', $i1, $i2);
+}
+
+sub highlightStringOff {
+    $messagesText->tagDelete('found');
+    $messagesText->tagConfigure('found',
+				-background => 'sienna',
+				-foreground => 'ivory');
+}    
+
+#----------------------------------------------------------------------------------
+# Fonctions associees au panneau de commande
+#----------------------------------------------------------------------------------
+sub bye {
+    #$ivy->stop;
+    exit;
+}
+
+sub stop {
+    my $flag = shift;
+    $stopFlag = 1;
+    $startButton->configure(-state => 'normal');
+    $stopButton->configure(-state => 'disabled');
+    &stopIvyBindings;
+    if ($flag) {
+	&setEditMode;
+	my $fmttime = &formattime($time);
+	&printInfo("Stopped at $fmttime");
+    }
+
+}
+
+sub start {
+    my $flag = shift;
+    $stopFlag = 0;
+    $stopButton->configure(-state => 'normal');
+    $startButton->configure(-state => 'disabled');
+    &startIvyBindings;
+    if ($flag) {
+	my $fmttime = &formattime($time);
+	&printInfo("Restarted at $fmttime");
+	&unsetEditMode;
+    }
+}
+
+sub updateDuration {
+    return unless $bindingsFlag;
+    $time++;
+    return if $stopFlag;
+    $duration++;
+    $fmtduration = &formattime($duration);
+}
+
+sub formattime {
+    my $duration = shift;
+    my $hour = sprintf("%02d", int($duration/3600));
+    my $sec = $duration % 3600;
+    my $min = sprintf("%02d", int($sec/60));
+    my $sec = sprintf("%02d", $sec % 60);
+    if ($hour eq '00') {
+	return "$min:$sec";
+    } else {
+	return "$hour:$min:$sec";
+    }  
+}
+
+#  sub Ivy::exit {
+#      print "exit\n";
+#  }
+
+sub setEditMode {
+    #print "setEditMode\n";
+    $messagesText->configure(-state => 'normal');
+    $messagesText->focus;
+}
+
+sub unsetEditMode {
+    #print "unsetEditMode\n";
+    $messagesText->configure(-state => 'disabled');
+    $bindingsEntry->focus;
+}
diff --git a/src/ivymon0 b/src/ivymon0
new file mode 100755
index 0000000..08bd7d4
--- /dev/null
+++ b/src/ivymon0
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+
+use Tk;
+
+# geometrie
+my ($width, $height) = (1024, 768); 
+# couleurs
+my $frame1color = 'yellow';
+my $frame1Xcolor = 'red';
+my $frame1XXcolor = 'orange';
+
+my $mw = MainWindow->new;
+$mw->geometry($width.'x'.$height);
+$mw->title('IvyMon');
+
+my $frame1 =
+    $mw->Frame(-background => $frame1color)->pack(-fill => 'both', -expand => 1);
+
+my $frame11 =
+    $frame1->Frame(-background => $frame1Xcolor)->pack(-fill => 'both', -expand => 1,
+						      -padx => 5, -pady => 5);
+
+my $frame111clients =
+    $frame11->Frame(-background => $frame1XXcolor,
+		    -width => 150)->pack(-fill => 'both',
+					 -padx => 10,
+					 -pady => 10,
+					 -side => 'left',
+					 -expand => 0);
+my $frame112messages =
+    $frame11->Frame(-background => $frame1XXcolor,
+		    -relief => 'sunken',
+		    -bd => 5)->pack(-fill => 'both',
+							 -padx => 10,
+							 -pady => 10,
+							 -side => 'right',
+							 -expand => 1);
+
+my $frame12bindings =
+    $frame1->Frame(-background => $frame1Xcolor,
+  		   -height => 100)->pack(-fill => 'both',
+ 					 -padx => 5,
+  					 -pady => 5,
+					 -side => 'bottom',
+  					 -expand => 0);
+
+$frame112messages->Text(-state => 'disabled')->pack(-fill => 'both',
+						    -expand => 1);
+
+MainLoop;