From 8e0eef80216fbb2bca3606daf5797e39b2889d7a Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Sat, 2 Sep 2000 15:28:14 +0000
Subject: [PATCH] fix a talk bug for t xxx > yyy added badword checking

---
 Changes              | 11 +++++++++
 cmd/announce.pl      |  6 ++++-
 cmd/dx.pl            |  6 +++--
 cmd/load/badwords.pl |  7 ++++++
 cmd/talk.pl          |  4 ++++
 perl/AnnTalk.pm      |  2 ++
 perl/BadWords.pm     | 54 ++++++++++++++++++++++++++++++++++++++++++++
 perl/DXProt.pm       | 32 ++++++++++++++++++++------
 perl/DXProtout.pm    |  3 +++
 perl/Messages        |  1 +
 perl/cluster.pl      |  4 ++++
 11 files changed, 120 insertions(+), 10 deletions(-)
 create mode 100644 cmd/load/badwords.pl
 create mode 100644 perl/BadWords.pm

diff --git a/Changes b/Changes
index 8e5d14b5..7d534247 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,14 @@
+02Sep00=======================================================================
+1. fix a long standing talk bug to do with routing to specific nodes (t xxx >
+yyy .....)
+2. Add badwords checking in various places. You put a list of words into
+/spider/data/badwords one or several per line. Lines starting with # are
+ignored. PC10, PC11, PC12 with words contained in this file will not be
+sent on. Also ann, talk and dx commands have badword checking added. Words
+are NOT case sensitive, but you will need to put all the endings in (eg 
+...k, ...ker, ...king).
+01Sep00=======================================================================
+1. allow blank on field 4 of PC10 (even though it's "illegal").
 28Aug00=======================================================================
 1. changes DXChannel::get_all_ak1a to get_all_nodes.
 2. ignore PC21s coming in on the interface with that callsign (ie nodes 
diff --git a/cmd/announce.pl b/cmd/announce.pl
index 494cd9dd..6eb1810e 100644
--- a/cmd/announce.pl
+++ b/cmd/announce.pl
@@ -46,11 +46,15 @@ if ($sort eq "FULL") {
 # change ^ into : for transmission
 $line =~ s/\^/:/og;
 
+my @bad;
+if (@bad = BadWords::check($line)) {
+	return (1, $self->msg('e17', @bad));
+}
+
 return (1, $self->msg('dup')) if AnnTalk::dup($from, $to, $line);
 Log('ann', $to, $from, $line);
 DXProt::broadcast_list("To $to de $from <$t>: $line", 'ann', undef, @locals);
 if ($to ne "LOCAL") {
-  $line =~ s/\^//og;    # remove ^ characters!
   my $pc = DXProt::pc12($from, $line, $tonode, $sysopflag, 0);
   DXProt::broadcast_ak1a($pc);
 }
diff --git a/cmd/dx.pl b/cmd/dx.pl
index 75ba77dc..3f366dff 100644
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -93,8 +93,10 @@ if ($spotted le ' ') {
 
 return (1, @out) unless $valid;
 
-# change ^ into : for transmission
-$line =~ s/\^/:/og;
+my @bad;
+if (@bad = BadWords::check($line)) {
+	return (1, $self->msg('e17', @bad));
+}
 
 # Store it here (but only if it isn't baddx)
 if (grep $_ eq $spotted, @DXProt::baddx) {
diff --git a/cmd/load/badwords.pl b/cmd/load/badwords.pl
new file mode 100644
index 00000000..06d9c063
--- /dev/null
+++ b/cmd/load/badwords.pl
@@ -0,0 +1,7 @@
+# reload the badwords file
+my $self = shift;
+my @out;
+return (1, $self->msg('e5')) if $self->priv < 9;
+push @out, (BadWords::load());
+@out = ($self->msg('ok')) unless @out;
+return (1, @out); 
diff --git a/cmd/talk.pl b/cmd/talk.pl
index 1f6d1551..8082e240 100644
--- a/cmd/talk.pl
+++ b/cmd/talk.pl
@@ -38,6 +38,10 @@ return (1, $self->msg('e7', $call)) unless $dxchan;
 # if there is a line send it, otherwise add this call to the talk list
 # and set talk mode for command mode
 if ($line) {
+	my @bad;
+	if (@bad = BadWords::check($line)) {
+		return (1, $self->msg('e17', @bad));
+	}
 	$dxchan->talk($self->call, $to, $via, $line) if $dxchan;
 } else {
 	my $s = $to;
diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm
index 383e7155..34185745 100644
--- a/perl/AnnTalk.pm
+++ b/perl/AnnTalk.pm
@@ -13,12 +13,14 @@ use strict;
 use DXUtil;
 use DXDebug;
 use DXDupe;
+use DXVars;
 
 use vars qw(%dup $duplth $dupage);
 
 $duplth = 60;					# the length of text to use in the deduping
 $dupage = 5*24*3600;			# the length of time to hold spot dups
 
+
 # enter the spot for dup checking and return true if it is already a dup
 sub dup
 {
diff --git a/perl/BadWords.pm b/perl/BadWords.pm
new file mode 100644
index 00000000..ff9dd04c
--- /dev/null
+++ b/perl/BadWords.pm
@@ -0,0 +1,54 @@
+#
+# Search for bad words in strings
+#
+# Copyright (c) 2000 Dirk Koopman
+#
+# $Id$
+#
+
+package BadWords;
+
+use strict;
+
+use DXUtil;
+use DXVars;
+use IO::File;
+
+use vars qw(%badwords $fn);
+
+$fn = "$main::data/badwords";
+%badwords = ();
+
+# load the badwords file
+sub load
+{
+	my @out;
+	return unless -e $fn;
+	my $fh = new IO::File $fn;
+	
+	if ($fh) {
+		%badwords = ();
+		while (<$fh>) {
+			chomp;
+			next if /^\s*\#/;
+			my @list = split " ";
+			for (@list) {
+				$badwords{lc $_}++;
+			}
+		}
+		$fh->close;
+	} else {
+		my $l = "can't open $fn $!";
+		dbg('err', $l);
+		push @out, $l;
+	}
+	return @out;
+}
+
+# check the text against the badwords list
+sub check
+{
+	return grep { $badwords{$_} } split(/\b/, lc shift);
+}
+
+1;
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index e2c1dae4..cd731a21 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -29,6 +29,7 @@ use AnnTalk;
 use Geomag;
 use WCY;
 use Time::HiRes qw(gettimeofday tv_interval);
+use BadWords;
 
 use strict;
 use vars qw($me $pc11_max_age $pc23_max_age
@@ -294,20 +295,25 @@ sub normal
 	
  SWITCH: {
 		if ($pcno == 10) {		# incoming talk
-			
+
+			# will we allow it at all?
+			my @bad;
+			if (@bad = BadWords::check($field[3])) {
+				dbg('chan', "Bad words: @bad, dropped" );
+				return;
+			}
+
 			# is it for me or one of mine?
 			my ($to, $via, $call, $dxchan);
 			if ($field[5] gt ' ') {
 				$call = $via = $field[2];
 				$to = $field[5];
-				unless (is_callsign($to)) {
-					dbg('chan', "Corrupt talk, rejected");
-					return;
-				}
 			} else {
 				$call = $to = $field[2];
 			}
-			if ($dxchan = DXChannel->get($call)) {
+			$dxchan = DXChannel->get($call);
+			if ($dxchan && $dxchan->is_user) {
+				$field[3] =~ s/\%5E/^/g;
 				$dxchan->talk($field[1], $to, $via, $field[3]);
 			} else {
 				$self->route($field[2], $line); # relay it on its way
@@ -351,6 +357,11 @@ sub normal
 				dbg('chan', "Duplicate Spot ignored\n");
 				return;
 			}
+			my @bad;
+			if (@bad = BadWords::check($field[5])) {
+				dbg('chan', "Bad words: @bad, dropped" );
+				return;
+			}
 			
 			my @spot = Spot::add($field[1], $field[2], $d, $field[5], $field[6], $field[7]);
 
@@ -427,7 +438,12 @@ sub normal
 				dbg('chan', "Duplicate Announce ignored");
 				return;
 			}
-			
+
+			my @bad;
+			if (@bad = BadWords::check($field[3])) {
+				dbg('chan', "Bad words: @bad, dropped" );
+				return;
+			}
 			if ($field[2] eq '*' || $field[2] eq $main::mycall) {
 				
 				# global ann filtering on INPUT
@@ -1125,6 +1141,7 @@ sub send_dx_spot
 		} elsif ($dxchan->is_user && $dxchan->{dx}) {
 			my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]);
 			$buf .= "\a\a" if $dxchan->{beep};
+			$buf =~ s/\%5E/^/g;
 			if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
 				$dxchan->send($buf);
 			} else {
@@ -1278,6 +1295,7 @@ sub send_announce
 			}
 			next if $target eq 'SYSOP' && $dxchan->{priv} < 5;
 			my $buf = "$to$target de $_[0]: $text";
+			$buf =~ s/\%5E/^/g;
 			$buf .= "\a\a" if $dxchan->{beep};
 			if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') {
 				$dxchan->send($buf);
diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm
index 8de0185b..47d44c92 100644
--- a/perl/DXProtout.pm
+++ b/perl/DXProtout.pm
@@ -37,6 +37,7 @@ sub pc10
 	}
 	$text = unpad($text);
 	$text = ' ' unless $text && length $text > 0;
+	$text =~ s/\^/%5E/g;
 	return "PC10^$from^$user1^$text^*^$user2^$main::mycall^~";  
 }
 
@@ -47,6 +48,7 @@ sub pc11
 	my $hops = get_hops(11);
 	my $t = time;
 	$text = ' ' if !$text;
+	$text =~ s/\^/%5E/g;
 	return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$main::mycall^$hops^~", $freq, cldate($t), ztime($t);
 }
 
@@ -59,6 +61,7 @@ sub pc12
 	$text = ' ' if !$text;
 	$wx = '0' if !$wx;
 	$tonode = '*' if !$tonode;
+	$text =~ s/\^/%5E/g;
 	return "PC12^$call^$tonode^$text^$sysop^$main::mycall^$wx^$hops^~";
 }
 
diff --git a/perl/Messages b/perl/Messages
index c376e318..e7d9d8c6 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -57,6 +57,7 @@ package DXM;
 				e14 => 'First argument must be numeric and > 0',
 				e15 => 'invalid qualifier \"$_[0]\"',
 				e16 => 'File \"$_[0]\" exists',
+				e17 => 'Please don\'t use the words: @_ on here', 
 
 				echoon => 'Echoing enabled',
 				echooff => 'Echoing disabled',
diff --git a/perl/cluster.pl b/perl/cluster.pl
index dfae3278..0f8ecfbb 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -62,6 +62,7 @@ use DXDb;
 use AnnTalk;
 use WCY;
 use DXDupe;
+use BadWords;
 
 use Data::Dumper;
 use Fcntl ':flock'; 
@@ -323,6 +324,9 @@ DXUser->init($userfn, 1);
 dbg('err', "starting listener ...");
 Msg->new_server("$clusteraddr", $clusterport, \&login);
 
+# load bad words
+dbg('err', "load badwords: " . (BadWords::load or "Ok"));
+
 # prime some signals
 $SIG{INT} = \&cease;
 $SIG{TERM} = \&cease;
-- 
2.43.0