From 0a35942621158fae0bca29f3c70c63a97fc4e691 Mon Sep 17 00:00:00 2001 From: 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