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
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.
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=======================================================================
11Sep01=======================================================================
1. added IP address logging of connections
10Sep01=======================================================================
--- /dev/null
+#
+# 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);
+
--- /dev/null
+#
+# show list of bad dx callsigns
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+return $BadWords::badword->show(1, $self);
+
--- /dev/null
+#
+# 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);
+
return DXDupe::listdups('A', $dupage, @_);
}
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;
+}
-use vars qw(%badwords $fn);
-$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+)/ );
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
- return unless -e $fn;
- my $fh = new IO::File $fn;
+ return unless -e $oldfn;
+ my $fh = new IO::File $oldfn;
while (<$fh>) {
chomp;
next if /^\s*\#/;
my @list = split " ";
for (@list) {
while (<$fh>) {
chomp;
next if /^\s*\#/;
my @list = split " ";
for (@list) {
+ $badword->put;
+ unlink $oldfn;
- my $l = "can't open $fn $!";
- dbg('err', $l);
+ my $l = "can't open $oldfn $!";
+ dbg($l);
push @out, $l;
}
return @out;
push @out, $l;
}
return @out;
# check the text against the badwords list
sub check
{
# check the text against the badwords list
sub check
{
- return grep { $badwords{$_} } split(/\b/, lc shift);
+ return grep { $badword->in($_) } split(/\b/, lc shift);
my $text = shift;
my ($filter, $hops);
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(@_ );
if ($self->{annfilter}) {
($filter, $hops) = $self->{annfilter}->it(@_ );
}
# is it for me or one of mine?
}
# 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];
if ($field[5] gt ' ') {
$via = $field[2];
$to = $field[5];
+ # 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;
# 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]);
if ($ref = Route::get($to)) {
$vref = Route::Node::get($via) if $via;
$vref = undef unless $vref && grep $to eq $_, $vref->users;
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;
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;
$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) );
# here's a bit of fun, convert incoming ann with a callsign in the first word
# or one saying 'to <call>' to a talk if we can route to the recipient
if ($ann_to_talk) {
# here's a bit of fun, convert incoming ann with a callsign in the first word
# or one saying 'to <call>' 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;