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