fix a talk bug for t xxx > yyy
authorminima <minima>
Sat, 2 Sep 2000 15:28:14 +0000 (15:28 +0000)
committerminima <minima>
Sat, 2 Sep 2000 15:28:14 +0000 (15:28 +0000)
added badword checking

Changes
cmd/announce.pl
cmd/dx.pl
cmd/load/badwords.pl [new file with mode: 0644]
cmd/talk.pl
perl/AnnTalk.pm
perl/BadWords.pm [new file with mode: 0644]
perl/DXProt.pm
perl/DXProtout.pm
perl/Messages
perl/cluster.pl

diff --git a/Changes b/Changes
index 8e5d14b5468fbb2ca9e82e244c6d0432212efa35..7d53424797ee9f392e3cc36be3513f04c014b84b 100644 (file)
--- 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 
index 494cd9ddfaa3c9c5179d418ea21b5c38e9c321e9..6eb1810ee2418bc342cb613235de09090e23214d 100644 (file)
@@ -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);
 }
index 75ba77dc866e8a0152d918a1ce514a9c6660186a..3f366dffb20f82ef5bb508c370b55f836066ce9e 100644 (file)
--- 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 (file)
index 0000000..06d9c06
--- /dev/null
@@ -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); 
index 1f6d155158dc7e3e48437bb0b553fe2cdefe32ca..8082e240ae0c5ac1092115df068feaaa525b6814 100644 (file)
@@ -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;
index 383e71557fa7551561bf735659ea097bfed431aa..341857450be90e8e45dd5003fed742875d645682 100644 (file)
@@ -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 (file)
index 0000000..ff9dd04
--- /dev/null
@@ -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;
index e2c1dae4221ebdc9cceca1ce97c14b09d11637f4..cd731a216fbcd64866720cb70c0c841bbdcedf2c 100644 (file)
@@ -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);
index 8de0185b10b22fb45c84b3ea3a2d11246fe71dc9..47d44c92c339e39a58c8b6076dfaf894619a57e9 100644 (file)
@@ -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^~";
 }
 
index c376e3183182c4d7186d32a10d905cc1c67205c6..e7d9d8c650e959823f3b3d720c29023618b9121b 100644 (file)
@@ -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',
index dfae3278efb914bf5bdc944be1ac91c393a7b2e9..0f8ecfbba1ff4ef37b0f8889a3e2b7d82ea6062e 100755 (executable)
@@ -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;