summaryrefslogtreecommitdiff
path: root/src/Ivy.pm
diff options
context:
space:
mode:
authorjacomi1999-02-19 09:36:34 +0000
committerjacomi1999-02-19 09:36:34 +0000
commit25b0f38d59d1d01da06a8111b540571341d30a8b (patch)
tree476fc7b93e239654b45bc7673b3ed6d33053b38d /src/Ivy.pm
parent8c327baf3af315e033fa7acfa46f53b371f8b636 (diff)
downloadivy-perl-25b0f38d59d1d01da06a8111b540571341d30a8b.zip
ivy-perl-25b0f38d59d1d01da06a8111b540571341d30a8b.tar.gz
ivy-perl-25b0f38d59d1d01da06a8111b540571341d30a8b.tar.bz2
ivy-perl-25b0f38d59d1d01da06a8111b540571341d30a8b.tar.xz
- broadcast port and domain options replaced by ivyBus option
- new function parseIvyBusParam
Diffstat (limited to 'src/Ivy.pm')
-rw-r--r--src/Ivy.pm1233
1 files changed, 650 insertions, 583 deletions
diff --git a/src/Ivy.pm b/src/Ivy.pm
index 2d36f01..88bf010 100644
--- a/src/Ivy.pm
+++ b/src/Ivy.pm
@@ -27,593 +27,607 @@ use Time::Gettimeofday ;
#############################################################################
#### PROTOTYPES #####
#############################################################################
-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 stop (); # - 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 after ($$); # temps en millisecondes, callback
-sub repeat ($$); # temps en millisecondes, callback
-sub fileEvent ($$); # associe un fd a un callback pour la mainloop locale
-sub pruneRegexp (@); # optimisation : si l'on connait les sujets des messages
- # qu'on envoie, on appelle cette fonction avec une
- # liste de sujets, et les regexps qui ne matchent pas
- # ce sujet sont eliminees Cette fonction doit etre
- # appelee avant le Ivy::start
-
-################ 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 ($$);
-#############################################################################
-#### CONSTANTES #####
-#############################################################################
-use constant VERSION => 3;
-use constant MSG_FMT => "%d %d\002%s\n";
-
-# par defaut, on diffuse le bonjour en local
-# (sauf pour l'instant, pour rester compatible)
-#use constant BROADCAST_ADDRS => "127.255.255.255" ;
-use constant BROADCAST_ADDRS => "143.196.1.255, 143.196.2.255, 143.196.53.255";
-
-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 AFTER => 0;
-use constant REPEAT => 1;
-#############################################################################
-#### VARIABLES GLOBALES #####
-#############################################################################
-my $messWhenReady; # message a envoyer a un canal lorsqu'on
- # a recu le message endregexp.
-
-my $localAddr; # adresse de la machine locale
-
-my $servPort; # No de port tcp du serveur
-
-my $appName; # Nom de l'appli locale
-
-my @neededApp; # liste des applis necessaires a l'appli locale
-
-my $statusFunc; # 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
-
-my $onDieFunc; # callback prenant en param 1 refs sur une liste :
- # [ref sur fonction, parametres]
-
-my $supSock ; # socket de supervision en lecture/ecriture
-my $connSock; # socket de connexion tcp
-
-my %sockList = (); # tab ass : nom du fd => fd
-my %appliList = (); # tab ass : nom de l'appli => fd
-
-my %sendRegList = (); # 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
-
-my @topicRegexps = (); # liste des topics qu'on envoie si on
- # les regexps
-
-my @recCbList = (); # liste de ref sur des couples
- # (regexp,callBack) les callbacks
- # sont appeles lors de
- # la reception de messages en fonction
- # du numero de regexp.
-
-my @directCbList = (); # liste de callBack pour les messages directs
-
-my %cnnxion = (); # 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
-
-my %buffByConn = (); # tableau associatif, clef => file desc,
- # valeur :buffer au cas ou la lacture ne se termine
- # pas par \n
-
-my $fileEventFunc; # pointeur sur la fonction permettant d'associer
- # des callbacks a un file desc, (ainsi que de
- # les enlever)
-
-
-my $localLoopSel; # dans le cas ou l'on soit dans une mainLoop
- # locale, cette var pointe une un objet
- # de type IO::Select;
-
-my %localBindByHandle; # table d'ass. handle -> callback
-my %afterList=(); # tableau d'ass [AFTER ou REPEAT,
- # timeTotal, deadLine, [callback, arg, arg, ...]]
-
-my $afterId = 0; #
-
-my $smallestTimout = 10000; # timeout le plus petit pour le select
-
-my $maxInstanceOfApp ; # nombre max d'instances de l'appli utilisant
- # le bus, si il y a deja $maxInstanceOfApp
- # instances on sort.
-
-BEGIN {$SIG{'PIPE'} = sub {warn "broken pipe, ignoring ...\n";}}
-
-#############################################################################
-#### PROCEDURES PUBLIQUES #####
-#############################################################################
-
-
-
-############### PROCEDURE BUS START
-sub start (@)
-{
- my %options = @_;
-
- # valeurs par defaut pour le parametre : variable d'environnement
- # ou valeur cablee, a defaut
- my $default_domains = $ENV{"IVYDOMAINS"};
- $default_domains = BROADCAST_ADDRS unless defined ($default_domains);
-
- my %defaultOptions = ( #PARAMETRES OBLIGATOIRES
- -loopMode => undef,
- # TK ou LOCAL
-
- -appName => undef,
- # nom de l'appli
-
- # PARAMETRES FACULTATIFS (avec valeurs par defaut)
- -broadcastPort => $ENV{"BUS"},
- # No de port UDP Si non specifie la variable
- # d'environnement BUS sera examinee
-
- -domains => $default_domains,
- # Liste des domaines ou se fait le broadcast
- # si non specifie, on utilise la variable
- # d'environnement ou la valeur par defaut
-
- -messWhenReady => "_APP NAME READY",
- # message de synchro a envoyer quand pret
-
- -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 deux parametres passes sont :
- # [liste des applis presentes],
- # [liste des applis absentes]
-
- -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
- ) ;
-
-
- 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::start vous devez specifier ".
- "l'option $opt\n";
- }
- }
-
- foreach my $opt (keys %options) {
- die "ERREUR Ivy::start option $opt inconnue\n" unless
- exists ($defaultOptions{$opt});
- }
-
- my $loopMode = $options{-loopMode};
- my $broadcastPort = $options{-broadcastPort} ;
- my $broadcastAddrs = $options{-domains} ;
- $appName = $options{-appName} ;
- $messWhenReady = $options{-messWhenReady} eq "_APP NAME READY" ?
- "$appName READY" : $options{-messWhenReady};
- @neededApp = @{$options{-neededApp}} ;
- $statusFunc = $options{-statusFunc} ;
- $onDieFunc = $options{-onDieFunc} ;
-
- 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 "le premier argument (mainloop mode) doit etre TK ou LOCAL\n";
- }
-
- # cree la socket de connexion, recupere le no de port
- $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] ;
- $cnnxion{"$hostAddr:". $connSock->sockport} = "\004";
- $cnnxion{"$localhostAddr:". $connSock->sockport} = "\004";
-
- # cree la socket de broadcast
- $supSock = IO::Socket::INET->new(LocalPort => $broadcastPort,
- Proto => 'udp',
- Type => SOCK_DGRAM,
- Reuse => 1);
-
- $supSock->sockopt (SO_BROADCAST, 1);
-
-
- # on determine la liste des adresses de broadcast
- $broadcastAddrs =~ s/ //g;
- my @broadcastAddrs = split (',', $broadcastAddrs);
-
- # et on envoie envoie le bonjour : "no de version no de port"
- my $bonjourMsg = sprintf ("%d %d\n", VERSION, $connSock->sockport());
-
- foreach my $netAddr (@broadcastAddrs) {
- # on complete la fin de l'adresse par des 255 si necessaire
- my @addrElems = split ('\.', $netAddr);
- $netAddr = '';
- my $i = 0;
- while ($i <4) {
- $netAddr .= (defined ($addrElems[$i]) ? $addrElems[$i] : '255');
- $netAddr .= '.' if ($i++ < 3);
- }
-# print "[$netAddr]\n";
- my $netAddrInet = inet_aton ($netAddr);
- my $netBroadcastAddr = pack_sockaddr_in ($broadcastPort, $netAddrInet);
- send ($supSock, $bonjourMsg, 0, $netBroadcastAddr) or
- warn "Ivy::start envoi du bonjour a echoue sur $netAddr : $!\n";
- }
- # callback pour traiter la reception des bonjours
- &$fileEventFunc ($supSock, \&_getBonjour) ;
-
- # callback pour traiter les demandes de cxion
- &$fileEventFunc ($connSock, \&_getConnections) ;
-}
-
-
-############### PROCEDURE BIND REGEXP
-sub bindRegexp ($$)
-{
- my ($regexp, $cb) = @_;
-
- 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 <= ($#recCbList+1); $id++) {
- last unless (defined $recCbList[$id]) && @{$recCbList[$id]->[1]};
- }
- $recCbList[$id] = [$regexp, $cb];
-
- # on envoie les messages regexps aux processus deja connectes
- _sendLastRegexpToAllreadyConnected ($id) ;
- } else {
- # on vire le callback, et on se desabonne de cette regexp
- for (my $id=0; $id <= $#recCbList; $id++) {
- next unless (defined $recCbList[$id]) && @{$recCbList[$id]->[1]};
- if ($recCbList[$id]->[0] eq $regexp) {
- $recCbList[$id]->[1] = [];
- # on envoie le mesage delregexp
- foreach my $fd (values %sockList) {
- send ($fd, sprintf (MSG_FMT, DELREGEXP, $id), 0)
- or _removeFileDescriptor ($fd);
- }
- }
- }
- }
-}
-
-############### PROCEDURE BIND REGEXP
-sub bindDirect ($$)
-{
- my ($id, $cb) = @_;
-
- if ($cb) {
- # on rajoute la $cb dans la liste des messages
- # qu'on prend
- $directCbList[$id] = $cb;
- } else {
- # on vire le callback
- undef $directCbList[$id];
- }
-}
-
-
-
-############### PROCEDURE SEND MSGS
-sub sendMsgs (@)
-{
- my @msgs = @_;
- my $total = 0;
- # pour tous les messages
- foreach my $msg (@msgs) {
- study ($msg);
-
- # pour routes les connections
- foreach my $fd (keys %sockList) {
-
- # pour toutes les fonctions de filtrage de regexp
- foreach my $regexpFunc (@{$sendRegList{$fd}}) {
- $total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
- }
- }
- }
-# print "DBG> sended $total times\n";
- return $total;
-}
+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"
-############### PROCEDURE SEND MSGS
-sub sendAppNameMsgs (@)
-{
- my @msgs = @_;
- my $total = 0;
- # pour tous les messages
- foreach (@msgs) {
- my $msg = "$appName $_";
- study ($msg);
-
- # pour routes les connections
- foreach my $fd (keys %sockList) {
-
- # pour toutes les fonctions de filtrage de regexp
- foreach my $regexpFunc (@{$sendRegList{$fd}}) {
- $total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
- }
- }
- }
-# print "DBG> sended $total times\n";
- return $total;
-}
-
-
-
-############### PROCEDURE SEND DIRECT MSGS
-sub sendDirectMsgs ($$@)
-{
- my ($to, $id, @msgs) = @_;
-
- if (defined ($appliList{$to})) {
- my @fds = @{$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 _removeFileDescriptor ($fd);
- }
- }
- return 1;
- } else {
- warn "Ivy::sendDirectMsgs appli $to inconnue\n";
- return 0;
- }
-}
-
-
-############### PROCEDURE SEND DIE TO
-sub sendDieTo ($)
-{
- my $to = shift;
-
- if (defined ($appliList{$to})) {
- my @fds = @{$appliList{$to}};
- # pour tous les messages
- foreach my $fd (@fds) {
- _sendDieTo ($fd);
- }
- return 1;
- } else {
- warn "Ivy::sendDieTo appli $to inconnue\n";
- return 0;
- }
-}
-
-
-############### PROCEDURE PING
-sub ping ($$)
-{
- my ($to, $timeout) = @_;
-
- if (defined ($appliList{$to})) {
- my @fds = @{$appliList{$to}};
- # pour tous les messages
- foreach my $fd (@fds) {
- send ($fd, sprintf (MSG_FMT, PING, 0, " "), 0)
- or _removeFileDescriptor ($fd);
- }
- }
-}
-
-
-############### PROCEDURE IVY STOP
-sub stop ()
-{
- # pour toutes les connections
- foreach my $fd (values %sockList) {
- send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0)
- or _removeFileDescriptor ($fd);
- }
-}
-
-
-############### PROCEDURE MAINLOOP
-sub mainLoop ()
-{
- for (;;) {
- my @ready = $localLoopSel->can_read ($smallestTimout) ;
- _scanAfter () ;
- foreach my $fd (@ready) {
- if (ref $localBindByHandle{$fd} eq 'CODE') {
- &{$localBindByHandle{$fd}} ;
- } else {
- my ($cb, @arg) = @{$localBindByHandle{$fd}} ;
- &$cb (@arg)
- }
- }
- }
-}
-
-
-############### PROCEDURE AFTER
-sub after ($$)
-{
- my ($timeAfter, $cbListRef) = @_;
- $timeAfter /= 1000;
- $smallestTimout = $timeAfter if $timeAfter < $smallestTimout;
-
- # 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);
-}
-
-############### PROCEDURE AFTER
-sub repeat ($$)
-{
- # on passe le temps en secondes pour le select
- my ($timeAfter, $cbListRef) = @_;
- $timeAfter /= 1000;
- $smallestTimout = $timeAfter if $timeAfter < $smallestTimout;
-
- $afterList{++$afterId}= [REPEAT, $timeAfter, timeofday()+$timeAfter,
- $cbListRef];
- return ($afterId);
-}
-
-############### PROCEDURE AFTER CANCEL
-sub afterCancel ($)
-{
- my $id = shift;
-
- if (defined ($id) && defined $afterList{$id}) {
- if ($afterList{$id}->[1] <= $smallestTimout) {
- 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;
- $smallestTimout = 10000;
- foreach my $af (values %afterList) {
- $smallestTimout = $af->[1] if $af->[1] < $smallestTimout ;
- }
- } else {
- delete $afterList{$id} ;
- }
- }
-}
-
-sub pruneRegexp (@)
-{
- @topicRegexps = @_;
-}
-
-#############################################################################
-#### PROCEDURES PRIVEE #####
-#############################################################################
+sub stop (); # - envoie un BYE et clot les connections
+sub bindRegexp ($$) ; # permet d'associer une regexp avec un callBack
+ # ou d'annuler une precedente association
-############### PROCEDURE GET BONJOUR
-sub _getBonjour ()
-{
- my $bonjourMsg = '';
-
- # l'hote distant
- my $inetAddr = $supSock->recv ($bonjourMsg, 1024, 0);
- unless (length $inetAddr) {
- warn "recv error, bonjour non traite\n";
- return;
- }
- my $addr = (unpack_sockaddr_in ($inetAddr))[1];
- my $peerName = gethostbyaddr ($addr, AF_INET);
-
- # on force $peerPort a etre vu comme une valeur numerique
- my ($version, $peerPort) = $bonjourMsg =~ /^(\d+)\s+(\d+)/;
+sub bindDirect ($$); # permet d'associer un identifiant de msg direct
+ # avec une fonction de callBack, ou de l'annuler
- unless (defined ($version) && defined ($peerPort)) {
- warn "ERREUR format du message bonjour incorrect\n".
- "message = $bonjourMsg\n" ;
- return;
- }
- if ($version != VERSION) {
- warn "ERREUR VERSION: demande de connexion de $peerName\n".
+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 after ($$); # temps en millisecondes, callback
+ sub repeat ($$); # temps en millisecondes, callback
+ sub fileEvent ($$); # associe un fd a un callback pour la mainloop locale
+ sub pruneRegexp (@); # optimisation : si l'on connait les sujets des messages
+ # qu'on envoie, on appelle cette fonction avec une
+ # liste de sujets, et les regexps qui ne matchent pas
+ # ce sujet sont eliminees Cette fonction doit etre
+ # appelee avant le Ivy::start
+
+ ################ 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
+
+ #############################################################################
+ #### CONSTANTES #####
+ #############################################################################
+ use constant VERSION => 3;
+ use constant MSG_FMT => "%d %d\002%s\n";
+
+ # par defaut, on diffuse le bonjour en local
+ # (sauf pour l'instant, pour rester compatible)
+ #use constant BROADCAST_ADDRS => "127.255.255.255" ;
+ use constant BROADCAST_ADDRS => "143.196.1.255, 143.196.2.255, 143.196.53.255";
+
+ 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 AFTER => 0;
+ use constant REPEAT => 1;
+ #############################################################################
+ #### VARIABLES GLOBALES #####
+ #############################################################################
+ my $messWhenReady; # message a envoyer a un canal lorsqu'on
+ # a recu le message endregexp.
+
+ my $localAddr; # adresse de la machine locale
+
+ my $servPort; # No de port tcp du serveur
+
+ # 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 ;
+
+ my $appName; # Nom de l'appli locale
+
+ my @neededApp; # liste des applis necessaires a l'appli locale
+
+ my $statusFunc; # 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
+
+ my $onDieFunc; # callback prenant en param 1 refs sur une liste :
+ # [ref sur fonction, parametres]
+
+ my $supSock ; # socket de supervision en lecture/ecriture
+ my $connSock; # socket de connexion tcp
+
+ my %sockList = (); # tab ass : nom du fd => fd
+ my %appliList = (); # tab ass : nom de l'appli => fd
+
+ my %sendRegList = (); # 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
+
+ my @topicRegexps = (); # liste des topics qu'on envoie si on
+ # les regexps
+
+ my @recCbList = (); # liste de ref sur des couples
+ # (regexp,callBack) les callbacks
+ # sont appeles lors de
+ # la reception de messages en fonction
+ # du numero de regexp.
+
+ my @directCbList = (); # liste de callBack pour les messages directs
+
+ my %cnnxion = (); # 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
+
+ my %buffByConn = (); # tableau associatif, clef => file desc,
+ # valeur :buffer au cas ou la lacture ne se termine
+ # pas par \n
+
+ my $fileEventFunc; # pointeur sur la fonction permettant d'associer
+ # des callbacks a un file desc, (ainsi que de
+ # les enlever)
+
+
+ my $localLoopSel; # dans le cas ou l'on soit dans une mainLoop
+ # locale, cette var pointe une un objet
+ # de type IO::Select;
+
+ my %localBindByHandle; # table d'ass. handle -> callback
+ my %afterList=(); # tableau d'ass [AFTER ou REPEAT,
+ # timeTotal, deadLine, [callback, arg, arg, ...]]
+
+ my $afterId = 0; #
+
+ my $smallestTimout = 10000; # timeout le plus petit pour le select
+
+ my $maxInstanceOfApp ; # nombre max d'instances de l'appli utilisant
+ # le bus, si il y a deja $maxInstanceOfApp
+ # instances on sort.
+
+ BEGIN {$SIG{'PIPE'} = sub {warn "broken pipe, ignoring ...\n";}}
+
+ #############################################################################
+ #### PROCEDURES PUBLIQUES #####
+ #############################################################################
+
+
+
+ ############### PROCEDURE BUS START
+ sub start (@)
+ {
+ my %options = @_;
+
+ # valeurs par defaut pour le parametre : variable d'environnement
+ # ou valeur cablee, a defaut
+ my $default_domains = $ENV{"IVYDOMAINS"};
+ $default_domains = BROADCAST_ADDRS unless defined ($default_domains);
+ 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)
+ # -broadcastPort => $ENV{"BUS"},
+ # No de port UDP Si non specifie la variable
+ # d'environnement BUS sera examinee
+
+ # -domains => $default_domains,
+ # Liste des domaines ou se fait le broadcast
+ # si non specifie, on utilise la variable
+ # d'environnement ou la valeur par defaut
+
+ -ivyBus => $default_ivyBus,
+ # 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
+
+ -messWhenReady => "_APP NAME READY",
+ # message de synchro a envoyer quand pret
+
+ -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 deux parametres passes sont :
+ # [liste des applis presentes],
+ # [liste des applis absentes]
+
+ -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
+ ) ;
+
+
+ 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::start vous devez specifier ".
+ "l'option $opt\n";
+ }
+ }
+
+ foreach my $opt (keys %options) {
+ die "ERREUR Ivy::start option $opt inconnue\n" unless
+ exists ($defaultOptions{$opt});
+ }
+
+ my $loopMode = $options{-loopMode};
+ # my $broadcastPort = $options{-broadcastPort} ;
+ # my $broadcastAddrs = $options{-domains} ;
+ $ivyBus = $options{-ivyBus} ne "" ? $options{-ivyBus} : undef;
+ my ($broadcastPort,$broadcastAddrs) = _parseIvyBusParam ($options{-ivyBus});
+
+ $appName = $options{-appName} ;
+ $messWhenReady = $options{-messWhenReady} eq "_APP NAME READY" ?
+ "$appName READY" : $options{-messWhenReady};
+ @neededApp = @{$options{-neededApp}} ;
+ $statusFunc = $options{-statusFunc} ;
+ $onDieFunc = $options{-onDieFunc} ;
+
+ 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 "le premier argument (mainloop mode) doit etre TK ou LOCAL\n";
+ }
+
+ # cree la socket de connexion, recupere le no de port
+ $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] ;
+ $cnnxion{"$hostAddr:". $connSock->sockport} = "\004";
+ $cnnxion{"$localhostAddr:". $connSock->sockport} = "\004";
+
+ # cree la socket de broadcast
+ $supSock = IO::Socket::INET->new(LocalPort => $broadcastPort,
+ Proto => 'udp',
+ Type => SOCK_DGRAM,
+ Reuse => 1);
+
+ $supSock->sockopt (SO_BROADCAST, 1);
+
+
+ # et on envoie envoie le bonjour : "no de version no de port"
+ my $bonjourMsg = sprintf ("%d %d\n", VERSION, $connSock->sockport());
+
+ foreach my $netBroadcastAddr (@{$broadcastAddrs}) {
+ send ($supSock, $bonjourMsg, 0, $netBroadcastAddr) or
+ warn "Ivy::start envoi du bonjour a echoue sur $netBroadcastAddr : $!\n";
+ }
+ # callback pour traiter la reception des bonjours
+ &$fileEventFunc ($supSock, \&_getBonjour) ;
+
+ # callback pour traiter les demandes de cxion
+ &$fileEventFunc ($connSock, \&_getConnections) ;
+ }
+
+
+ ############### PROCEDURE BIND REGEXP
+ sub bindRegexp ($$)
+ {
+ my ($regexp, $cb) = @_;
+
+ 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 <= ($#recCbList+1); $id++) {
+ last unless (defined $recCbList[$id]) && @{$recCbList[$id]->[1]};
+ }
+ $recCbList[$id] = [$regexp, $cb];
+
+ # on envoie les messages regexps aux processus deja connectes
+ _sendLastRegexpToAllreadyConnected ($id) ;
+ } else {
+ # on vire le callback, et on se desabonne de cette regexp
+ for (my $id=0; $id <= $#recCbList; $id++) {
+ next unless (defined $recCbList[$id]) && @{$recCbList[$id]->[1]};
+ if ($recCbList[$id]->[0] eq $regexp) {
+ $recCbList[$id]->[1] = [];
+ # on envoie le mesage delregexp
+ foreach my $fd (values %sockList) {
+ send ($fd, sprintf (MSG_FMT, DELREGEXP, $id), 0)
+ or _removeFileDescriptor ($fd);
+ }
+ }
+ }
+ }
+ }
+
+ ############### PROCEDURE BIND REGEXP
+ sub bindDirect ($$)
+ {
+ my ($id, $cb) = @_;
+
+ if ($cb) {
+ # on rajoute la $cb dans la liste des messages
+ # qu'on prend
+ $directCbList[$id] = $cb;
+ } else {
+ # on vire le callback
+ undef $directCbList[$id];
+ }
+ }
+
+
+
+ ############### PROCEDURE SEND MSGS
+ sub sendMsgs (@)
+ {
+ my @msgs = @_;
+ my $total = 0;
+ # pour tous les messages
+ foreach my $msg (@msgs) {
+ study ($msg);
+
+ # pour routes les connections
+ foreach my $fd (keys %sockList) {
+
+ # pour toutes les fonctions de filtrage de regexp
+ foreach my $regexpFunc (@{$sendRegList{$fd}}) {
+ $total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
+ }
+ }
+ }
+ # print "DBG> sended $total times\n";
+ return $total;
+ }
+
+ ############### PROCEDURE SEND MSGS
+ sub sendAppNameMsgs (@)
+ {
+ my @msgs = @_;
+ my $total = 0;
+ # pour tous les messages
+ foreach (@msgs) {
+ my $msg = "$appName $_";
+ study ($msg);
+
+ # pour routes les connections
+ foreach my $fd (keys %sockList) {
+
+ # pour toutes les fonctions de filtrage de regexp
+ foreach my $regexpFunc (@{$sendRegList{$fd}}) {
+ $total += &{$regexpFunc} (\$msg) if defined $regexpFunc;
+ }
+ }
+ }
+ # print "DBG> sended $total times\n";
+ return $total;
+ }
+
+
+
+ ############### PROCEDURE SEND DIRECT MSGS
+ sub sendDirectMsgs ($$@)
+ {
+ my ($to, $id, @msgs) = @_;
+
+ if (defined ($appliList{$to})) {
+ my @fds = @{$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 _removeFileDescriptor ($fd);
+ }
+ }
+ return 1;
+ } else {
+ warn "Ivy::sendDirectMsgs appli $to inconnue\n";
+ return 0;
+ }
+ }
+
+
+ ############### PROCEDURE SEND DIE TO
+ sub sendDieTo ($)
+ {
+ my $to = shift;
+
+ if (defined ($appliList{$to})) {
+ my @fds = @{$appliList{$to}};
+ # pour tous les messages
+ foreach my $fd (@fds) {
+ _sendDieTo ($fd);
+ }
+ return 1;
+ } else {
+ warn "Ivy::sendDieTo appli $to inconnue\n";
+ return 0;
+ }
+ }
+
+
+ ############### PROCEDURE PING
+ sub ping ($$)
+ {
+ my ($to, $timeout) = @_;
+
+ if (defined ($appliList{$to})) {
+ my @fds = @{$appliList{$to}};
+ # pour tous les messages
+ foreach my $fd (@fds) {
+ send ($fd, sprintf (MSG_FMT, PING, 0, " "), 0)
+ or _removeFileDescriptor ($fd);
+ }
+ }
+ }
+
+
+ ############### PROCEDURE IVY STOP
+ sub stop ()
+ {
+ # pour toutes les connections
+ foreach my $fd (values %sockList) {
+ send ($fd, sprintf (MSG_FMT, BYE, 0, ""), 0)
+ or _removeFileDescriptor ($fd);
+ }
+ }
+
+
+ ############### PROCEDURE MAINLOOP
+ sub mainLoop ()
+ {
+ for (;;) {
+ my @ready = $localLoopSel->can_read ($smallestTimout) ;
+ _scanAfter () ;
+ foreach my $fd (@ready) {
+ if (ref $localBindByHandle{$fd} eq 'CODE') {
+ &{$localBindByHandle{$fd}} ;
+ } else {
+ my ($cb, @arg) = @{$localBindByHandle{$fd}} ;
+ &$cb (@arg)
+ }
+ }
+ }
+ }
+
+
+ ############### PROCEDURE AFTER
+ sub after ($$)
+ {
+ my ($timeAfter, $cbListRef) = @_;
+ $timeAfter /= 1000;
+ $smallestTimout = $timeAfter if $timeAfter < $smallestTimout;
+
+ # 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);
+ }
+
+ ############### PROCEDURE AFTER
+ sub repeat ($$)
+ {
+ # on passe le temps en secondes pour le select
+ my ($timeAfter, $cbListRef) = @_;
+ $timeAfter /= 1000;
+ $smallestTimout = $timeAfter if $timeAfter < $smallestTimout;
+
+ $afterList{++$afterId}= [REPEAT, $timeAfter, timeofday()+$timeAfter,
+ $cbListRef];
+ return ($afterId);
+ }
+
+ ############### PROCEDURE AFTER CANCEL
+ sub afterCancel ($)
+ {
+ my $id = shift;
+
+ if (defined ($id) && defined $afterList{$id}) {
+ if ($afterList{$id}->[1] <= $smallestTimout) {
+ 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;
+ $smallestTimout = 10000;
+ foreach my $af (values %afterList) {
+ $smallestTimout = $af->[1] if $af->[1] < $smallestTimout ;
+ }
+ } else {
+ delete $afterList{$id} ;
+ }
+ }
+ }
+
+ sub pruneRegexp (@)
+ {
+ @topicRegexps = @_;
+ }
+
+ #############################################################################
+ #### PROCEDURES PRIVEE #####
+ #############################################################################
+
+
+ ############### PROCEDURE GET BONJOUR
+ sub _getBonjour ()
+ {
+ my $bonjourMsg = '';
+
+ # l'hote distant
+ my $inetAddr = $supSock->recv ($bonjourMsg, 1024, 0);
+ unless (length $inetAddr) {
+ warn "recv error, bonjour non traite\n";
+ return;
+ }
+ my $addr = (unpack_sockaddr_in ($inetAddr))[1];
+ my $peerName = gethostbyaddr ($addr, AF_INET);
+
+ # on force $peerPort a etre vu comme une valeur numerique
+ my ($version, $peerPort) = $bonjourMsg =~ /^(\d+)\s+(\d+)/;
+
+ unless (defined ($version) && defined ($peerPort)) {
+ warn "ERREUR format du message bonjour incorrect\n".
+ "message = $bonjourMsg\n" ;
+ return;
+ }
+ if ($version != VERSION) {
+ warn "ERREUR VERSION: demande de connexion de $peerName\n".
"version courrante : " . VERSION . ", recue : $version\n" ;
return;
}
@@ -1062,4 +1076,57 @@ sub _toBePruned ($$)
}
+############### METHODE 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 = BROADCAST_ADDRS if $ivyNetworks eq '';
+ $ivyNetworks =~ s/ //g;
+ my @broadcastAddrs = split (',', $ivyNetworks);
+
+ foreach my $netAddr (@broadcastAddrs) {
+ # 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);
+}
+
+
1;