diff options
Diffstat (limited to 'Ivy.pm')
-rw-r--r-- | Ivy.pm | 88 |
1 files changed, 63 insertions, 25 deletions
@@ -30,7 +30,6 @@ # ################################################################## - package Ivy ; use Sys::Hostname; @@ -42,11 +41,12 @@ use IO::Socket::Multicast; use vars qw($VERSION); use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); +use bytes; # to compute the VERSION from the CVS tag (or if no tag, as the cvs file revision) my $TAG= q$Name: $; my $REVISION = q$Revision$ ; -$VERSION = '1.48' ; # for Makefile.PL +$VERSION = '1.49' ; # for Makefile.PL ($VERSION) = $TAG =~ /^\D*([\d_]+)/ ; if (defined $VERSION and $VERSION ne "_") { $VERSION =~ s/_/\./g; @@ -310,6 +310,8 @@ my %hostNameByAddr = (); my $pingId = 1; # identifiant d'un ping (renvoyé par le pong) +#my $trace; + ############################################################################# #### CLEFS DES VARIABLES D'INSTANCE ##### #### ##### @@ -359,6 +361,7 @@ sub init return; } + srand(); # initialisation du generateur aléatoire qui sert à produire un UUID my $class = shift if (@_ and $_[0] eq __PACKAGE__); my (%options) = @_; @@ -430,6 +433,13 @@ sub init $appName = $options{-appName} ; $onDieFunc = $options{-onDieFunc} ; + + # trace pour le debug + my $verFile = 0; +# while (!open ($trace, , ">>", "/tmp/Ivy_$appName:$verFile.log")) {$verFile++}; +# syswrite ($trace, "DEBUT\n"); + + if (scalar (@{$options{-pruneRegexp}})) { carp "-pruneRegexp is *OBSOLETE*. -filterRegexp should be used instead\n"; $options{-filterRegexp} = $options{-pruneRegexp} unless defined $options{-filterRegexp}; @@ -700,6 +710,7 @@ sub DESTROY ($) # which appeared when upgrading from perl-tk 800.023 to 800.024 $self->[connSock]->close() if ($self->[connSock] and $self->[connSock]->connected()); undef (@$self); +# close ($trace); } # end DESTROY ############### METHODE DE CLASSE STOP @@ -749,7 +760,7 @@ sub start # le nom de machine et 'localhost' my ($n, $al, $t, $l, @hostAddrs) = gethostbyname (hostname()); foreach my $a (@hostAddrs) { - # print STDERR "DBG> I am ", unpack ('CCCC', $a), $connSock->sockport, "\n"; +# syswrite ($trace, ("DBG> I am " . unpack ('CCCC', $a) . $connSock->sockport . "\n")); $self->[cnnxion]->{"$a:". $connSock->sockport} = "\004"; } @@ -1284,11 +1295,11 @@ sub getUuid ($) ############################################################################# -############### METHODE GET BONJOUR +############### METHODE GET BONJOUR sub _getBonjour ($) { my $self = shift; -# my $DTS = sprintf ("%2d:%2d:%2d", (localtime())[2,1,0]); + my $DTS = sprintf ("%2d:%2d:%2d", (localtime())[2,1,0]); my $bonjourMsg = ''; @@ -1310,8 +1321,8 @@ sub _getBonjour ($) $bonjourMsg =~ /^(\d+)\s+(\d+)(?:\s+(\S+)\s+(.*))?\n/; $udpAppName = 1 unless defined $udpAppName; - # printf STDERR ("DBG<$DTS>[$appName]> bonjourMsg = '$bonjourMsg'\n"); - # printf STDERR ("DBG<$DTS>[$appName]> reception de $peerName : bonjour $peerPort uuid = $uuid\n"); +# syswrite ($trace, "DBG<$DTS>[$appName]> bonjourMsg = '$bonjourMsg'\n"); +# syswrite ($trace, "DBG<$DTS>[$appName]> reception de $peerName : bonjour $peerPort uuid = $uuid\n"); unless (defined ($version) && defined ($peerPort)) { carp "Warning[$appName] in Ivy::_getBonjour, ill-formed Hello message \"$bonjourMsg\"" ; @@ -1329,19 +1340,19 @@ sub _getBonjour ($) # 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 STDERR "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort [$udpAppName]: DEJA CONNECTE\n" ; +# syswrite ($trace, "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort [$udpAppName]: DEJA CONNECTE\n") ; return ; } elsif ((defined $uuid) && ($uuid eq $self->[uuid])) { - # print STDERR "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort [$udpAppName]: $uuid c'est MOI\n" ; +# syswrite ($trace, "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort [$udpAppName]: $uuid c'est MOI\n") ; return; } elsif ((defined $uuid) && (exists ($self->[connectedUuid]->{$uuid}))) { - # print STDERR "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort:$uuid [$udpAppName] DEJA CONNECTE\n" ; +# syswrite ($trace, "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort:$uuid [$udpAppName] DEJA CONNECTE\n") ; return; } else { -# print STDERR "DBG<$DTS>[$appName]> reception de $peerName : bonjour $udpAppName:$peerPort" ; -# print STDERR " uuid=$uuid" if (defined $uuid); -# print STDERR ("\n"); -# print STDERR "DBG<$DTS>>[$appName] from $self->[appName] ACCEPT bonjour de $peerName:$peerPort:$uuid [$udpAppName]\n" ; +# syswrite ($trace, "DBG<$DTS>[$appName]> reception de $peerName : bonjour $udpAppName:$peerPort") ; +# syswrite ($trace, " uuid=$uuid") if (defined $uuid); +# syswrite ($trace, "\n"); +# syswrite ($trace, "DBG<$DTS>>[$appName] from $self->[appName] ACCEPT bonjour de $peerName:$peerPort:$uuid [$udpAppName]\n") ; $self->[connectedUuid]->{$uuid} = 1 if (defined $uuid); } @@ -1388,6 +1399,13 @@ sub _getBonjour ($) $self->[bufRecByCnnx]{$appSock} = ''; $self->[bufEmiByCnnx]{$appSock} = ''; $self->[sockList]{$appSock} = $appSock; + + +# syswrite ($trace, sprintf ("_getBonjour : ajout dans le fdset de %s[%s]:%d\n", +# (gethostbyaddr ($appSock->peeraddr(),AF_INET))[0], +# join (':', unpack ('C4', $appSock->peeraddr())), +# $appSock->peerport())); + &$fileEventFunc ($appSock, [\&_getMessages, $self, $appSock]) ; # on balance les regexps qui nous interessent a l'appli distante @@ -1419,9 +1437,10 @@ sub _getConnections ($) } -# printf "accepting connection from %s:%d\n", -# (gethostbyaddr ($appSock->peeraddr(),AF_INET))[0], -# $appSock->peerport() if $^W; +# syswrite ($trace, sprintf ("_getConnections : ajout dans le fdset de %s[%s]:%d\n", +# (gethostbyaddr ($appSock->peeraddr(),AF_INET))[0], +# join (':', unpack ('C4', $appSock->peeraddr())), +# $appSock->peerport())); # callback pour traiter la reception des messages @@ -1447,9 +1466,13 @@ sub _getMessages ($$) my $nlIndex; my $mess; - # on recupere le message -# my $status = recv ($appSock, $buffer, 1048576, 0) ; +# syswrite ($trace, sprintf ("_getMessages from %s[%s]:%d\n", +# (gethostbyaddr ($appSock->peeraddr(),AF_INET))[0], +# join (':', unpack ('C4', $appSock->peeraddr())), +# $appSock->peerport())); + + # on recupere le message unless (sysread ($appSock, $$bufferRef, 65536, length ($$bufferRef))) { # message null : broken pipe, ça s'est deconnecte a l'autre bout # on vire ce fd de la boucle d'evenements @@ -1457,20 +1480,17 @@ sub _getMessages ($$) # Bon la il faudra un jour clarifier ce bordel, lister toutes # les facons dont un couple d'applis connectées peuvent sortir et # eviter les dead lock qui doivent subsister. +# syswrite ($trace, sprintf ("_getMessage : bad FD[%d] detected errno=%d\n", $appSock->peerport(), $!)); $self->_removeFileDescriptor ($appSock, '_getMessages') unless ($!{EAGAIN}); return; } - # if (defined $appSock->peername) { $addr = $appSock->peeraddr(); $peerPort = $appSock->peerport() ; $senderName = $self->[cnnxion]{"$addr:$peerPort"} ; $senderName = "NONAME" unless $senderName; $senderName =~ s/^\004//g; -# my @messages = split ('\n', $$bufferRef) ; -# $$bufferRef = ($$bufferRef =~ /\n$/) ? '': pop (@messages) ; -# foreach $mess (@messages) { while (($nlIndex= index ($$bufferRef, "\n")) > 0) { $mess = substr ($$bufferRef, 0, $nlIndex, ''); substr ($$bufferRef, 0, 1, ''); @@ -1484,6 +1504,8 @@ sub _getMessages ($$) # si ca a chie on rale (carp "Warning in Ivy::_getMessages, ill-formated message \'$mess\'" and return) unless defined $type ; +# syswrite ($trace, "_getMessage type = $type\n"); + # sinon on fait en fonction du type de message if ($type == MSG) { # M S G # on recupere le couple call back, regexp correspondant @@ -1522,7 +1544,7 @@ sub _getMessages ($$) } elsif ($type == BYE) { - #print "reception d'un bye\n"; +# syswrite ($trace, "reception d'un bye\n"); $self->_removeFileDescriptor ($appSock, '_getMessages[BYE]'); # B Y E } @@ -1732,6 +1754,13 @@ sub _removeFileDescriptor ($$$) { my ($self, $fd, $callBy) = @_; + unless (defined $fd) { +# syswrite ($trace, "_removeFileDescriptor : *UN*inititialized fd, don't do anything\n"); + return; + } + + + # on s'est deja occupe de lui return unless exists $self->[sockList]->{$fd}; my $diedAppName = _getNameByFileDes ($self, $fd); @@ -1741,6 +1770,14 @@ sub _removeFileDescriptor ($$$) # uniquement si on est dans le thread principal # sinon le select merde salement sur ce coup my $peerPort = $fd->peerport() ; + if ($peerPort == 0) { +# syswrite ($trace, "_removeFileDescriptor : peerport is NULL, don't do anything\n"); + return; + } +# syswrite ($trace, sprintf ("_removeFileDescriptor : suppression dans le fdset de %s[%s]:%d\n", +# (gethostbyaddr ($fd->peeraddr(),AF_INET))[0], +# join (':', unpack ('C4', $fd->peeraddr())), +# $fd->peerport())); &$fileEventFunc ($fd, '') ; delete $self->[sendRegList]->{$fd}; delete $self->[sockList]->{$fd}; @@ -1763,7 +1800,8 @@ sub _removeFileDescriptor ($$$) return; } - #printf "DBG> _removeFileDescriptor : deconnection de %s ($diedAppName)\n", _inetAdrByName ($diedAppName); +# syswrite ($trace, +# sprintf ("DBG> _removeFileDescriptor : deconnection de %s ($diedAppName)\n", $self->_inetAdrByName ($diedAppName))); delete $self->[cnnxion]{$addrInet}; delete $nameByHandle{$fd}; |