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 9e81881b0bce6315156441ec7fa2e4c23ad02c03..7dce7a010381e3f5b062119ee63859c9b90feb2e 100644 (file)
--- 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 2ab02967f8d6dcdf5741af56f3d8525f1bfa1f4a..2a02bfd36f75bb340896dbf103637ca27a6c10d1 100644 (file)
--- 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 235ee76ed0b3de1803f16c784965dffbea1ad3af..18df627918ecd962829ce5d3f27c8c7de7b9ab40 100644 (file)
--- 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 d0ad733048a3c0699d14695ae2263fb48ac80074..13833962d3d316d26f997e8861a431d143bda478 100644 (file)
--- 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 fb429f643537d40cd204b367c93ed5f962cd74df..e0f760b857a576708c60a01d9fe74a6a58b0a73f 100644 (file)
--- 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 07fd6ab594630c0606a48bae4932f3abf38e4d2d..c9b49182d09f9965c7174e295bd833649f514525 100755 (executable)
--- 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;
        }
 }