improve bad word debugging messages

diff --git a/Changes b/Changes
index 0cf34afc2a007a9c8aa1528315252f2ad09c016d..fa47aee0dc1e919fa88c2fd56aa1e36783aae570 100644 (file)
--- 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 01395c9052a52c429b2a27e547b608a575294689..f6d890b17c5919eb74254854fa7d77aea04b1c9f 100644 (file)
--- 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 54ae90e59d57a0cf8c3816298ac8923801d4bb05..a6668a36db0daeef1752d86b796d4dcaf7d82e18 100644 (file)
--- 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 baa48ca704bd5433a89ed433a76d94b64552a7d4..9e5976ee92686250a80f53dba340a14380c57101 100755 (executable)
--- 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