* add traces on disconnect

* force socket on raw mode
* when read or write returns error, examine errno before closing connexion

1 files changed, 38 insertions, 33 deletions

diff --git a/Ivy.pm b/Ivy.pm
index e128c3a..ac58aba 100644
--- a/Ivy.pm
+++ b/Ivy.pm
@@ -141,7 +141,7 @@ 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 _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)
@@ -683,7 +683,7 @@ sub DESTROY ($)
     # the 2 next lines works. This has to been validated! CM 21/12/2000
     if (defined $fd) {
       _univSend ($self, $fd, sprintf (MSG_FMT, BYE, 0, ""));
-      $self->_removeFileDescriptor ($fd);
+      $self->_removeFileDescriptor ($fd, 'DESTROY');
     }
   }
 
@@ -743,7 +743,7 @@ sub start
     # cree la socket de connexion, recupere le no de port
     my $connSock = $self->[connSock] = IO::Socket::INET->new(Listen => 128,
 							     Proto    => 'tcp',
-							     Reuse   => 1) ;
+							     ReuseAddr   => 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'
@@ -766,7 +766,8 @@ sub start
 	    (LocalPort  => $self->[broadcastPort],
 	     Proto      => 'udp',
 	     Type       => SOCK_DGRAM,
-	     ReusePort  => 1);
+	     ReuseAddr      => 1);
+
 	$self->[supSock]->sockopt (SO_BROADCAST, 1);
 	foreach my $netBroadcastAddr (@{$self->[broadcastBuses]}) {
 #	    print "BroadcastBus: --", $netBroadcastAddr, "--\n";
@@ -778,7 +779,7 @@ sub start
 	# creating the multicast socket
 	$self->[supSock] = IO::Socket::Multicast->new
 	    (LocalPort  => $self->[broadcastPort],
-	     ReusePort  => 1);
+	     ReuseAddr  => 1);
 
 	# Multicast datagrams with initial TTL 0 are restricted to the same host.
 	# Multicast datagrams with initial TTL 1 are restricted to the same subnet.
@@ -1153,7 +1154,7 @@ sub mainLoop (;$)
       } elsif ($sent >= 0) {
 	substr ($$bufEmiRef, 0, $sent, '');
       } else {
-	$self->_removeFileDescriptor ($fd) ;
+	$self->_removeFileDescriptor ($fd, 'mainLoop[WRITE]') unless ($!{EAGAIN} || $!{EWOULDBLOCK}|| $!{EINTR} || $!{EMSGSIZE} || $!{ENOBUFS})
       }
     }
   }
@@ -1287,6 +1288,7 @@ sub getUuid ($)
 sub _getBonjour ($)
 {
   my $self = shift;
+#  my $DTS = sprintf ("%2d:%2d:%2d", (localtime())[2,1,0]);
 
   my $bonjourMsg = '';
 
@@ -1308,16 +1310,16 @@ sub _getBonjour ($)
     $bonjourMsg =~ /^(\d+)\s+(\d+)(?:\s+(\S+)\s+(.*))?\n/;
 
   $udpAppName = 1 unless defined $udpAppName;
-#  printf ("DEBUG : bonjourMsg = '$bonjourMsg'\n");
-#  printf ("DEBUG : reception de $peerName : bonjour $peerPort uuid = $uuid\n");
+ #  printf STDERR ("DBG<$DTS>[$appName]> bonjourMsg = '$bonjourMsg'\n");
+ #  printf STDERR ("DBG<$DTS>[$appName]> reception de $peerName : bonjour $peerPort uuid = $uuid\n");
 
   unless (defined ($version) && defined ($peerPort)) {
-    carp "Warning in Ivy::_getBonjour, ill-formed Hello message \"$bonjourMsg\"" ;
+    carp "Warning[$appName] in Ivy::_getBonjour, ill-formed Hello message \"$bonjourMsg\"" ;
     return;
   }
 
   if ($version != IVY_PROTOCOLE_VERSION) {
-    carp "Warning in Ivy::_getBonjour,  connection request from ".
+    carp "Warning[$appName] in Ivy::_getBonjour,  connection request from ".
 	"$peerName with protocol version $version,\ncurrent version is " .
 	IVY_PROTOCOLE_VERSION ;
     return;
@@ -1327,19 +1329,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 "DBG> from $self->[appName] DISCARD bonjour de $peerName:$peerPort [$udpAppName]: DEJA CONNECTE\n" ;
+   #  print STDERR "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort [$udpAppName]: DEJA CONNECTE\n" ;
     return ;
   } elsif ((defined $uuid) && ($uuid eq $self->[uuid])) {
-#    print "DBG> from $self->[appName] DISCARD bonjour de $peerName:$peerPort [$udpAppName]: $uuid  c'est MOI\n" ;
+   #  print STDERR "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 "DBG> from $self->[appName] DISCARD bonjour de $peerName:$peerPort:$uuid [$udpAppName] DEJA CONNECTE\n" ;
+   #  print STDERR "DBG<$DTS>[$appName]> from $self->[appName] DISCARD bonjour de $peerName:$peerPort:$uuid [$udpAppName] DEJA CONNECTE\n" ;
     return;
   } else {
-#     print "DBG> reception de $peerName : bonjour $udpAppName:$peerPort" ;
-#     print " uuid=$uuid" if (defined $uuid);
-#     print ("\n");
-#    print "DBG> from $self->[appName]  ACCEPT bonjour de $peerName:$peerPort:$uuid [$udpAppName]\n" ;
+#      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" ;
     $self->[connectedUuid]->{$uuid} = 1 if (defined $uuid);
   }
 
@@ -1355,12 +1357,12 @@ sub _getBonjour ($)
   push (@ivyBusAddrList, pack ("CCCC", 127,255,255,255));
   push (@ivyBusAddrList, (gethostbyname (hostname()))[4]);
     foreach my $ivyBusAddr (@ivyBusAddrList) {
-    $addrInIvyBus = 1 unless (grep ($_ != 0, unpack ("CCCC",
+    $addrInIvyBus = 1 unless (grep ($_ != 0, unpack ("C4",
 			      ($addr & $ivyBusAddr) ^ $addr)));
   }
 
   if ($addrInIvyBus == 0) {
-    carp "Warning: Hello message from $peerName ignored,\n".
+    carp "Warning[$appName]: Hello message from $peerName ignored,\n".
 	"this guy is outside our emission zone\n" if $^W;
     return;
   }
@@ -1373,10 +1375,11 @@ sub _getBonjour ($)
   if ($appSock) {
     my $flags = fcntl($appSock, F_GETFL, 0);
     unless (fcntl($appSock, F_SETFL, $flags | O_NONBLOCK)) {
-      carp "Can't set flags for the socket: $!\n";
+      carp "Warning[$appName] Can't set flags for the socket: $!\n";
       return;
     }
 
+    binmode ($appSock, ':raw');
     # on cree une entree pour $appSock dans la liste des regexp
     $nameByHandle{$appSock}=_getHostByAddr($addr) .":$peerPort";
     $self->[cnnxion]{"$addr:$peerPort"} = $udpAppName;
@@ -1390,7 +1393,7 @@ sub _getBonjour ($)
     # on balance les regexps qui nous interessent a l'appli distante
     $self->_sendWantedRegexp ($appSock);
   }  else {
-    carp "Warning in Ivy::_getBonjour, connection to " .
+    carp "Warning[$appName] in Ivy::_getBonjour, connection to " .
       "$peerName:$peerPort is impossible" ;
   }
 } # end _getBonjour
@@ -1411,6 +1414,7 @@ sub _getConnections ($)
     unless (fcntl($appSock, F_SETFL, $flags | O_NONBLOCK)) {
       carp "Can't set flags for the socket: $!\n";
       return;
+      binmode ($appSock, ':raw');
     }
   }
 
@@ -1453,7 +1457,7 @@ 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.
-      $self->_removeFileDescriptor ($appSock);
+      $self->_removeFileDescriptor ($appSock, '_getMessages') unless ($!{EAGAIN});
       return;
     }
 
@@ -1519,7 +1523,7 @@ sub _getMessages ($$)
 
       elsif ($type == BYE) {
 	#print "reception d'un bye\n";
-	$self->_removeFileDescriptor ($appSock);		        # B Y E
+	$self->_removeFileDescriptor ($appSock, '_getMessages[BYE]');		        # B Y E
       }
 
       elsif ($type == REGEXP) {			        # R E G E X P
@@ -1724,9 +1728,9 @@ sub _inetAdrByName ($$) {
 
 
 ############### PROCEDURE	REMOVE FILE DESCRIPTOR
-sub _removeFileDescriptor ($$)
+sub _removeFileDescriptor ($$$)
 {
-  my ($self, $fd) = @_;
+  my ($self, $fd, $callBy) = @_;
 
   # on s'est deja occupe de lui
   return unless exists $self->[sockList]->{$fd};
@@ -1736,17 +1740,17 @@ sub _removeFileDescriptor ($$)
   # 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
-  my $peerPort = $fd->peerport() ;  
+  my $peerPort = $fd->peerport() ;
   &$fileEventFunc ($fd, '') ;
-  delete $self->[sendRegList]{$fd};
-  delete $self->[sockList]{$fd};
+  delete $self->[sendRegList]->{$fd};
+  delete $self->[sockList]->{$fd};
   delete $self->[bufRecByCnnx]->{$fd};
   delete $self->[bufEmiByCnnx]->{$fd};
 
   $fd->close();
 
   unless (defined $diedAppName) {
-    warn "Ivy::__removeFileDescriptor : disconnection of NONAME\n" if $^W;
+    warn "Ivy::__removeFileDescriptor (called by $callBy) : disconnection of NONAME\n" if $^W;
     return;
   }
 
@@ -1754,7 +1758,7 @@ sub _removeFileDescriptor ($$)
 			keys %{$self->[cnnxion]}))[0];
 
   unless (defined $addrInet) {
-    carp "Warning in Ivy::_removeFileDescriptor, disconnection of $diedAppName with ".
+    carp "Warning in Ivy::_removeFileDescriptor (called by $callBy) : disconnection of $diedAppName with ".
       "addrInet not defined\n";
     return;
   }
@@ -1842,7 +1846,7 @@ sub _sendMsgTo ($$\$)
 	select (undef, $win, undef, undef);
       }
     } else {
-      $self->_removeFileDescriptor ($fd) ;
+      $self->_removeFileDescriptor ($fd, '_sendMsgTo') ;
     }
   }
 
@@ -1878,7 +1882,7 @@ sub _univSend ($$$)
       select (undef, $win, undef, undef);
     }
   } else {
-    $self->_removeFileDescriptor ($fd) ;
+    $self->_removeFileDescriptor ($fd, '_univSend') unless ($!{EAGAIN} || $!{EWOULDBLOCK}|| $!{EINTR} || $!{EMSGSIZE} || $!{ENOBUFS})
   }
 }
 
@@ -2132,7 +2136,8 @@ sub _callCongestionCb ($$$)
 		       } elsif ($sent >= 0) {
 			 substr ($$bufEmiRef, 0, $sent, '');
 		       } else {
-			 $self->_removeFileDescriptor ($fd) ;
+			 $self->_removeFileDescriptor ($fd, '_callCongestionCb') unless ($!{EAGAIN} || $!{EWOULDBLOCK}|| 
+											 $!{EINTR} || $!{EMSGSIZE} || $!{ENOBUFS});
 		       }
 		     });
     } else {