From 5094a0b55d903d344277adf9d26b5af8e37247d8 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 17 Mar 2023 20:21:10 +0000 Subject: [PATCH] attempt to fix myalias/mycall external usurpation Do some housekeeping on startup and ending. Suppress useless warnings caused by uninititalised object handles that are correctly uninitialised caused by error conditions failing prematurely. Fix logdbg to show the type of message in debug. --- Changes | 6 ++++ perl/DXDebug.pm | 8 ++++- perl/DXLog.pm | 7 ++-- perl/DXProtHandle.pm | 19 ++++++++-- perl/QSL.pm | 2 +- perl/RBN.pm | 9 +++-- perl/cluster.pl | 85 +++++++++++++++++++++++--------------------- 7 files changed, 85 insertions(+), 51 deletions(-) diff --git a/Changes b/Changes index 74c07256..840bcdc0 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +17Mar23======================================================================= +1. Try to nail down incoming PC92s that attempt to change the type of $myalias + or $mycall. +2. Do some housekeeping with the startup and finish debugging to make the + order of messaging more logical. Also disable some messaging caused by + other errors/circumstances causing various object handles disappearing. 10Mar23======================================================================= 1. I am aware that there are windows nodes out there on mojo (brave, impetuous that you are) and wget is not an easy option to download badip files. So, diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index f249282e..83e49259 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -28,7 +28,7 @@ use 5.10.1; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose dbgtrace dbgprintring confess croak cluck carp); +@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose dbgtrace dbgprintring dbgsetcat confess croak cluck carp); use strict; use vars qw(%dbglevel $fp $callback $cleandays $keepdays $dbgringlth); @@ -297,6 +297,12 @@ sub dbgclean } } +# force a category for the next (unconditional) dbg message (replace (*) with ()) +sub dbgsetcat +{ + $_isdbg = shift; +} + 1; __END__ diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 439518c2..a332d392 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -220,8 +220,11 @@ sub Log sub LogDbg { my $cat = shift; - DXDebug::dbg($_) for @_; - Log($cat, @_); + foreach my $m (@_) { + DXDebug::dbgsetcat($cat); + DXDebug::dbg($m); + Log($cat, $m); + } } sub Logclose diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index c4f31232..73f13919 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -945,7 +945,7 @@ sub check_add_user $user->node($homenode); $user->priv(0); } - $user->lastin($main::systime); # this make it last longer than just this invocation + $user->lastin($main::systime); # this makes it last longer than just this invocation $user->put; # just to make sure it gets written away!!! dbg("DXProt: PC92 new user record for $call created"); } @@ -1032,6 +1032,12 @@ sub handle_19 next; } + if ($call eq $main::myalias) { + LogDbg('err', "ROUTE: $call eq \$myalias from $self->{call}, ignored!!!"); + dbgprintring(3) if isdbg('nologchan'); + next; + } + my $user = check_add_user($call, 'A'); # if (eph_dup($genline)) { @@ -1807,7 +1813,12 @@ sub _add_thingy $user->del if $user; $call = $normcall; # this is safe because a route add will ignore duplicates } - + + if ($call eq $main::myalias && $is_node) { + LogDbg('err', "ROUTE: $call eq \$myalias from $ncall - downgraded to user!!!"); + dbgprintring(3) if isdbg('nologchan'); + $is_node = 0; + } if ($is_node) { dbg("ROUTE: added node $call to $ncall") if isdbg('routelow'); $user = check_add_user($call, 'A'); @@ -2249,7 +2260,9 @@ sub handle_92 dbg("PCPROT: $self->{call} : type $sort $_->[0] refers to me, ignored") if isdbg('route'); next; } - if ($_->[0] eq $main::myalias && $_->[1] || $_->[0] eq $main::mycall && $_->[1] == 0) { + + my $isnode = ($_->[1] | $_->[2]); + if (($_->[0] eq $main::myalias && $isnode) || ($_->[0] eq $main::mycall && !$isnode)) { LogDbg('err',"PCPROT: $self->{call} : type $sort $_->[0] trying to change type to " . $_->[1]?"Node":"User" . ", ignored"); next; } diff --git a/perl/QSL.pm b/perl/QSL.pm index ec551221..b9f4ee85 100644 --- a/perl/QSL.pm +++ b/perl/QSL.pm @@ -48,7 +48,7 @@ sub init sub finish { dbg("DXQSL finished"); - $dbm->sync; + $dbm->sync if $dbm; undef $dbm; untie %u; } diff --git a/perl/RBN.pm b/perl/RBN.pm index e844b6d6..820f39cb 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -194,7 +194,7 @@ sub start $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type - LogDbg('DXCommand', "$call connected from $self->{hostname}"); + LogDbg('err', "$call connected from $self->{hostname}"); # set some necessary flags on the user if they are connecting $self->{registered} = 1; @@ -369,7 +369,7 @@ sub normal dbg("seeme: result '$buf'") if isdbg('seeme'); $uchan->local_send('S', $buf); } else { - LogDbg("RBN Someone is playing silly persons $rcall is not a user and cannot do 'seeme', ignored and reset"); + LogDbg('err',"RBN Someone is playing silly persons $rcall is not a user and cannot do 'seeme', ignored and reset"); del_seeme($rcall); } } @@ -852,7 +852,7 @@ sub per_minute next unless $dxchan->is_rbn; dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} retrieved spots: $dxchan->{norbn} delivered: $dxchan->{nospot} after filtering to users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats'); if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) { - LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting"); + LogDbg('err', "RBN: no input from $dxchan->{call}, disconnecting"); $dxchan->disconnect; } $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {}; @@ -908,7 +908,10 @@ sub finish sub write_cache { + return unless $json; + my $ta = [ gettimeofday ]; + $json->indent(1)->canonical(1) if isdbg 'rbncache'; my $s = eval {$json->encode($spots)}; if ($s) { diff --git a/perl/cluster.pl b/perl/cluster.pl index b45213a7..7188ed6f 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -552,12 +552,6 @@ sub setup_start # log our path dbg "Perl path: " . join(':', @INC); - # try to load the database - if (DXSql::init($dsn)) { - $dbh = DXSql->new($dsn); - $dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh; - } - # try to load Encode and Git { local $^W = 0; @@ -600,6 +594,36 @@ sub setup_start $SIG{__DIE__} = $w; } + unless ($is_win) { + $SIG{HUP} = 'IGNORE'; + $SIG{CHLD} = sub { $zombies++ }; + + $SIG{PIPE} = sub { dbg("Broken PIPE signal received"); }; + $SIG{IO} = sub { dbg("SIGIO received"); }; + $SIG{WINCH} = $SIG{STOP} = $SIG{CONT} = 'IGNORE'; + $SIG{KILL} = 'DEFAULT'; # as if it matters.... + + # catch the rest with a hopeful message + for (keys %SIG) { + if (!$SIG{$_}) { + # dbg("Catching SIG $_") if isdbg('chan'); + $SIG{$_} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); }; + } + } + } + + + # banner + my ($year) = (gmtime)[5]; + $year += 1900; + LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O started"); + LogDbg('cluster', "Copyright (c) 1998-$year Dirk Koopman G1TLH"); + LogDbg('cluster', "Capabilities: ve7cc rbn"); + + # prime some signals + unless ($DB::VERSION) { + $SIG{INT} = $SIG{TERM} = sub { $ending = 10; }; + } # setup location of motd & issue localdata_mv($motd); @@ -610,12 +634,6 @@ sub setup_start # try to load XML::Simple DXXml::init(); - # banner - my ($year) = (gmtime)[5]; - $year += 1900; - LogDbg('cluster', "DXSpider v$version build $build (git: $gitbranch/$gitversion) using perl $^V on $^O started"); - LogDbg('cluster', "Copyright (c) 1998-$year Dirk Koopman G1TLH"); - LogDbg('cluster', "Capabilities: ve7cc rbn"); # load Prefixes dbg("loading prefixes ..."); @@ -683,35 +701,6 @@ sub setup_start dbg("UDP Listener") if $UDPMsg::enable; UDPMsg::init(\&new_channel); - # load bad words - BadWords::load(); - - # prime some signals - unless ($DB::VERSION) { - $SIG{INT} = $SIG{TERM} = sub { $ending = 10; }; - } - - # get any bad IPs - DXCIDR::init(); - - unless ($is_win) { - $SIG{HUP} = 'IGNORE'; - $SIG{CHLD} = sub { $zombies++ }; - - $SIG{PIPE} = sub { dbg("Broken PIPE signal received"); }; - $SIG{IO} = sub { dbg("SIGIO received"); }; - $SIG{WINCH} = $SIG{STOP} = $SIG{CONT} = 'IGNORE'; - $SIG{KILL} = 'DEFAULT'; # as if it matters.... - - # catch the rest with a hopeful message - for (keys %SIG) { - if (!$SIG{$_}) { - # dbg("Catching SIG $_") if isdbg('chan'); - $SIG{$_} = sub { my $sig = shift; DXDebug::confess("Caught signal $sig"); }; - } - } - } - # start dupe system dbg("Starting Dupe system"); DXDupe::init(); @@ -757,6 +746,13 @@ sub setup_start dbg("Starting DX Spot system"); Spot->init(); + # try to load the spot database if present + if (DXSql::init($dsn)) { + $dbh = DXSql->new($dsn); + $dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh; + } + + # read in any existing message headers and clean out old crap dbg("Reading existing Message/Bulletine headers ..."); DXMsg->init(); @@ -777,6 +773,13 @@ sub setup_start dbg("Starting DXQsl system"); QSL::init(1); + # load bad words + BadWords::load(); + + # get any bad IPs + DXCIDR::init(); + + dbg("Ooing local initialisations ..."); if (defined &Local::init) { eval { -- 2.43.0