test validity of socket structure before removing file descriptor when

a read on a socket fails

1 files changed, 63 insertions, 25 deletions

diff --git a/Ivy.pm b/Ivy.pm
index 4d5b9e4..1255952 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -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};