removed unwanted pc21 for isolated nodes
[spider.git] / perl / DXProt.pm
index 1ffbe70193961fd899fb090d5b1e6c744df56ab5..f4f56e7dff3e701f190daf5a3a97c605ce9b72b0 100644 (file)
@@ -22,6 +22,7 @@ use DXLog;
 use Spot;
 use DXProtout;
 use DXDebug;
+use Filter;
 use Local;
 
 use Carp;
@@ -29,14 +30,17 @@ use Carp;
 use strict;
 use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age 
                        %spotdup %wwvdup $last_hour %pings %rcmds 
-                       %nodehops @baddx $baddxfn);
+                       %nodehops @baddx $baddxfn $pc12_dup_age
+                       %anndup);
 
 $me = undef;                                   # the channel id for this cluster
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
 $pc11_dup_age = 24*3600;               # the maximum time to keep the spot dup list for
 $pc23_dup_age = 24*3600;               # the maximum time to keep the wwv dup list for
+$pc12_dup_age = 24*3600;               # the maximum time to keep the ann dup list for
 %spotdup = ();                             # the pc11 and 26 dup hash 
-%wwvdup = ();                              # the pc23 and 27 dup hash 
+%wwvdup = ();                              # the pc23 and 27 dup hash
+%anndup = ();                               # the PC12 dup hash
 $last_hour = time;                             # last time I did an hourly periodic update
 %pings = ();                    # outstanding ping requests outbound
 %rcmds = ();                    # outstanding rcmd requests outbound
@@ -106,9 +110,15 @@ 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
+       # set unbuffered and no echo
        $self->send_now('B',"0");
+       $self->send_now('E',"0");
        
        # send initialisation string
        if (!$self->{outbound}) {
@@ -168,6 +178,14 @@ sub normal
                }
                
                if ($pcno == 11 || $pcno == 26) { # dx spot
+
+                       # route 'foreign' pc26s 
+                       if ($pcno == 26) {
+                               if ($field[7] ne $main::mycall) {
+                                       route($field[7], $line);
+                                       return;
+                               }
+                       }
                        
                        # if this is a 'nodx' node then ignore it
                        last SWITCH if grep $field[7] =~ /^$_/,  @DXProt::nodx_node;
@@ -207,32 +225,43 @@ sub normal
 
             #
                        # @spot at this point contains:-
-            # freq, spotted call, time, text, spotter, spotted cc, spotters cc,
-            # orig node, spotted itu, spotted cq, spotters itu, spotters cq
+            # 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[0]);
-                       }
-
                        # 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
+                       # announce duplicate checking
+                       my $text = uc unpad($field[3]);
+                       my $dupkey = $field[1].$field[2].$text.$field[4].$field[6];
+                       if ($anndup{$dupkey}) {
+                               dbg('chan', "Duplicate Announce ignored\n");
+                               return;
+                       }
+                       $anndup{$dupkey} = $main::systime;
+                       
+                       # global ann filtering
+                       my ($filter, $hops) = Filter::it($self->{annfilter}, @field[1..6], $self->{call} ) if $self->{annfilter};
+                       if ($self->{annfilter} && !$filter) {
+                               dbg('chan', "Rejected by filter");
+                               return;
+                       }
                        
                        if ($field[2] eq '*' || $field[2] eq $main::mycall) {
                                
@@ -284,8 +313,12 @@ sub normal
                
                if ($pcno == 16) {              # add a user
                        my $node = DXCluster->get_exact($field[1]); 
-                       last SWITCH if !$node; # ignore if havn't seen a PC19 for this one yet
-                       last SWITCH unless $node->isa('DXNode');
+                       return unless $node; # ignore if havn't seen a PC19 for this one yet
+                       return unless $node->isa('DXNode');
+                       if ($node->dxchan != $self) {
+                               dbg('chan', "LOOP: come in on wrong channel");
+                               return;
+                       }
                        my $i;
                        
                        
@@ -305,7 +338,7 @@ sub normal
                                $user = DXUser->new($call) if !$user;
                                $user->homenode($node->call) if !$user->homenode;
                                $user->node($node->call);
-                               $user->lastin($main::systime);
+                               $user->lastin($main::systime) unless DXChannel->get($call);
                                $user->put;
                        }
                        
@@ -315,7 +348,13 @@ sub normal
                }
                
                if ($pcno == 17) {              # remove a user
-                       
+                       my $node = DXCluster->get_exact($field[2]);
+                       return unless $node;
+                       return unless $node->isa('DXNode');
+                       if ($node->dxchan != $self) {
+                               dbg('chan', "LOOP: come in on wrong channel");
+                               return;
+                       }
                        my $ref = DXCluster->get_exact($field[1]);
                        $ref->del() if $ref;
                        last SWITCH;
@@ -337,7 +376,12 @@ sub normal
                                my $ver = $field[$i+3];
                                
                                # now check the call over
-                               next if DXCluster->get_exact($call); # we already have this
+                               my $node = DXCluster->get_exact($call);
+                               if ($node && $node->dxchan != $self) {
+                                       dbg('chan', "LOOP: come in on wrong channel");
+                                       return;
+                               }
+                               next if $node; # we already have this
                                
                                # check for sane parameters
                                next if $ver < 5000; # only works with version 5 software
@@ -358,7 +402,7 @@ sub normal
                                        $user->homenode($call);
                                        $user->node($call);
                                }
-                               $user->lastin($main::systime);
+                               $user->lastin($main::systime) unless DXChannel->get($call);
                                $user->put;
                        }
                        
@@ -374,14 +418,24 @@ sub normal
                        
                        # queue mail
                        DXMsg::queue_msg(0);
+
                        return;
                }
                
                if ($pcno == 21) {              # delete a cluster from the list
                        my $call = uc $field[1];
                        if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
-                               my $ref = DXCluster->get_exact($call);
-                               $ref->del() if $ref;
+                               my $node = DXCluster->get_exact($call);
+                               if ($node) {
+                                       if ($node->dxchan != $self) {
+                                               dbg('chan', "LOOP: come in on wrong channel");
+                                               return;
+                                       }
+                                       $node->del();
+                               } else {
+                                       dbg('chan', "$call not in table, dropped");
+                                       return;
+                               }
                        }
                        last SWITCH;
                }
@@ -395,6 +449,15 @@ sub normal
                }
                
                if ($pcno == 23 || $pcno == 27) { # WWV info
+                       
+                       # route 'foreign' pc27s 
+                       if ($pcno == 27) {
+                               if ($field[8] ne $main::mycall) {
+                                       route($field[8], $line);
+                                       return;
+                               }
+                       }
+
                        # do some de-duping
                        my $d = cltounix($field[1], sprintf("%02d18Z", $field[2]));
                        my $sfi = unpad($field[3]);
@@ -425,7 +488,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;
                }
                
@@ -437,8 +500,8 @@ sub normal
                }
                
                if ($pcno == 25) {      # merge request
-                       unless ($field[1] eq $main::mycall) {
-                               dbg('chan', "merge request to $field[1] from $field[2] ignored");
+                       if ($field[1] ne $main::mycall) {
+                               route($field[1], $line);
                                return;
                        }
 
@@ -449,7 +512,7 @@ sub normal
                                my @in = reverse Spot::search(1, undef, undef, 0, $field[3]-1);
                                my $in;
                                foreach $in (@in) {
-                                       $self->send(pc26(@{$in}[0..4], $in->[7]));
+                                       $self->send(pc26(@{$in}[0..4], $field[2]));
                                }
                        }
 
@@ -458,34 +521,44 @@ sub normal
                                my @in = reverse Geomag::search(0, $field[4], time, 1);
                                my $in;
                                foreach $in (@in) {
-                                       $self->send(pc27(@{$in}));
+                                       $self->send(pc27(@{$in}[0..5], $field[2]));
                                }
                        }
                        return;
                }
-               
+
                if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling
-                       DXMsg::process($self, $line);
+                       if ($field[1] eq $main::mycall) {
+                               DXMsg::process($self, $line);
+                       } else {
+                               route($field[1], $line);
+                       }
                        return;
                }
                
                if ($pcno == 34 || $pcno == 36) { # remote commands (incoming)
                        if ($field[1] eq $main::mycall) {
                                my $ref = DXUser->get_current($field[2]);
+                               my $cref = DXCluster->get($field[2]);
                                Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]);
-                               unless ($field[3] =~ /rcmd/i) {    # not allowed to relay RCMDS!
+                               unless ($field[3] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) {    # not allowed to relay RCMDS!
                                        if ($ref->{priv}) {     # you have to have SOME privilege, the commands have further filtering
                                                $self->{remotecmd} = 1; # for the benefit of any command that needs to know
+                                               my $oldpriv = $self->{priv};
+                                               $self->{priv} = $ref->{priv};     # assume the user's privilege level
                                                my @in = (DXCommandmode::run_cmd($self, $field[3]));
+                                               $self->{priv} = $oldpriv;
                                                for (@in) {
                                                        s/\s*$//og;
                                                        $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_"));
                                                        Log('rcmd', 'out', $field[2], $_);
                                                }
                                                delete $self->{remotecmd};
+                                       } else {
+                                               $self->send(pc35($main::mycall, $field[2], "$main::mycall:sorry...!"));
                                        }
                                } else {
-                                       $self->send(pc35($main::mycall, $field[2], "$main::mycall:Tut tut tut...!"));
+                                       $self->send(pc35($main::mycall, $field[2], "$main::mycall:your attempt is logged, Tut tut tut...!"));
                                }
                        } else {
                                route($field[1], $line);
@@ -507,10 +580,8 @@ sub normal
                        return;
                }
                
-               if ($pcno == 37) {
-                       last SWITCH;
-               }
-               
+               # for pc 37 see 44 onwards
+
                if ($pcno == 38) {              # node connected list from neighbour
                        return;
                }
@@ -547,25 +618,21 @@ sub normal
                if ($pcno == 43) {
                        last SWITCH;
                }
-               if ($pcno == 44) {
-                       last SWITCH;
-               }
-               if ($pcno == 45) {
-                       last SWITCH;
-               }
-               if ($pcno == 46) {
-                       last SWITCH;
-               }
-               if ($pcno == 47) {
-                       last SWITCH;
-               }
-               if ($pcno == 48) {
-                       last SWITCH;
+               if ($pcno == 37 || $pcno == 44 || $pcno == 45 || $pcno == 46 || $pcno == 47 || $pcno == 49) {
+                       if ($field[1] eq $main::mycall) {
+                               ;
+                       } else {
+                               route($field[1], $line);
+                       }
+                       return;
                }
                
                if ($pcno == 50) {              # keep alive/user list
-                       my $ref = DXCluster->get_exact($field[1]);
-                       $ref->update_users($field[2]) if $ref;                  
+                       my $node = DXCluster->get_exact($field[1]);
+                       if ($node) {
+                               return unless $node->dxchan == $self;
+                               $node->update_users($field[2]);
+                       }
                        last SWITCH;
                }
                
@@ -640,6 +707,10 @@ sub process
                while (($key, $val) = each %wwvdup) {
                        delete $wwvdup{$key} if $val < $cutoff;
                }
+               $cutoff = $main::systime - $pc12_dup_age;
+               while (($key, $val) = each %anndup) {
+                       delete $anndup{$key} if $val < $cutoff;
+               }
                $last_hour = $main::systime;
        }
 }
@@ -671,7 +742,7 @@ sub finish
        delete $pings{$call};
        
        # now broadcast to all other ak1a nodes that I have gone
-       broadcast_ak1a(pc21($call, 'Gone.'), $self);
+       broadcast_ak1a(pc21($call, 'Gone.'), $self) unless $self->{isolate};
        
        Log('DXProt', $call . " Disconnected");
        $ref->del() if $ref;
@@ -680,30 +751,77 @@ 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 && $dxchan->{dx}) {
+                       my $buf = Spot::formatb($_[0], $_[1], $_[2], $_[3], $_[4]);
+                       $buf .= "\a\a" if $dxchan->{beep};
+                       if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
+                               $dxchan->send($buf) if !$hops || ($hops && $filter);
+                       } else {
+                               $dxchan->delay($buf) if !$hops || ($hops && $filter);
+                       }
+               }                                       
+       }
+}
 
 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 { $_->{call} ne $main::mycall } @nodes;
+               @nodes = grep { $_->dxchan != $self } @nodes if @nodes;
+               @nodes = grep { !$_->dxchan->{isolate} } @nodes if @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) {
@@ -734,7 +852,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
@@ -750,6 +869,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
@@ -778,13 +914,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 {