try to prevent double connects from semi succeeding and then getting an

abort from DXChannel->new

diff --git a/Changes b/Changes
index 21ab3c66dcd39eb99640d6a9d7ea3bd5a8eb723e..f6c0c42ffb5a47f6b82ecbeaf93545bbddcd35b1 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 14May01=======================================================================
 1. fix problem with re-reading in db definitions for remote databases.
+2. try to prevent situations where two can (semi) successfully login, probably
+under load, and get a 'tried to connect whilst already connected' abort.
 11May01=======================================================================
 1. allow stat/msg on priv 1
 07May01=======================================================================

diff --git a/perl/Msg.pm b/perl/Msg.pm
index ae9c4c28699709a3f34a771d0062568f74323071..8be2fc1bf071d39dd464907de8397da7fdd27891 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -398,7 +398,9 @@ FINISH:
                &{$conn->{eproc}}($conn, $!) if exists $conn->{eproc};
                $conn->disconnect;
     } else {
-               $conn->dequeue if exists $conn->{msg};
+               unless ($conn->{disable_read}) {
+                       $conn->dequeue if exists $conn->{msg};
+               }
        }
 }
 
@@ -444,6 +446,13 @@ sub close_all_clients
        }
 }
 
+sub disable_read
+{
+       my $conn = shift;
+       set_event_handler ($conn->{sock}, read => undef);
+       return $_[0] ? $conn->{disable_read} = $_[0] : $_[0];
+}
+
 #
 #----------------------------------------------------
 # Event loop routines used by both client and server

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 98fdbb187491697c32bccbb5e030bcbf645d489c..d321cba5fcd9b971e4cb048857aa539065daa253 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -110,7 +110,8 @@ $starttime = 0;                 # the starting time of the cluster
 sub already_conn
 {
        my ($conn, $call, $mess) = @_;
-       
+
+       $conn->disable_read(1);
        dbg('chan', "-> D $call $mess\n"); 
        $conn->send_now("D$call|$mess");
        sleep(2);