added user filtering (or at leats the capability for it)
[spider.git] / perl / DXProt.pm
index b0d21db377ee62d8d7c847cfbc1dd4d1b4c0debc..b446b713f3e705994c1516995ff21583335425c3 100644 (file)
@@ -22,12 +22,15 @@ use DXLog;
 use Spot;
 use DXProtout;
 use DXDebug;
+use Filter;
 use Local;
 
 use Carp;
 
 use strict;
-use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $last_hour %pings %rcmds %nodehops);
+use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age 
+                       %spotdup %wwvdup $last_hour %pings %rcmds 
+                       %nodehops @baddx $baddxfn);
 
 $me = undef;                                   # the channel id for this cluster
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
@@ -39,7 +42,9 @@ $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
 
+$baddxfn = "$main::data/baddx.pl";
 
 sub init
 {
@@ -69,6 +74,9 @@ sub init
                $wwvdup{$dupkey} = $_->[1];
        }
 
+       # load the baddx file
+       do "$baddxfn" if -e "$baddxfn";
+       print "$@\n" if $@;
 }
 
 #
@@ -99,6 +107,11 @@ sub start
        $self->{isolate} = $user->{isolate};
        $self->{consort} = $line;       # save the connection type
        $self->{here} = 1;
+
+       # get the filters
+       $self->{spotfilter} = Filter::read_in('spots', $call);
+       $self->{wwvfilter} = Filter::read_in('wwv', $call);
+       $self->{annfilter} = Filter::read_in('ann', $call);
        
        # set unbuffered
        $self->send_now('B',"0");
@@ -189,27 +202,36 @@ sub normal
                        }
                        
                        $spotdup{$dupkey} = $d;
+
+                       # is it 'baddx'
+                       if (grep $field[2] eq $_, @baddx) {
+                               dbg('chan', "Bad DX spot, ignored");
+                               return;
+                       }
                        
-                       my $spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]);
+                       my @spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]);
+
+            #
+                       # @spot at this point contains:-
+            # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node
+                       # then  spotted itu, spotted cq, spotters itu, spotters cq
+                       # you should be able to route on any of these
+            #
                        
                        # local processing 
                        my $r;
                        eval {
-                               $r = Local::spot($self, $freq, $field[2], $d, $text, $spotter, $field[7]);
+                               $r = Local::spot($self, @spot);
                        };
 #                      dbg('local', "Local::spot1 error $@") if $@;
                        return if $r;
 
-                       # send orf to the users
-                       if ($spot && $pcno == 11) {
-                               my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
-                               broadcast_users("$buf\a\a", 'dx', $spot);
-                       }
-
                        # DON'T be silly and send on PC26s!
                        return if $pcno == 26;
-                       
-                       last SWITCH;
+
+                       # send out the filtered spots
+                       send_dx_spot($self, $line, @spot) if @spot;
+                       return;
                }
                
                if ($pcno == 12) {              # announces
@@ -271,7 +293,7 @@ sub normal
                        
                        for ($i = 2; $i < $#field; $i++) {
                                my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o;
-                               next if length $call < 3 || length $call > 8;
+                               next if !$call || length $call < 3 || length $call > 8;
                                next if !$confmode;
                                $call = uc $call;
                                next if DXCluster->get_exact($call); # we already have this (loop?)
@@ -354,6 +376,7 @@ sub normal
                        
                        # queue mail
                        DXMsg::queue_msg(0);
+
                        return;
                }
                
@@ -405,7 +428,7 @@ sub normal
                        return if $pcno == 27;
 
                        # broadcast to the eager users
-                       broadcast_users("WWV de $field[7] <$field[2]>:   SFI=$sfi, K=$k, A=$i, $field[6]", 'wwv', $wwv );
+                       broadcast_users("WWV de $field[7] <$field[2]>:   SFI=$sfi, A=$k, K=$i, $field[6]", 'wwv', $wwv );
                        last SWITCH;
                }
                
@@ -660,30 +683,72 @@ sub finish
 #
 # some active measures
 #
+sub send_dx_spot
+{
+       my $self = shift;
+       my $line = shift;
+       my @dxchan = DXChannel->get_all();
+       my $dxchan;
+       
+       # 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) {
+               my $routeit;
+               my ($filter, $hops) = Filter::it($dxchan->{spotfilter}, @_, $self->{call} ) if $dxchan->{spotfilter};
+               if ($dxchan->is_ak1a) {
+                       next if $dxchan == $self;
+                       if ($hops) {
+                               $routeit = $line;
+                               $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/;
+                       } else {
+                               $routeit = adjust_hops($dxchan, $line);  # adjust its hop count by node name
+                               next unless $routeit;
+                       }
+                       if ($filter) {
+                               $dxchan->send($routeit) if $routeit;
+                       } else {
+                               $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
+                               
+                       }
+               } elsif ($dxchan->is_user) {
+                       my $buf = Spot::formatb($_[0], $_[1], $_[2], $_[3], $_[4]);
+                       $buf .= "\a\a" if $dxchan->beep;
+                       $dxchan->send($buf);
+               }                                       
+       }
+}
 
 sub send_local_config
 {
        my $self = shift;
        my $n;
        my @nodes;
-       
+       my @localnodes;
+       my @remotenodes;
+               
        # send our nodes
        if ($self->{isolate}) {
-               @nodes = (DXCluster->get_exact($main::mycall));
+               @localnodes = (DXCluster->get_exact($main::mycall));
        } else {
                # create a list of all the nodes that are not connected to this connection
+               # and are not themselves isolated, this to make sure that isolated nodes
+        # don't appear outside of this node
                @nodes = DXNode::get_all();
-               @nodes = grep { $_->dxchan != $self } @nodes;
+               @nodes = grep { $_->dxchan != $self && !$_->dxchan->{isolate} } @nodes;
+               @nodes = grep { $_->{call} ne $main::mycall } @nodes;
+               @localnodes = grep { $_->dxchan->{call} eq $_->{call} } @nodes if @nodes;
+               unshift @localnodes, DXCluster->get_exact($main::mycall);
+               @remotenodes = grep { $_->dxchan->{call} ne $_->{call} } @nodes if @nodes;
        }
 
-       my @s = $me->pc19(@nodes);
+       my @s = $me->pc19(@localnodes, @remotenodes);
        for (@s) {
                my $routeit = adjust_hops($self, $_);
                $self->send($routeit) if $routeit;
        }
        
        # get all the users connected on the above nodes and send them out
-       foreach $n (@nodes) {
+       foreach $n (@localnodes, @remotenodes) {
                my @users = values %{$n->list};
                my @s = pc16($n, @users);
                for (@s) {
@@ -714,7 +779,8 @@ sub route
        }
 }
 
-# broadcast a message to all clusters [except those mentioned after buffer]
+# broadcast a message to all clusters taking into account isolation
+# [except those mentioned after buffer]
 sub broadcast_ak1a
 {
        my $s = shift;                          # the line to be rebroadcast
@@ -730,6 +796,23 @@ sub broadcast_ak1a
        }
 }
 
+# broadcast a message to all clusters ignoring isolation
+# [except those mentioned after buffer]
+sub broadcast_all_ak1a
+{
+       my $s = shift;                          # the line to be rebroadcast
+       my @except = @_;                        # to all channels EXCEPT these (dxchannel refs)
+       my @dxchan = get_all_ak1a();
+       my $dxchan;
+       
+       # send it if it isn't the except list and isn't isolated and still has a hop count
+       foreach $dxchan (@dxchan) {
+               next if grep $dxchan == $_, @except;
+               my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name
+               $dxchan->send($routeit);
+       }
+}
+
 # broadcast to all users
 # storing the spot or whatever until it is in a state to receive it
 sub broadcast_users
@@ -758,13 +841,19 @@ sub broadcast_list
        my $dxchan;
        
        foreach $dxchan (@_) {
+               my $filter = 1;
                
-               next if $sort eq 'dx' && !$dxchan->{dx};
+               if ($sort eq 'dx') {
+                   next unless $dxchan->{dx};
+                       ($filter) = Filter::it($dxchan->{spotfilter}, @{$fref}) if ref $fref;
+                       next unless $filter;
+               }
                next if $sort eq 'ann' && !$dxchan->{ann};
                next if $sort eq 'wwv' && !$dxchan->{wwv};
                next if $sort eq 'wx' && !$dxchan->{wx};
 
                $s =~ s/\a//og unless $dxchan->{beep};
+
                if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
                        $dxchan->send($s);      
                } else {