From: Dirk Koopman <djk@tobit.co.uk>
Date: Thu, 1 Dec 2022 14:21:20 +0000 (+0000)
Subject: improve bad word debugging messages
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=61a666ccf108505f0cec2e5c682fde019fc3a051;p=spider.git

improve bad word debugging messages
---

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