From 465426f9282b990ec3462c63e5ca7613f92fb290 Mon Sep 17 00:00:00 2001
From: djk <djk>
Date: Thu, 18 Nov 1999 23:49:58 +0000
Subject: [PATCH] force PC39 on ak1a disconnects don't allow overlapping
 connect requests

---
 Changes           | 2 ++
 cmd/connect.pl    | 2 ++
 cmd/disconnect.pl | 2 +-
 perl/DXCron.pm    | 5 +++++
 perl/DXProt.pm    | 2 ++
 perl/Messages     | 1 +
 perl/cluster.pl   | 2 ++
 7 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/Changes b/Changes
index 63460253..ed66380e 100644
--- 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 d4a11d2a..b3b00181 100644
--- 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 02f9f45c..6c038386 100644
--- 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 c0565fa1..d2e434bc 100644
--- 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 67f64b79..b4ff5f65 100644
--- 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 71bbb425..488f861e 100644
--- 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 0e93c4e9..b67b9ff8 100755
--- 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
-- 
2.34.1