From 17f0b57add792391822d38116e89b33c1df4e2dd Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 13 Sep 2001 19:58:05 +0000 Subject: [PATCH] 5. Change the badwords interface to be the same as baddx, badspotter et al. added set/badword, unset/badword and show/badword. This routine will auto convert (and delete afterwards) the old badwords file. Also make the ann->talk thingy less aggressive --- Changes | 3 +++ cmd/set/badword.pl | 10 ++++++++++ cmd/show/badword.pl | 10 ++++++++++ cmd/unset/badword.pl | 10 ++++++++++ perl/AnnTalk.pm | 17 ++++++++++++++++- perl/BadWords.pm | 22 ++++++++++++---------- perl/DXCommandmode.pm | 8 ++++---- perl/DXProt.pm | 37 +++++++++++++++++++++---------------- 8 files changed, 86 insertions(+), 31 deletions(-) create mode 100644 cmd/set/badword.pl create mode 100644 cmd/show/badword.pl create mode 100644 cmd/unset/badword.pl diff --git a/Changes b/Changes index 29408d19..d57dc730 100644 --- a/Changes +++ b/Changes @@ -7,6 +7,9 @@ data (eg at init time with large lists of node/users on fast links). form 'to g1tlh hello', 't g1tlh hello' or 'g1tlh hello' appear. This also suppresses similar announces for users whose callsign is not the one in the announce. +5. Change the badwords interface to be the same as baddx, badspotter et al. +added set/badword, unset/badword and show/badword. This routine will auto +convert (and delete afterwards) the old badwords file. 11Sep01======================================================================= 1. added IP address logging of connections 10Sep01======================================================================= diff --git a/cmd/set/badword.pl b/cmd/set/badword.pl new file mode 100644 index 00000000..21a38a3c --- /dev/null +++ b/cmd/set/badword.pl @@ -0,0 +1,10 @@ +# +# set list of bad dx callsigns +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +return $BadWords::badword->set(8, $self->msg('e6'), $self, $line); + diff --git a/cmd/show/badword.pl b/cmd/show/badword.pl new file mode 100644 index 00000000..eddefef8 --- /dev/null +++ b/cmd/show/badword.pl @@ -0,0 +1,10 @@ +# +# show list of bad dx callsigns +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +return $BadWords::badword->show(1, $self); + diff --git a/cmd/unset/badword.pl b/cmd/unset/badword.pl new file mode 100644 index 00000000..76f0cf10 --- /dev/null +++ b/cmd/unset/badword.pl @@ -0,0 +1,10 @@ +# +# unset list of bad dx callsigns +# +# Copyright (c) 1998 - Dirk Koopman G1TLH +# +# $Id$ +# +my ($self, $line) = @_; +return $BadWord::badwords->unset(8, $self->msg('e6'), $self, $line); + diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm index b48dc7e0..0269edaa 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -62,6 +62,21 @@ sub listdups return DXDupe::listdups('A', $dupage, @_); } - +# is this text field a likely announce to talk substitution? +# this may involve all sorts of language dependant heuristics, but +# then again, it might not +sub is_talk_candidate +{ + my ($from, $text) = @_; + my $call; + ($call) = $text =~ /^\s*(?:[Xx]|[Tt][Oo]?)\s+([\w-]+)/; + ($call) = $text =~ /^\s*>\s*([\w-]+)\b/ unless $call; + ($call) = $text =~ /^\s*([\w-]+):?\b/ unless $call; + if ($call) { + $call = uc $call; + return is_callsign($call); + } + return undef; +} 1; diff --git a/perl/BadWords.pm b/perl/BadWords.pm index 2336bb04..e7d1169e 100644 --- a/perl/BadWords.pm +++ b/perl/BadWords.pm @@ -12,12 +12,13 @@ use strict; use DXUtil; use DXVars; +use DXHash; use IO::File; -use vars qw(%badwords $fn); +use vars qw($badword); -$fn = "$main::data/badwords"; -%badwords = (); +my $oldfn = "$main::data/badwords"; +$badword = new DXHash "badword"; use vars qw($VERSION $BRANCH); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); @@ -29,23 +30,24 @@ $main::branch += $BRANCH; sub load { my @out; - return unless -e $fn; - my $fh = new IO::File $fn; + return unless -e $oldfn; + my $fh = new IO::File $oldfn; if ($fh) { - %badwords = (); while (<$fh>) { chomp; next if /^\s*\#/; my @list = split " "; for (@list) { - $badwords{lc $_}++; + $badword->add($_); } } $fh->close; + $badword->put; + unlink $oldfn; } else { - my $l = "can't open $fn $!"; - dbg('err', $l); + my $l = "can't open $oldfn $!"; + dbg($l); push @out, $l; } return @out; @@ -54,7 +56,7 @@ sub load # check the text against the badwords list sub check { - return grep { $badwords{$_} } split(/\b/, lc shift); + return grep { $badword->in($_) } split(/\b/, lc shift); } 1; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 6986a41a..a5aaa5cf 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -705,10 +705,10 @@ sub announce my $text = shift; my ($filter, $hops); - if ($suppress_ann_to_talk) { - my ($to, $call) = $text =~ /^\s*([\w-]+)[\s:]+([\w-]+)/; - return if ($to && $call && ((uc $to =~ /^TO?$/ && is_callsign(uc $call)) || is_callsign($call = uc $to))); - } + if ($suppress_ann_to_talk && $to ne $self->{call}) { + my $call = AnnTalk::is_talk_candidate($_[0], $text); + return if $call && Route::get($call); + } if ($self->{annfilter}) { ($filter, $hops) = $self->{annfilter}->it(@_ ); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 153618f9..e9860556 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -321,7 +321,8 @@ sub normal } # is it for me or one of mine? - my ($to, $via, $call, $dxchan); + my ($from, $to, $via, $call, $dxchan); + $from = $field[1]; if ($field[5] gt ' ') { $via = $field[2]; $to = $field[5]; @@ -329,12 +330,20 @@ sub normal $to = $field[2]; } + # if we are converting announces to talk is it a dup? + if ($ann_to_talk) { + if (AnnTalk::is_talk_candidate($$from, $field[3]) && AnnTalk::dup($$from, $to, $field[3])) { + dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr'); + return; + } + } + # it is here and logged on $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall; $dxchan = DXChannel->get($to) unless $dxchan; if ($dxchan && $dxchan->is_user) { $field[3] =~ s/\%5E/^/g; - $dxchan->talk($field[1], $to, $via, $field[3]); + $dxchan->talk($$from, $to, $via, $field[3]); return; } @@ -345,17 +354,17 @@ sub normal if ($ref = Route::get($to)) { $vref = Route::Node::get($via) if $via; $vref = undef unless $vref && grep $to eq $_, $vref->users; - $ref->dxchan->talk($field[1], $to, $vref ? $via : undef, $field[3], $field[6]); + $ref->dxchan->talk($$from, $to, $vref ? $via : undef, $field[3], $field[6]); return; } # not visible here, send a message of condolence $vref = undef; - $ref = Route::get($field[1]); + $ref = Route::get($$from); $vref = $ref = Route::Node::get($field[6]) unless $ref; if ($ref) { $dxchan = $ref->dxchan; - $dxchan->talk($main::mycall, $field[1], $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); + $dxchan->talk($main::mycall, $$from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) ); } return; } @@ -520,17 +529,13 @@ sub normal # here's a bit of fun, convert incoming ann with a callsign in the first word # or one saying 'to ' to a talk if we can route to the recipient if ($ann_to_talk) { - my ($to, $call) = $field[3] =~ /^\s*([\w-]+)[\s:]+([\w-]+)/; - if ($to && $call) { - $to = uc $to; - $call = uc $call; - if (($to =~ /^TO?$/ && is_callsign($call)) || is_callsign($call = $to)) { - my $ref = Route::get($call); - if ($ref) { - my $dxchan = $ref->dxchan; - $dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self; - return; - } + my $call = AnnTalk::is_talk_candidate($field[1], $field[3]); + if ($call) { + my $ref = Route::get($call); + if ($ref) { + my $dxchan = $ref->dxchan; + $dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self; + return; } } } -- 2.43.0