From 0a35942621158fae0bca29f3c70c63a97fc4e691 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Mon, 5 Mar 2001 21:11:15 +0000
Subject: [PATCH] fix simulanious connections

---
 Changes           |  3 +++
 cmd/disconnect.pl |  8 ++------
 perl/DXCron.pm    |  9 +--------
 perl/DXProt.pm    |  5 +----
 perl/ExtMsg.pm    | 10 ++--------
 perl/Msg.pm       | 50 ++++++++++++++++++++++++++++++++++++++++++++---
 perl/cluster.pl   |  9 ++++++---
 7 files changed, 62 insertions(+), 32 deletions(-)

diff --git a/Changes b/Changes
index c261855f..5442857a 100644
--- 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 195cdf8c..9207d73b 100644
--- 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 d3007794..5bb12422 100644
--- 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 42eb6b86..516779b6 100644
--- 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 81b9a1bc..cd18eb93 100644
--- 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 6702f152..7d5b4072 100644
--- 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 50e860d2..bf9aecef 100755
--- 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");
-- 
2.43.0