Fix a couple of typos in the help files for BADDX and BADSPOTTER
[spider.git] / perl / DXProt.pm
index 7f2aaba82c415a1053fe572f34704dd46539de63..99fc85ce7e3c42723bec9a8c5da038f2d540beb9 100644 (file)
@@ -30,11 +30,12 @@ use Geomag;
 use WCY;
 use Time::HiRes qw(gettimeofday tv_interval);
 use BadWords;
+use DXHash;
 
 use strict;
 use vars qw($me $pc11_max_age $pc23_max_age
                        $last_hour %pings %rcmds
-                       %nodehops @baddx $baddxfn $censorpc
+                       %nodehops $baddx $badspotter $badnode $censorpc
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
 
 $me = undef;                                   # the channel id for this cluster
@@ -45,10 +46,11 @@ $last_hour = time;                          # last time I did an hourly periodic update
 %pings = ();                    # outstanding ping requests outbound
 %rcmds = ();                    # outstanding rcmd requests outbound
 %nodehops = ();                 # node specific hop control
-@baddx = ();                    # list of illegal spotted callsigns
 $censorpc = 0;                                 # Do a BadWords::check on text fields and reject things
-
-$baddxfn = "$main::data/baddx.pl";
+                                                               # loads of 'bad things'
+$baddx = new DXHash "baddx";
+$badspotter = new DXHash "badspotter";
+$badnode = new DXHash "badnode";
 
 @checklist = 
 (
@@ -177,10 +179,6 @@ sub init
        do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
        confess $@ if $@;
        $me->{sort} = 'S';    # S for spider
-
-       # load the baddx file
-       do "$baddxfn" if -e "$baddxfn";
-       print "$@\n" if $@;
 }
 
 #
@@ -332,8 +330,14 @@ sub normal
                        }
                        
                        # if this is a 'nodx' node then ignore it
-                       if (grep $field[7] =~ /^$_/,  @DXProt::nodx_node) {
-                               dbg('chan', "PCPROT: Bad DXNode, dropped");
+                       if ($badnode->in($field[7])) {
+                               dbg('chan', "PCPROT: Bad Node, dropped");
+                               return;
+                       }
+                       
+                       # if this is a 'bad spotter' user then ignore it
+                       if ($badspotter->in($field[6])) {
+                               dbg('chan', "PCPROT: Bad Spotter, dropped");
                                return;
                        }
                        
@@ -346,7 +350,7 @@ sub normal
                        }
 
                        # is it 'baddx'
-                       if (grep $field[2] eq $_, @baddx) {
+                       if ($baddx->in($field[2])) {
                                dbg('chan', "PCPROT: Bad DX spot, ignored");
                                return;
                        }
@@ -848,7 +852,7 @@ sub normal
                        } else {
                                my $ref = DXUser->get_current($field[1]);
                                if ($ref && $ref->is_clx) {
-                                       route($field[1], pc84($field[2], $field[1], $field[2], $field[3]));
+                                       $self->route($field[1], pc84($field[2], $field[1], $field[2], $field[3]));
                                } else {
                                        $self->route($field[1], $line);
                                }
@@ -871,7 +875,7 @@ sub normal
                        } else {
                                my $ref = DXUser->get_current($field[1]);
                                if ($ref && $ref->is_clx) {
-                                       route($field[1], pc85($field[2], $field[1], $field[2], $field[3]));
+                                       $self->route($field[1], pc85($field[2], $field[1], $field[2], $field[3]));
                                } else {
                                        $self->route($field[1], $line);
                                }
@@ -956,7 +960,7 @@ sub normal
                                                                $dxchan->send($dxchan->msg('pingi', $field[2], $s, $ave))
                                                        } elsif ($dxchan->is_node) {
                                                                if ($tochan) {
-                                                                       $tochan->{nopings} = 2; # pump up the timer
+                                                                       $tochan->{nopings} = $tochan->user->nopings || 2; # pump up the timer
                                                                        push @{$tochan->{pingtime}}, $t;
                                                                        shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
                                                                        my $st;
@@ -1040,7 +1044,7 @@ sub normal
                                if ($ref && $ref->is_clx) {
                                        $self->route($field[1], $line);
                                } else {
-                                       route($field[1], pc34($field[2], $field[1], $field[4]));
+                                       $self->route($field[1], pc34($field[2], $field[1], $field[4]));
                                }
                        }
                        return;
@@ -1068,7 +1072,7 @@ sub normal
                                if ($ref && $ref->is_clx) {
                                        $self->route($field[1], $line);
                                } else {
-                                       route($field[1], pc35($field[2], $field[1], $field[4]));
+                                       $self->route($field[1], pc35($field[2], $field[1], $field[4]));
                                }
                        }
                        return;
@@ -1225,6 +1229,19 @@ sub send_wwv_spot
        my $line = shift;
        my @dxchan = DXChannel->get_all();
        my $dxchan;
+       my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my @dxcc = Prefix::extract($_[7]);
+       if (@dxcc > 0) {
+               $wwv_dxcc = $dxcc[1]->dxcc;
+               $wwv_itu = $dxcc[1]->itu;
+               $wwv_cq = $dxcc[1]->cq;                                         
+       }
+       @dxcc = Prefix::extract($_[8]);
+       if (@dxcc > 0) {
+               $org_dxcc = $dxcc[1]->dxcc;
+               $org_itu = $dxcc[1]->itu;
+               $org_cq = $dxcc[1]->cq;                                         
+       }
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
        # taking into account filtering and so on
@@ -1233,7 +1250,7 @@ sub send_wwv_spot
                my ($filter, $hops);
 
                if ($dxchan->{wwvfilter}) {
-                        ($filter, $hops) = $dxchan->{wwvfilter}->it(@_, $self->{call} );
+                       ($filter, $hops) = $dxchan->{wwvfilter}->it(@_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
                         next unless $filter;
                }
                if ($dxchan->is_node) {
@@ -1269,6 +1286,19 @@ sub send_wcy_spot
        my $line = shift;
        my @dxchan = DXChannel->get_all();
        my $dxchan;
+       my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my @dxcc = Prefix::extract($_[11]);
+       if (@dxcc > 0) {
+               $wcy_dxcc = $dxcc[1]->dxcc;
+               $wcy_itu = $dxcc[1]->itu;
+               $wcy_cq = $dxcc[1]->cq;                                         
+       }
+       @dxcc = Prefix::extract($_[12]);
+       if (@dxcc > 0) {
+               $org_dxcc = $dxcc[1]->dxcc;
+               $org_itu = $dxcc[1]->itu;
+               $org_cq = $dxcc[1]->cq;                                         
+       }
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
        # taking into account filtering and so on
@@ -1277,7 +1307,7 @@ sub send_wcy_spot
                my ($filter, $hops);
 
                if ($dxchan->{wcyfilter}) {
-                        ($filter, $hops) = $dxchan->{wcyfilter}->it(@_, $self->{call} );
+                       ($filter, $hops) = $dxchan->{wcyfilter}->it(@_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
                         next unless $filter;
                }
                if ($dxchan->is_clx || $dxchan->is_spider || $dxchan->is_dxnet) {
@@ -1328,10 +1358,25 @@ sub send_announce
                $target = "WX"; 
                $to = '';
        }
-       $target = "All" if !$target;
+       $target = "ALL" if !$target;
        
        Log('ann', $target, $_[0], $text);
 
+       # obtain country codes etc 
+       my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my @dxcc = Prefix::extract($_[0]);
+       if (@dxcc > 0) {
+               $ann_dxcc = $dxcc[1]->dxcc;
+               $ann_itu = $dxcc[1]->itu;
+               $ann_cq = $dxcc[1]->cq;                                         
+       }
+       @dxcc = Prefix::extract($_[4]);
+       if (@dxcc > 0) {
+               $org_dxcc = $dxcc[1]->dxcc;
+               $org_itu = $dxcc[1]->itu;
+               $org_cq = $dxcc[1]->cq;                                         
+       }
+
        # send it if it isn't the except list and isn't isolated and still has a hop count
        # taking into account filtering and so on
        foreach $dxchan (@dxchan) {
@@ -1339,19 +1384,6 @@ sub send_announce
                my ($filter, $hops);
 
                if ($dxchan->{annfilter}) {
-                       my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
-                       my @dxcc = Prefix::extract($_[0]);
-                       if (@dxcc > 0) {
-                               $ann_dxcc = $dxcc[1]->dxcc;
-                               $ann_itu = $dxcc[1]->itu;
-                               $ann_cq = $dxcc[1]->cq;                                         
-                       }
-                       @dxcc = Prefix::extract($_[4]);
-                       if (@dxcc > 0) {
-                               $org_dxcc = $dxcc[1]->dxcc;
-                               $org_itu = $dxcc[1]->itu;
-                               $org_cq = $dxcc[1]->cq;                                         
-                       }
                        ($filter, $hops) = $dxchan->{annfilter}->it(@_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
                        next unless $filter;
                } 
@@ -1447,12 +1479,20 @@ sub route
        unless ($dxchan) {
                my $cl = DXCluster->get_exact($call);
                $dxchan = $cl->dxchan if $cl;
+               if (ref $dxchan) {
+                       if (ref $self && $dxchan eq $self) {
+                               dbg('chan', "PCPROT: Trying to route back to source, dropped");
+                               return;
+                       }
+               }
        }
        if ($dxchan) {
                my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
                if ($routeit) {
                        $dxchan->send($routeit);
                }
+       } else {
+               dbg('chan', "PCPROT: No route available, dropped");
        }
 }