From 2090157518d0d2da860345507680f4ad91b043a2 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Tue, 26 May 2020 19:53:13 +0100 Subject: [PATCH] fix the issue in DXProt::add_thingy For some reason I wasn't checking whether PC92 routing message was valid enough. I shall probably have to harden it even more still. Also fixed DXDebug::printdbgring(nn) so that actually honours nn! --- cmd/show/debug_ring.pl | 6 ++++-- perl/DXCommandmode.pm | 4 ++-- perl/DXDebug.pm | 14 ++++++++----- perl/DXProtHandle.pm | 46 ++++++++++++++++++++++++------------------ perl/cluster.pl | 11 ++++++---- 5 files changed, 48 insertions(+), 33 deletions(-) diff --git a/cmd/show/debug_ring.pl b/cmd/show/debug_ring.pl index 272da35c..9513b965 100644 --- a/cmd/show/debug_ring.pl +++ b/cmd/show/debug_ring.pl @@ -12,10 +12,12 @@ my $n; my $doclear; for (@args) { + say "arg: $_"; $n = 0+$_ if /^\d+$/; $doclear++ if /^clear$/; } -DXDebug::dbgprintring($n); +my $lines = DXDebug::dbgprintring($n); DXDebug::dbgclearring() if $doclear; +dge; -return (1, 'Contents of debug ring buffer logged. View with watchdbg.'); +return (1, qq{Contents of $lines lines of debug ring buffer logged. View with watchdbg.}); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index a31cc4de..8bb6659e 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -13,7 +13,7 @@ package DXCommandmode; @ISA = qw(DXChannel); -require 5.10.1; +use 5.10.1; use POSIX qw(:math_h); use DXUtil; @@ -835,7 +835,7 @@ sub find_cmd_name { }; #wrap the code into a subroutine inside our unique package - my $eval = qq(package DXCommandmode::$package; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; ); + my $eval = qq(package DXCommandmode::$package; use 5.10.1; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; ); if ($sub =~ m|\s*sub\s+handle\n|) { diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 25d74225..d901c6b5 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -83,7 +83,7 @@ if (!defined $DB::VERSION) { } -my $_isdbg; # current dbg level we are processing +my $_isdbg = ''; # current dbg level we are processing sub dbg { @@ -218,11 +218,13 @@ sub longmess sub dbgprintring { return unless $fp; - my $count = shift; + my $i = shift || 0; + my $count = @dbgring; + $i = @dbgring-$i if $i; + return 0 unless $i < $count; # do nothing if there is nothing to print + my $first; my $l; - my $i = defined $count ? @dbgring-$count : 0; - $count = @dbgring; for ( ; $i < $count; ++$i) { my ($t, $str) = split /\^/, $dbgring[$i], 2; next unless $t; @@ -235,11 +237,13 @@ sub dbgprintring } my $buf = sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0]; $fp->writeunix($lt, "$lt^RING: $buf^$str"); + ++$l; } my $et = time; $fp->writeunix($et, "$et^###"); - $fp->writeunix($et, "$et^### RINGBUFFER END"); + $fp->writeunix($et, "$et^### RINGBUFFER END $l debug lines written"); $fp->writeunix($et, "$et^###"); + return $l; } sub dbgclearring diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index b3278d36..b75d7084 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -1489,30 +1489,36 @@ sub _add_thingy if ($call) { my $ncall = $parent->call; - if ($is_node) { - dbg("ROUTE: added node $call to $ncall") if isdbg('routelow'); - @rout = $parent->add($call, $version, Route::here($here), $ip); - my $r = Route::Node::get($call); - $r->PC92C_dxchan($dxchan->call, $hops) if $r; - if ($ip) { - $r->ip($ip); - Log('DXProt', "PC92A $call -> $ip on $ncall"); + if ($ncall ne $call) { + if ($is_node) { + dbg("ROUTE: added node $call to $ncall") if isdbg('routelow'); + @rout = $parent->add($call, $version, Route::here($here), $ip); + my $r = Route::Node::get($call); + $r->PC92C_dxchan($dxchan->call, $hops) if $r; + if ($ip) { + $r->ip($ip); + Log('DXProt', "PC92A $call -> $ip on $ncall"); + } + } else { + dbg("ROUTE: added user $call to $ncall") if isdbg('routelow'); + @rout = $parent->add_user($call, Route::here($here), $ip); + $dxchan->tell_buddies('loginb', $call, $ncall) if $dxchan; + my $r = Route::User::get($call); + if ($ip) { + $r->ip($ip); + Log('DXProt', "PC92A $call -> $ip on $ncall"); + } } - } else { - dbg("ROUTE: added user $call to $ncall") if isdbg('routelow'); - @rout = $parent->add_user($call, Route::here($here), $ip); - $dxchan->tell_buddies('loginb', $call, $ncall) if $dxchan; - my $r = Route::User::get($call); - if ($ip) { - $r->ip($ip); - Log('DXProt', "PC92A $call -> $ip on $ncall"); + if ($pc92_slug_changes && $parent == $main::routeroot) { + $things_add{$call} = Route::get($call); + delete $things_del{$call}; } - } - if ($pc92_slug_changes && $parent == $main::routeroot) { - $things_add{$call} = Route::get($call); - delete $things_del{$call}; + } else { + dbgprintring(10); + dbg("DXProt::add_thingy: Trying to add parent $call to itself $ncall, ignored"); } } + return @rout; } diff --git a/perl/cluster.pl b/perl/cluster.pl index e13fb034..6bd0c744 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -13,6 +13,7 @@ package main; require 5.10.1; + use warnings; use vars qw($root $is_win $systime $lockfn @inqueue $starttime $lockfn @outstanding_connects @@ -33,7 +34,8 @@ $user_interval = 11*60; # the interval between unsolicited prompts if no traff # make sure that modules are searched in the order local then perl BEGIN { umask 002; - + $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN }; + # take into account any local::lib that might be present eval { require local::lib; @@ -87,14 +89,13 @@ BEGIN { use DXVars; use SysVar; -use strict; - # order here is important - DXDebug snarfs Carp et al so that Mojo errors go into the debug log use DXDebug; - use Mojolicious 7.26; use Mojo::IOLoop; +$DOWARN = 1; + use Msg; use IntMsg; use Internet; @@ -157,6 +158,8 @@ use Web; use vars qw($version $build $gitversion $gitbranch); +use strict; + use Local; -- 2.43.0