From 61a666ccf108505f0cec2e5c682fde019fc3a051 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Thu, 1 Dec 2022 14:21:20 +0000 Subject: [PATCH] improve bad word debugging messages --- Changes | 9 +++++++++ perl/DXCommandmode.pm | 28 ++++++++++++++++------------ perl/DXProtHandle.pm | 43 ++++++++++++++++++++++++++++--------------- perl/cluster.pl | 3 --- 4 files changed, 53 insertions(+), 30 deletions(-) diff --git a/Changes b/Changes index 0cf34afc..fa47aee0 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,12 @@ +01Dec22======================================================================= +1. Re-add some debugging to see which incoming PC protcol sentences are + being dumped because of any bad content (words or calls) if debugging + option 'nologchan' is set. +2. Any line entered by a user is checked for badwords *before* being sent to + the command processing system. +3. All debugging for badwords has the word 'badword' in it. So that one can + do a 'grepdbg -2 badword' and one should see who said it and all of what + they said. 23Nov22======================================================================= 1. The BadWord system has been rewritten. This change is pretty radical and needs to be used with care as a word that is entered will be reduced to the diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 01395c90..f6d890b1 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -259,6 +259,7 @@ sub normal my $self = shift; my $cmdline = shift; my @ans; + my @bad; # save this for them's that need it my $rawline = $cmdline; @@ -345,15 +346,14 @@ sub normal } elsif ($cmdline =~ m|^/+\w+|) { $cmdline =~ s|^/||; my $sendit = $cmdline =~ s|^/+||; - my @in = $self->run_cmd($cmdline); - $self->send_ans(@in); - if ($sendit && $self->{talklist} && @{$self->{talklist}}) { - foreach my $l (@in) { - my @bad; - if (@bad = BadWords::check($l)) { - $self->badcount(($self->badcount||0) + @bad); - LogDbg('DXCommand', "$self->{call} swore: $l with words:" . join(',', @bad) . ")"); - } else { + if (@bad = BadWords::check($cmdline)) { + $self->badcount(($self->badcount||0) + @bad); + LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with words: '" . join(',', @bad) . "'"); + } else { + my @in = $self->run_cmd($cmdline); + $self->send_ans(@in); + if ($sendit && $self->{talklist} && @{$self->{talklist}}) { + foreach my $l (@in) { for (@{$self->{talklist}}) { if ($self->{state} eq 'talk') { $self->send_talks($_, $l); @@ -367,10 +367,9 @@ sub normal $self->send($self->{state} eq 'talk' ? $self->talk_prompt : $self->chat_prompt); } elsif ($self->{talklist} && @{$self->{talklist}}) { # send what has been said to whoever is in this person's talk list - my @bad; if (@bad = BadWords::check($cmdline)) { $self->badcount(($self->badcount||0) + @bad); - LogDbg('DXCommand', "$self->{call} swore: $cmdline with words:" . join(',', @bad) . ")"); + LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with words: '" . join(',', @bad) . "'"); } else { for (@{$self->{talklist}}) { if ($self->{state} eq 'talk') { @@ -402,7 +401,12 @@ sub normal } $self->send_ans(@ans); } else { - $self->send_ans(run_cmd($self, $cmdline)); + if (@bad = BadWords::check($cmdline)) { + $self->badcount(($self->badcount||0) + @bad); + LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with words: '" . join(',', @bad) . "'"); + } else { + $self->send_ans(run_cmd($self, $cmdline)); + } } # check for excessive swearing diff --git a/perl/DXProtHandle.pm b/perl/DXProtHandle.pm index 54ae90e5..a6668a36 100644 --- a/perl/DXProtHandle.pm +++ b/perl/DXProtHandle.pm @@ -94,7 +94,8 @@ sub handle_10 my @bad; if (@bad = BadWords::check($pc->[3])) { my $bw = join ', ', @bad; - dbg("PCPROT: Bad words: '$bw', dropped"); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Badwords: '$bw', dropped"); return; } } @@ -111,7 +112,8 @@ sub handle_10 # if this is a 'nodx' node then ignore it if ($badnode->in($pc->[6]) || ($via && $badnode->in($via))) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Bad Node, dropped"); return; } @@ -119,7 +121,8 @@ sub handle_10 my $nossid = $from; $nossid =~ s/-\d+$//; if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Bad Spotter, dropped"); return; } @@ -164,18 +167,21 @@ sub handle_11 # is the spotted callsign blank? This should really be trapped earlier but it # could break other protocol sentences. Also check for lower case characters. if ($pc->[2] =~ /^\s*$/) { - dbg("PCPROT: blank callsign, dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: blank callsign, dropped"); return; } if ($pc->[2] =~ /[a-z]/) { - dbg("PCPROT: lowercase characters, dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: lowercase characters, dropped"); return; } # if this is a 'nodx' node then ignore it if ($badnode->in($pc->[7])) { - dbg("PCPROT: Bad Node $pc->[7], dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Bad Node $pc->[7], dropped"); return; } @@ -183,7 +189,8 @@ sub handle_11 my $nossid = $pc->[6]; $nossid =~ s/-\d+$//; if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter $pc->[6], dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Bad Spotter $pc->[6], dropped"); return; } @@ -201,7 +208,7 @@ sub handle_11 my $d = cltounix($pc->[3], $pc->[4]); # bang out (and don't pass on) if date is invalid or the spot is too old (or too young) if (!$d || (($pcno == 11 || $pcno == 61) && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) { - dbg("PCPROT: Spot ignored, invalid date or out of range ($pc->[3] $pc->[4])\n") if isdbg('chanerr'); + dbg("PCPROT: Spot ignored, invalid date or out of range ($pc->[3] $pc->[4])\n"); return; } @@ -209,7 +216,7 @@ sub handle_11 if ($baddx->in($pc->[2]) || (my @bad = BadWords::check($pc->[2]))) { my $bw = join ', ', @bad; $bw = qq{ '$bw'} if $bw; - dbg("PCPROT: Bad DX spot$bw, ignored") if isdbg('chanerr'); + dbg("PCPROT: Bad DX spot$bw, ignored"); return; } @@ -224,7 +231,8 @@ sub handle_11 my @bad; if (@bad = BadWords::check($pc->[5])) { my $bw = join ', ', @bad; - dbg("PCPROT: Bad words: '$bw', dropped"); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Badwords: '$bw', dropped"); return; } } @@ -444,14 +452,16 @@ sub handle_12 my @bad; if (@bad = BadWords::check($pc->[3])) { my $bw = join ', ', @bad; - dbg("PCPROT: Bad words: '$bw', dropped"); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Badwords: '$bw', dropped"); return; } } # if this is a 'nodx' node then ignore it if ($badnode->in($pc->[5])) { - dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Bad Node, dropped"); return; } @@ -459,7 +469,8 @@ sub handle_12 my $nossid = $pc->[1]; $nossid =~ s/-\d+$//; if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Bad Spotter, dropped"); return; } @@ -2263,7 +2274,8 @@ sub handle_93 my @bad; if (@bad = BadWords::check($text)) { my $bw = join ', ', @bad; - dbg("PCPROT: Bad words: '$bw', dropped"); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Badwords: '$bw', dropped"); return; } } @@ -2272,7 +2284,8 @@ sub handle_93 my $nossid = $from; $nossid =~ s/-\d+$//; if ($badspotter->in($nossid)) { - dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr'); + dbg($line) if isdbg('nologchan'); + dbg("PCPROT: Bad Spotter, dropped"); return; } diff --git a/perl/cluster.pl b/perl/cluster.pl index baa48ca7..9e5976ee 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -187,9 +187,6 @@ $yes //= 'Yes'; # visual representation of yes $no //= 'No'; # ditto for no $user_interval //= 11*60; # the interval between unsolicited prompts if no traffic - -$clusteraddr //= '127.0.0.1'; # cluster tcp host address - used for things like console.pl -$clusterport //= 27754; # cluster tcp port @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) $starttime = 0; # the starting time of the cluster -- 2.43.0