fix simulanious connections

diff --git a/Changes b/Changes
index c261855f8c320bce92d0c1e03b48c15b5d10cc26..5442857aab70bd80b6377558b8f59bba15c4d2c9 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+05Mar01=======================================================================
+1. do some major surgery on the connect logic to shorten the possibility of 
+duplicate connects happening
 04Mar01=======================================================================
 1. allow fallback to english for help
 03Mar01=======================================================================

diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl
index 195cdf8c2ae043b9efdf7cb9391a8dc634d5b113..9207d73b930c5833725821538524e1ac51c242c2 100644 (file)
--- a/cmd/disconnect.pl
+++ b/cmd/disconnect.pl
@@ -23,12 +23,8 @@ foreach $call (@calls) {
                } 
                $dxchan->disconnect;
                push @out, $self->msg('disc2', $call);
-       } elsif (my $out = grep {$_->{call} eq $call} @main::outstanding_connects) {
-               unless ($^O =~ /^MS/i) {
-                       kill 'TERM', $out->{pid};
-               }
-               @main::outstanding_connects = grep {$_->{call} ne $call} @main::outstanding_connects;
-               push @out, $self->msg('disc2', $call);
+       } elsif (my $conn = Msg->call($call)) {
+               $conn->disconnect;
        } else {
                push @out, $self->msg('e10', $call);
        }

diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index d300779456931861463060bf80ed80779cb5bc58..5bb1242283d635e7f11b5161a7178b62950a088a 100644 (file)
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -225,13 +225,6 @@ sub disconnect
                } 
                $dxchan->disconnect;
        }
-       my $out = grep {$_->{call} eq $call} @main::outstanding_connects;
-       if ($out) {
-               unless ($^O =~ /^MS/i) {
-                       kill 'TERM', $out->{pid};
-               }
-               @main::outstanding_connects = grep {$_->{call} ne $call} @main::outstanding_connects;
-       }
 }
 
 # start a connect process off
@@ -240,7 +233,7 @@ sub start_connect
        my $call = uc shift;
        my $lccall = lc $call;
 
-       if (grep {$_->{call} eq $call} @main::outstanding_connects) {
+       if (Msg->conns($call)) {
                dbg('cron', "Connect not started, outstanding connect to $call");
                return;
        }

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 42eb6b86731395c8a7f7bc108016b225f41a44d2..516779b67458791266a7d00bd25453d30732b1ad 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -236,13 +236,10 @@ sub start
 
        # send initialisation string
        unless ($self->{outbound}) {
-#              $self->send(pc38()) if DXNode->get_all();
                $self->send(pc18());
                $self->{lastping} = $main::systime;
        } else {
-               # remove from outstanding connects queue
-               @main::outstanding_connects = grep {$_->{call} ne $call} @main::outstanding_connects;
-               $self->{lastping} = $main::systime + $self->pingint / 2;
+               $self->{lastping} = $main::systime + ($self->pingint / 2);
        }
        $self->state('init');
        $self->pc50_t(time);

diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm
index 81b9a1bc33b727798573dc91291e7492b2a33592..cd18eb9318039974b7ae7f95101c7c9aeb534f46 100644 (file)
--- a/perl/ExtMsg.pm
+++ b/perl/ExtMsg.pm
@@ -71,9 +71,8 @@ sub dequeue
                } elsif ($conn->{state} eq 'WL' ) {
                        $msg = uc $msg;
                        if (is_callsign($msg)) {
+                               &{$conn->{rproc}}($conn, "A$msg|telnet");
                                _send_file($conn, "$main::data/connected");
-                               $conn->{call} = $msg;
-                               &{$conn->{rproc}}($conn, "A$conn->{call}|telnet");
                                $conn->{state} = 'C';
                        } else {
                                $conn->send_now("Sorry $msg is an invalid callsign");
@@ -131,12 +130,11 @@ sub start_connect
        my $call = shift;
        my $fn = shift;
        my $conn = ExtMsg->new(\&main::rec); 
-       $conn->{call} = $call;
+       $conn->conns($call);
        
        my $f = new IO::File $fn;
        push @{$conn->{cmd}}, <$f>;
        $f->close;
-       push @main::outstanding_connects, {call => $call, conn => $conn};
        $conn->_dotimeout($deftimeout);
        $conn->_docmd;
 }
@@ -171,9 +169,6 @@ sub _docmd
                }
                last if $conn->{state} eq 'E';
        }
-       unless (exists $conn->{cmd} && @{$conn->{cmd}}) {
-               @main::outstanding_connects = grep {$_->{call} ne $conn->{call}} @main::outstanding_connects;
-       }
 }
 
 sub _doconnect
@@ -261,7 +256,6 @@ sub _timeout
        my $conn = shift;
        dbg('connect', "timed out after $conn->{timeval} seconds");
        $conn->disconnect;
-       @main::outstanding_connects = grep {$_->{call} ne $conn->{call}} @main::outstanding_connects;
 }
 
 # handle callsign and connection type firtling

diff --git a/perl/Msg.pm b/perl/Msg.pm
index 6702f152bc6811334a8cf1f6661791f0d0a2c7b7..7d5b407213ec6bad7c6b743174d9fe84afca88e1 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -13,9 +13,9 @@ package Msg;
 use strict;
 use IO::Select;
 use IO::Socket;
-#use DXDebug;
+use Carp;
 
-use vars qw(%rd_callbacks %wt_callbacks $rd_handles $wt_handles $now @timerchain);
+use vars qw(%rd_callbacks %wt_callbacks $rd_handles $wt_handles $now @timerchain %conns);
 
 %rd_callbacks = ();
 %wt_callbacks = ();
@@ -57,6 +57,40 @@ sub new
        return bless $conn, $class;
 }
 
+# save it
+sub conns
+{
+       my $pkg = shift;
+       my $call = shift;
+       my $ref;
+       
+       if (ref $pkg) {
+               $call = $pkg->{call} unless $call;
+               return undef unless $call;
+               confess "changing $pkg->{call} to $call" if exists $pkg->{call} && $call ne $pkg->{call};
+               $pkg->{call} = $call;
+               $ref = $conns{$call} = $pkg;
+       } else {
+               $ref = $conns{$call};
+       }
+       return $ref;
+}
+
+# this is only called by any dependent processes going away unexpectedly
+sub pid_gone
+{
+       my ($pkg, $pid) = @_;
+       
+       my @pid = grep {$_->{pid} == $pid} values %conns;
+       for (@pid) {
+               if ($_->{rproc}) {
+                       &{$_->{rproc}}($_, undef, "$pid has gorn");
+               } else {
+                       $_->disconnect;
+               }
+       }
+}
+
 #-----------------------------------------------------------------
 # Send side routines
 sub connect {
@@ -93,8 +127,18 @@ sub disconnect {
        $conn->{state} = 'E';
        delete $conn->{cmd};
        $conn->{timeout}->del_timer if $conn->{timeout};
-       return unless defined($sock);
+
+       # be careful to delete the correct one
+       if (my $call = $conn->{call}) {
+               my $ref = $conns{$call};
+               delete $conns{$call} if $ref && $ref == $conn;
+       }
+       
     set_event_handler ($sock, "read" => undef, "write" => undef);
+       unless ($^O =~ /^MS/i) {
+               kill 'TERM', $conn->{pid} if exists $conn->{pid};
+       }
+       return unless defined($sock);
     shutdown($sock, 3);
        close($sock);
 }

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 50e860d29d57899df6289f50b4036e2f1b14f911..bf9aecef411624cdceb339a09e69fc6e83bfdcdf 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -83,7 +83,7 @@ $systime = 0;                                 # the time now (in seconds)
 $version = "1.47";                             # the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
 $lockfn = "cluster.lock";       # lock file name
-@outstanding_connects = ();     # list of outstanding connects
+#@outstanding_connects = ();     # list of outstanding connects
 @listeners = ();                               # list of listeners
 
       
@@ -128,7 +128,7 @@ sub rec
  
                # is there one already connected to me - locally? 
                my $user = DXUser->get($call);
-               if (DXChannel->get($call)) {
+               if ($sort ne 'O' && Msg->conns($call)) {
                        my $mess = DXM::msg($lang, ($user && $user->is_node) ? 'concluster' : 'conother', $call, $main::mycall);
                        already_conn($conn, $call, $mess);
                        return;
@@ -163,6 +163,9 @@ sub rec
                        return;
                }
 
+               # mark him up
+               $conn->conns($call) unless $sort eq 'O';
+               
                # create the channel
                $dxchan = DXCommandmode->new($call, $conn, $user) if $user->is_user;
                $dxchan = DXProt->new($call, $conn, $user) if $user->is_node;
@@ -244,7 +247,7 @@ sub reap
        my $cpid;
        while (($cpid = waitpid(-1, WNOHANG)) > 0) {
                dbg('reap', "cpid: $cpid");
-               @outstanding_connects = grep {$_->{pid} != $cpid} @outstanding_connects;
+#              Msg->pid_gone($cpid);
                $zombies-- if $zombies > 0;
        }
        dbg('reap', "cpid: $cpid");