force PC39 on ak1a disconnects

don't allow overlapping connect requests

diff --git a/Changes b/Changes
index 634602533a96c4ac34f4469e2eb832475a9e1bf8..ed66380e1fd60572764904496e3fe17c039d564f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,8 @@
 connect nodes that fail to respond to 3 ping requests (on the 4th attempt). 
 The default time is a ping every 3 mins, therefore a link will be struck out
 after 12 minutes of nil response.
+2. Maintain a table of outstanding connects to other nodes and prevent over-
+laps (special favour to G0RDI).
 17Nov99=======================================================================
 1. Started using Data::Dumper for things again
 2. 'Fixed' DXUser file corruption?

diff --git a/cmd/connect.pl b/cmd/connect.pl
index d4a11d2ab7b03fb8c3eb15dc8ac8c71b9cccbcce..b3b001819b5067fe49bd0fceeff728f36f7f6cba 100644 (file)
--- a/cmd/connect.pl
+++ b/cmd/connect.pl
@@ -8,6 +8,7 @@ my $lccall = lc $call;
 return (1, $self->msg('e5')) if $self->priv < 5;
 return (1, $self->msg('e6')) unless $call gt ' ';
 return (1, $self->msg('already', $call)) if DXChannel->get($call);
+return (1, $self->msg('outconn', $call)) if grep {$_->{call} eq $call} @main::outstanding_connects;
 return (1, $self->msg('conscript', $lccall)) unless -e "$main::root/connect/$lccall";
 
 my $prog = "$main::root/local/client.pl";
@@ -27,6 +28,7 @@ if (defined $pid) {
                exec $prog, $call, 'connect';
        } else {
                sleep(1);    # do a coordination
+               push @main::outstanding_connects, {call => $call, pid => $pid};
                return(1, $self->msg('constart', $call));
        }
 }

diff --git a/cmd/disconnect.pl b/cmd/disconnect.pl
index 02f9f45cf3088ea8c17ed1f8ba32b7364706e00b..6c038386747ac6c619ab2a45295df3fcbf81ffcd 100644 (file)
--- a/cmd/disconnect.pl
+++ b/cmd/disconnect.pl
@@ -16,7 +16,7 @@ foreach $call (@calls) {
        my $dxchan = DXChannel->get($call);
        if ($dxchan) {
                if ($dxchan->is_ak1a) {
-                       $dxchan->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', $self->call)));
+#                      $dxchan->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', $self->call)));
                } else {
                        return (1, $self->msg('e5')) if $self->priv < 8;
                        $dxchan->send_now('D', $self->msg('disc1', $self->call));

diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index c0565fa1e9e8268b2c3c8aed8719398227f91409..d2e434bcbbd5bc1d1a4555ec7dd101e0d3d729a3 100644 (file)
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -234,6 +234,11 @@ sub start_connect
        my $call = uc shift;
        my $lccall = lc $call;
 
+       if (grep {$_->{call} eq $call} @main::outstanding_connects) {
+               dbg('cron', "Connect not started, outstanding connect to $call");
+               return;
+       }
+       
        my $prog = "$main::root/local/client.pl";
        $prog = "$main::root/perl/client.pl" if ! -e $prog;
        

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 67f64b79064616092577d3cbabab6629a26cc7ca..b4ff5f655f4701be2edcb151be015d5233b6c6cb 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -130,6 +130,8 @@ sub start
        if (!$self->{outbound}) {
                $self->send(pc38()) if DXNode->get_all();
                $self->send(pc18());
+               # remove from outstanding connects queue
+               @main::outstanding_connects = grep {$_->{call} ne $call} @main::outstanding_connects;
        }
        $self->state('init');
        $self->pc50_t(time);

diff --git a/perl/Messages b/perl/Messages
index 71bbb425fb751c1ce7ff9454e960a86c7c6aab0b..488f861e7c9ad90c103f924dd037b6e0d387b353 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -111,6 +111,7 @@ package DXM;
                                nodec => '$_[0] created as AK1A style Node',
                                nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line',
                                ok => 'Operation successful',
+                               outconn => 'Outstanding connect to $_[0]',
                                page => 'Press Enter to continue, A to abort ($_[0] lines) >',
                                pagelth => 'Page Length is now $_[0]',
                                passerr => 'Please use: SET/PASS <password> <callsign>',

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 0e93c4e9fc1c1e250df2d43e99aa4d5abb972a2d..b67b9ff88e98b4c150a29d77dd61897ded2d0370 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -73,6 +73,7 @@ $systime = 0;                                 # the time now (in seconds)
 $version = "1.35";                             # 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
       
 # handle disconnections
 sub disconnect
@@ -229,6 +230,7 @@ sub reap
 {
        $SIG{'CHLD'} = \&reap;
        my $cpid = wait;
+       @outstanding_connects = grep {$_->{pid} != $cpid} @outstanding_connects;
 }
 
 # this is where the input queue is dealt with and things are dispatched off to other parts of