fix msg aging
[spider.git] / perl / DXProt.pm
index d26795c406a3921c3387a2e6e08f87b4992ac6d2..330e7a60eba433069a65a217ad5ebbb56ae91312 100644 (file)
@@ -38,12 +38,13 @@ use strict;
 
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
                        $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
+                       $pingint $obscount
                        %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
 
@@ -65,6 +66,8 @@ $rspfcheck = 1;
 $eph_restime = 180;
 $eph_info_restime = 60*60;
 $eph_pc34_restime = 30;
+$pingint = 5*60;
+$obscount = 2;
 
 @checklist = 
 (
@@ -185,19 +188,8 @@ sub check
 
 sub init
 {
-       my $user = DXUser->get($main::mycall);
-       $DXProt::myprot_version += $main::version*100;
-       $main::me = DXProt->new($main::mycall, 0, $user); 
-       $main::me->{here} = 1;
-       $main::me->{state} = "indifferent";
        do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
        confess $@ if $@;
-       $main::me->{sort} = 'S';    # S for spider
-       $main::me->{priv} = 9;
-       $main::me->{metric} = 0;
-       $main::me->{pingave} = 0;
-       
-#      $Route::Node::me->adddxchan($main::me);
 }
 
 #
@@ -266,9 +258,9 @@ sub start
        
        # ping neighbour node stuff
        my $ping = $user->pingint;
-       $ping = 5*60 unless defined $ping;
+       $ping = $pingint unless defined $ping;
        $self->{pingint} = $ping;
-       $self->{nopings} = $user->nopings || 2;
+       $self->{nopings} = $user->nopings || $obscount;
        $self->{pingtime} = [ ];
        $self->{pingave} = 999;
        $self->{metric} ||= 100;
@@ -276,7 +268,7 @@ sub start
 
        # send initialisation string
        unless ($self->{outbound}) {
-               $self->send(pc18());
+               $self->sendinit;
        }
        
        $self->state('init');
@@ -290,6 +282,16 @@ sub start
        $script->run($self) if $script;
 }
 
+#
+# send outgoing 'challenge'
+#
+
+sub sendinit
+{
+       my $self = shift;
+       $self->send(pc18());
+}
+
 #
 # This is the normal pcxx despatcher
 #
@@ -349,6 +351,20 @@ sub normal
                                $to = $field[2];
                        }
 
+                       # if this is a 'nodx' node then ignore it
+                       if ($badnode->in($field[6]) || ($via && $badnode->in($via))) {
+                               dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
+                               return;
+                       }
+
+                       # if this is a 'bad spotter' user then ignore it
+                       my $nossid = $from;
+                       $nossid =~ s/-\d+$//;
+                       if ($badspotter->in($nossid)) {
+                               dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
+                               return;
+                       }
+
                        # 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])) {
@@ -408,7 +424,9 @@ sub normal
                        }
                        
                        # if this is a 'bad spotter' user then ignore it
-                       if ($badspotter->in($field[6])) {
+                       my $nossid = $field[6];
+                       $nossid =~ s/-\d+$//;
+                       if ($badspotter->in($nossid)) {
                                dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
                                return;
                        }
@@ -442,6 +460,7 @@ sub normal
                                }
                        }
 
+
                        my @spot = Spot::prepare($field[1], $field[2], $d, $field[5], $field[6], $field[7]);
                        # global spot filtering on INPUT
                        if ($self->{inspotsfilter}) {
@@ -451,8 +470,11 @@ sub normal
                                        return;
                                }
                        }
-                       
-                       if (Spot::dup($field[1], $field[2], $d, $field[5])) {
+
+                       # this goes after the input filtering, but before the add
+                       # so that if it is input filtered, it isn't added to the dup
+                       # list. This allows it to come in from a "legitimate" source
+                       if (Spot::dup($field[1], $field[2], $d, $field[5], $field[6])) {
                                dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chanerr');
                                return;
                        }
@@ -545,6 +567,20 @@ sub normal
                                }
                        }
 
+                       # if this is a 'nodx' node then ignore it
+                       if ($badnode->in($field[5])) {
+                               dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr');
+                               return;
+                       }
+
+                       # if this is a 'bad spotter' user then ignore it
+                       my $nossid = $field[1];
+                       $nossid =~ s/-\d+$//;
+                       if ($badspotter->in($nossid)) {
+                               dbg("PCPROT: Bad Spotter, dropped") if isdbg('chanerr');
+                               return;
+                       }
+
                        if ($field[2] eq '*' || $field[2] eq $main::mycall) {
 
 
@@ -592,6 +628,12 @@ sub normal
                        my $ncall = $field[1];
                        my $newline = "PC16^";
                        
+                       # do I want users from this channel?
+                       unless ($self->user->wantpc16) {
+                               dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
+                               return;
+                       }
+                       # is it me?
                        if ($ncall eq $main::mycall) {
                                dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
                                return;
@@ -617,7 +659,7 @@ sub normal
                                next unless $call && $conf && defined $here && is_callsign($call);
                                next if $call eq $main::mycall;
 
-                               eph_del_regex("^PC17\^$call\^$ncall");
+                               eph_del_regex("^PC17\\^$call\\^$ncall");
                                
                                $conf = $conf eq '*';
 
@@ -664,13 +706,13 @@ sub normal
                        my $ncall = $field[2];
                        my $ucall = $field[1];
 
-                       if (eph_dup($line)) {
-                               dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
+                       eph_del_regex("^PC16\\^$ncall.*$ucall");
+                       
+                       # do I want users from this channel?
+                       unless ($self->user->wantpc16) {
+                               dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
                                return;
                        }
-
-                       eph_del_regex("^PC16.*$ncall.*$ucall");
-                       
                        if ($ncall eq $main::mycall) {
                                dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
                                return;
@@ -697,6 +739,12 @@ sub normal
                        return unless $self->in_filter_route($parent);
                        
                        $parent->del_user($uref);
+
+                       if (eph_dup($line)) {
+                               dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
+                               return;
+                       }
+
                        $self->route_pc17($parent, $uref);
                        return;
                }
@@ -704,6 +752,23 @@ sub normal
                if ($pcno == 18) {              # link request
                        $self->state('init');   
 
+                       # record the type and version offered
+                       if ($field[1] =~ /DXSpider Version: (\d+\.\d+) Build: (\d+\.\d+)/) {
+                               $self->version(53 + $1);
+                               $self->user->version(53 + $1);
+                               $self->build(0 + $2);
+                               $self->user->build(0 + $2);
+                               unless ($self->is_spider) {
+                                       $self->user->sort('S');
+                                       $self->user->put;
+                                       $self->sort('S');
+                               }
+                       } else {
+                               $self->version(50.0);
+                               $self->version($field[2] / 100) if $field[2] && $field[2] =~ /^\d+$/;
+                               $self->user->version($self->version);
+                       }
+
                        # first clear out any nodes on this dxchannel
                        my $parent = Route::Node::get($self->{call});
                        my @rout = $parent->del_nodes;
@@ -739,7 +804,7 @@ sub normal
                                my $ver = $field[$i+3];
                                next unless defined $here && defined $conf && is_callsign($call);
 
-                               eph_del_regex("^PC(?:21\^$call|17\^[^\^]+\^$call)");
+                               eph_del_regex("^PC(?:21\\^$call|17\\^[^\\^]+\\^$call)");
                                
                                # check for sane parameters
 #                              $ver = 5000 if $ver eq '0000';
@@ -751,7 +816,7 @@ sub normal
                                my $dxchan = DXChannel->get($call);
                                if ($dxchan && $dxchan != $self) {
                                        dbg("PCPROT: PC19 from $self->{call} trying to alter wrong locally connected $call, ignored!") if isdbg('chanerr');
-                                       return;
+                                       next;
                                }
 
                                # update it if required
@@ -821,21 +886,15 @@ sub normal
                if ($pcno == 21) {              # delete a cluster from the list
                        my $call = uc $field[1];
 
-                       if (eph_dup($line)) {
-                               dbg("PCPROT: dup PC21 detected") if isdbg('chanerr');
-                               return;
-                       }
-
+                       eph_del_regex("^PC1[79].*$call");
+                       
                        # if I get a PC21 from the same callsign as self then treat it
                        # as a PC39: I have gone away
                        if ($call eq $self->call) {
                                $self->disconnect(1);
-                               eph_del_regex("^PC(?:1[679]|21).*$field[1]");
                                return;
                        }
 
-                       eph_del_regex("^PC1[79].*$call");
-                       
                        my @rout;
                        my $parent = Route::Node::get($self->{call});
                        unless ($parent) {
@@ -864,6 +923,11 @@ sub normal
                                return;
                        }
 
+#                      if (eph_dup($line)) {
+#                              dbg("PCPROT: dup PC21 detected") if isdbg('chanerr');
+#                              return;
+#                      }
+
                        $self->route_pc21(@rout) if @rout;
                        return;
                }
@@ -989,7 +1053,7 @@ sub normal
                }
                
                if ($pcno == 35) {              # remote command replies
-                       eph_del_regex("^PC35\^$field[2]\^$field[1]\^");
+                       eph_del_regex("^PC35\\^$field[2]\\^$field[1]\\^");
                        $self->process_rcmd_reply($field[1], $field[2], $field[1], $field[3]);
                        return;
                }
@@ -1003,7 +1067,6 @@ sub normal
                if ($pcno == 39) {              # incoming disconnect
                        if ($field[1] eq $self->{call}) {
                                $self->disconnect(1);
-                               eph_del_regex("^PC(?:1[679]|21).*$field[1]");
                        } else {
                                dbg("PCPROT: came in on wrong channel") if isdbg('chanerr');
                        }
@@ -1029,7 +1092,7 @@ sub normal
 
                        # add this station to the user database, if required
                        my $user = DXUser->get_current($call);
-                       $user = DXUser->new($call) if !$user;
+                       $user = DXUser->new($call) unless $user;
                        
                        if ($field[2] == 1) {
                                $user->name($field[3]);
@@ -1135,11 +1198,6 @@ sub normal
                                                                        } else {
                                                                                $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
                                                                        }
-#                                                                      my $st;
-#                                                                      for (@{$tochan->{pingtime}}) {
-#                                                                              $st += $_;
-#                                                                      }
-#                                                                      $tochan->{pingave} = $st / @{$tochan->{pingtime}};
                                                                        $tochan->{nopings} = $nopings; # pump up the timer
                                                                }
                                                        } 
@@ -1204,6 +1262,9 @@ sub normal
                        
                        return;
                }
+               if ($pcno == 90) {              # new style PC16,17,19,21
+                       return;
+               }
        }
         
        # if get here then rebroadcast the thing with its Hop count decremented (if
@@ -1245,7 +1306,7 @@ sub process
                next unless $dxchan->is_node();
                next if $dxchan == $main::me;
 
-               # send the pc50
+               # send the pc50 or PC90
                $dxchan->send($pc50s) if $pc50s;
                
                # send a ping out on this channel
@@ -1282,6 +1343,7 @@ sub process
 # some active measures
 #
 
+
 sub send_dx_spot
 {
        my $self = shift;
@@ -1450,24 +1512,27 @@ sub send_announce
 
        # obtain country codes etc 
        my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my ($ann_state, $org_state) = ("", "");
        my @dxcc = Prefix::extract($_[0]);
        if (@dxcc > 0) {
                $ann_dxcc = $dxcc[1]->dxcc;
                $ann_itu = $dxcc[1]->itu;
                $ann_cq = $dxcc[1]->cq;                                         
+               $ann_state = $dxcc[1]->state;
        }
        @dxcc = Prefix::extract($_[4]);
        if (@dxcc > 0) {
                $org_dxcc = $dxcc[1]->dxcc;
                $org_itu = $dxcc[1]->itu;
                $org_cq = $dxcc[1]->cq;                                         
+               $org_state = $dxcc[1]->state;
        }
 
        if ($self->{inannfilter}) {
                my ($filter, $hops) = 
                        $self->{inannfilter}->it(@_, $self->{call}, 
                                                                         $ann_dxcc, $ann_itu, $ann_cq,
-                                                                        $org_dxcc, $org_itu, $org_cq);
+                                                                        $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
                unless ($filter) {
                        dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
                        return;
@@ -1511,7 +1576,7 @@ sub announce
 sub send_local_config
 {
        my $self = shift;
-       my $n;
+       my $node;
        my @nodes;
        my @localnodes;
        my @remotenodes;
@@ -1530,18 +1595,21 @@ sub send_local_config
                my @intcalls = map { $_->nodes } @localnodes if @localnodes;
                my $ref = Route::Node::get($self->{call});
                my @rnodes = $ref->nodes;
-               for my $n (@intcalls) {
-                       push @remotenodes, Route::Node::get($n) unless grep $n eq $_, @rnodes;
+               for my $node (@intcalls) {
+                       push @remotenodes, Route::Node::get($node) unless grep $node eq $_, @rnodes;
                }
                unshift @localnodes, $main::routeroot;
        }
        
-       send_route($self, \&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
+
+       $self->send_route(\&pc19, scalar(@localnodes)+scalar(@remotenodes), @localnodes, @remotenodes);
        
        # get all the users connected on the above nodes and send them out
-       foreach $n (@localnodes, @remotenodes) {
-               if ($n) {
-                       send_route($self, \&pc16, 1, $n, map {my $r = Route::User::get($_); $r ? ($r) : ()} $n->users);
+       foreach $node (@localnodes, @remotenodes) {
+               if ($node) {
+                       $self->send_route(\&pc16, 1, $node, 
+                                                         map {my $r = Route::User::get($_); $r ? ($r) : ()} $node->users)
+                               if $self->user->wantsendpc16;
                } else {
                        dbg("sent a null value") if isdbg('chanerr');
                }
@@ -1762,6 +1830,10 @@ sub disconnect
                $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op")));
        }
 
+       # get rid of any PC16 and 19s
+       eph_del_regex("^PC16\\^$call");
+       eph_del_regex("^PC19\\^.*$call");
+
        # do routing stuff
        my $node = Route::Node::get($call);
        my @rout;
@@ -1822,7 +1894,7 @@ sub send_route
                if (!$self->{isolate} && $self->{routefilter}) {
                        $filter = undef;
                        if ($r) {
-                               ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq);
+                               ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->{state}, $r->{state});
                                if ($filter) {
                                        push @rin, $r;
                                } else {
@@ -1861,6 +1933,9 @@ sub broadcast_route
                foreach $dxchan (@dxchan) {
                        next if $dxchan == $self;
                        next if $dxchan == $main::me;
+                       next if $dxchan->user->wantnp;
+                       next if ($generate == \&pc16 || $generate==\&pc17) && !$dxchan->user->wantsendpc16;
                        $dxchan->send_route($generate, @_);
                }
        }
@@ -1869,12 +1944,14 @@ sub broadcast_route
 sub route_pc16
 {
        my $self = shift;
+       return unless $self->user->wantpc16;
        broadcast_route($self, \&pc16, 1, @_);
 }
 
 sub route_pc17
 {
        my $self = shift;
+       return unless $self->user->wantpc16;
        broadcast_route($self, \&pc17, 1, @_);
 }
 
@@ -1908,6 +1985,12 @@ sub route_pc50
        broadcast_route($self, \&pc50, 1, @_);
 }
 
+sub route_pc90
+{
+       my $self = shift;
+       broadcast_route($self, \&pc90, 1, @_);
+}
+
 sub in_filter_route
 {
        my $self = shift;
@@ -1915,7 +1998,7 @@ sub in_filter_route
        my ($filter, $hops) = (1, 1);
        
        if ($self->{inroutefilter}) {
-               ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq);
+               ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->state, $r->state);
                dbg("PCPROT: $self->{call}/" . $r->call . ' rejected by in_filter_route') if !$filter && isdbg('chanerr');
        }
        return $filter;