From 8e0eef80216fbb2bca3606daf5797e39b2889d7a Mon Sep 17 00:00:00 2001 From: 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