From: Dirk Koopman <djk@tobit.co.uk>
Date: Fri, 5 Mar 2021 09:41:06 +0000 (+0000)
Subject: fix DXCron, lockout and close_gracefully
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=309eea6bcd4a0eaf25f810168bc38dc348c2a982;p=spider.git

fix DXCron, lockout and close_gracefully

1. Fix DXCron::spawn_cmd so that more than one spawn_cmd can be active at a
   time. This affects many nodes where lots of regular spawn_cmds happen at
   a time and this prevented crucial things like 'start_connect' from working!
2. Sort user lockout issues to cope with all likely scenarios - including
   "phantom" SSID working.
3. Fix "close_gracefully" error messages which are useless, but benign. These
   happen (mainly) when outgoing connects timeout.
---

diff --git a/Changes b/Changes
index 9e81881b..7dce7a01 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,31 @@
+05Mar21=======================================================================
+1. Fix DXCron::spawn_cmd so that more than one spawn_cmd can be active at a 
+   time. This affects many nodes where lots of regular spawn_cmds happen at
+   a time and this prevented crucial things like 'start_connect' from working!
+2. Sort user lockout issues to cope with all likely scenarios - including 
+   "phantom" SSID working.
+3. Fix "close_gracefully" error messages which are useless, but benign. These 
+   happen (mainly) when outgoing connects timeout.
+24Feb21=======================================================================
+1. modify RBN timing arrangements
+    
+   There are two new twiddle pots:
+    
+   $limbotime (default 5*60 secs) which allows potential spots to
+   hang around longer to allow $minqual *different* skimmers to spot
+   them. At which point they are emitted. This is to catch the "slow
+   burning" spots where a call is spotted by different skimmers but
+   separated in time by more than $dwelltime - in fact maybe by
+   minutes.
+    
+   $maxqual (default 9 skimmers) which short circuits the normal
+   hard maximum $quality (9 skimmer spots) and $dwelltime (10secs)
+   to allow a spot that has $maxqual *different* skimmers (usually
+   as the result of a burst from the RBN) to defeat $dwelltime and
+   be emitted the moment that condition is satisfied. There maybe
+   a better name for this.
+21Feb21=======================================================================
+1. add data section on 160m in bands.pl.
 07Sep20=======================================================================
 1, Change interface to watchdbg & grepdbg slightly so that multiple search
    regexes are ANDed rather than ORed together. ORing is easily achieved 
diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index 2ab02967..2a02bfd3 100644
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -288,14 +288,15 @@ sub spawn_cmd
 	my $fc = DXSubprocess->new();
 	$fc->run(
 			 sub {
-				 $main::me->{_nospawn} = 1;
+				 ++$main::me->{_nospawn};
 				 my @res = $main::me->run_cmd($line);
-				 delete $main::me->{_nospawn};
 #				 diffms("DXCron spawn_cmd 1", $line, $t0, scalar @res) if isdbg('chan');
 				 return @res;
 			 },
 			 sub {
 				 my ($fc, $err, @res) = @_; 
+				 --$main::me->{_nospawn};
+				 delete $main::me->{_nospawn} if exists $main::me->{_nospawn} && $main::me->{_nospawn} <= 0;
 				 if ($err) {
 					 my $s = "DXCron::spawn_cmd: error $err";
 					 dbg($s);
@@ -326,8 +327,8 @@ sub rcmd
 sub run_cmd
 {
 	my $line = shift;
-	my @in = $main::me->run_cmd($line);
 	dbg("DXCron::run_cmd: $line") if isdbg('cron');
+	my @in = $main::me->run_cmd($line);
 	for (@in) {
 		s/\s*$//;
 		dbg("DXCron::cmd out: $_") if isdbg('cron');
diff --git a/perl/Messages b/perl/Messages
index 235ee76e..18df6279 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -34,7 +34,7 @@ package DXM;
 				chatinst => 'Entering Chatmode on $_[0], /EX to end, /<cmd> to run a command',
 				chatprompt => 'Chat ($_[0])>',
 				chattoomany => 'Not allowed, already in $_[1], use /chat $_[0]',
-				cluster => 'Nodes: $_[0]/$_[1] Clr - Users: $_[2]/$_[3] Clr Max: $_[4]/$_[5] Clr - Uptime: $_[6]',
+				cluster => 'Nodes: $_[0]/$_[1] Users [Loc/Clr]: $_[2]/$_[3] Max: $_[4]/$_[5] - Uptime: $_[6]',
 				conother => 'Sorry $_[0] you are connected to me on another port',
 				concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster (on $_[1])',
 				contomany => 'Sorry $_[0] but you are already connected to $_[1] other nodes (on $_[2])',
diff --git a/perl/Msg.pm b/perl/Msg.pm
index d0ad7330..13833962 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -320,7 +320,7 @@ sub _close_it
 
 	if ($sock) {
 		dbg((ref $conn) . " Connection $conn->{cnum} $call closing gracefully") if isdbg('connll');
-		$sock->close_gracefully;
+		$sock->close_gracefully if $sock->can('close_gracefully');
 	}
 	
 	# get rid of any references
@@ -570,7 +570,8 @@ sub DESTROY
 	my $sock = $conn->{sock};
 
 	if ($sock) {
-		$sock->close_gracefully;
+		$sock->close_gracefully if $sock->can('close_gracefully');
+		delete $conn->{sock};
 	}
 	
 	$noconns--;
diff --git a/perl/Timer.pm b/perl/Timer.pm
index fb429f64..e0f760b8 100644
--- a/perl/Timer.pm
+++ b/perl/Timer.pm
@@ -23,11 +23,11 @@ sub new
     my ($pkg, $time, $proc, $recur) = @_;
 	my $obj = ref($pkg);
 	my $class = $obj || $pkg;
-	my $self = bless { t=>$time + time, proc=>$proc }, $class;
+	my $self = bless { t=>$time + $main::systime, proc=>$proc }, $class;
 	$self->{interval} = $time if $recur;
 	push @timerchain, $self;
-	$notimers++;
-	dbg("Timer created ($notimers)") if isdbg('connll');
+	$notimers = @timerchain;
+	dbg("Timer created (notimers: $notimers)") if isdbg('connll');
 	return $self;
 }
 
@@ -36,11 +36,13 @@ sub del
 	my $self = shift;
 	delete $self->{proc};
 	@timerchain = grep {$_ != $self} @timerchain;
+	$notimers = @timerchain;
+	dbg("Timer deleted (notimers: $notimers)") if isdbg('connll');
 }
 
 sub handler
 {
-	my $now = time;
+	my $now = $main::systime;
 
 	return unless $now != $lasttime;
 
@@ -59,6 +61,5 @@ sub handler
 sub DESTROY
 {
 	dbg("timer destroyed ($Timer::notimers)") if isdbg('connll');
-	$Timer::notimers--;
 }
 1;
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 07fd6ab5..c9b49182 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -253,16 +253,16 @@ sub new_channel
 		}
 
 		# is he locked out ?
+		my $lock;
 		$user = DXUser::get_current($call);
 		$conn->conns($call);
 		my $basecall = $call;
-		$basecall =~ s/-\d+$//;	# remember this for later multiple user processing
-		my $lock;
+		$basecall =~ s/-\d+$//;	# remember this for later multiple user processing, it's used for other stuff than checking lockout status
 		if ($user) {
 			# make sure we act on any locked status that the actual incoming call has.
 			$lock = $user->lockout;
-		} elsif ($allowmultiple && $call ne $basecall) {
-		    # if we are allowing multiple connections and there is a basecall minus incoming ssid, use the basecall's lock status
+		} elsif ($basecall ne $call) {
+			# if there isn't a SSID on the $call, then try the base
 			$user = DXUser::get_current($basecall);
 			$lock = $user->lockout if $user;
 		}
@@ -749,7 +749,7 @@ sub idle_loop
 			$main::me->disconnect;
 		}
 
-		Mojo::IOLoop->stop if --$ending <= 0;
+		Mojo::IOLoop->stop_gracefully if --$ending <= 0;
 	}
 }