add delete_interface on disconnect
[spider.git] / perl / DXProt.pm
index a7a82a7b77486b12e11c68d8e4f858ab97f42350..c96d787e41ba3f27010ef46b385d72765a84e2df 100644 (file)
@@ -33,6 +33,9 @@ use DXHash;
 use Route;
 use Route::Node;
 use Script;
+use Investigate;
+use RouteDB;
+
 
 use strict;
 
@@ -45,6 +48,7 @@ $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 %pc19list $chatdupeage
+                       $investigation_int $pc19_version
                        %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
 
@@ -71,6 +75,8 @@ $eph_pc34_restime = 30;
 $pingint = 5*60;
 $obscount = 2;
 $chatdupeage = 20 * 60 * 60;
+$investigation_int = 12*60*60; # time between checks to see if we can see this node
+$pc19_version = 5466;                  # the visible version no for outgoing PC19s generated from pc59
 
 @checklist = 
 (
@@ -411,6 +417,10 @@ sub handle_10
                }
        }
 
+       # remember a route to this node and also the node on which this user is
+       RouteDB::update($_[6], $self->{call});
+#      RouteDB::update($to, $_[6]);
+
        # it is here and logged on
        $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
        $dxchan = DXChannel->get($to) unless $dxchan;
@@ -431,6 +441,8 @@ sub handle_10
                return;
        }
 
+       # can we see an interface to send it down?
+       
        # not visible here, send a message of condolence
        $vref = undef;
        $ref = Route::get($from);
@@ -503,7 +515,10 @@ sub handle_11
                }
        }
 
-
+       # remember a route
+#      RouteDB::update($_[7], $self->{call});
+#      RouteDB::update($_[6], $_[7]);
+       
        my @spot = Spot::prepare($_[1], $_[2], $d, $_[5], $_[6], $_[7]);
        # global spot filtering on INPUT
        if ($self->{inspotsfilter}) {
@@ -629,12 +644,17 @@ sub handle_12
                return;
        }
 
+
        my $dxchan;
        
        if ((($dxchan = DXChannel->get($_[2])) && $dxchan->is_user) || $_[4] =~ /^[\#\w.]+$/){
                $self->send_chat($line, @_[1..6]);
        } elsif ($_[2] eq '*' || $_[2] eq $main::mycall) {
 
+               # remember a route
+#              RouteDB::update($_[5], $self->{call});
+#              RouteDB::update($_[1], $_[5]);
+
                # ignore something that looks like a chat line coming in with sysop
                # flag - this is a kludge...
                if ($_[3] =~ /^\#\d+ / && $_[4] eq '*') {
@@ -671,17 +691,12 @@ sub handle_16
        my $line = shift;
        my $origin = shift;
 
-       if (eph_dup($line)) {
-               dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
-               return;
-       }
-
        # general checks
        my $dxchan;
        my $ncall = $_[1];
        my $newline = "PC16^";
                        
-       # do I want users from this channel?
+       # dos I want users from this channel?
        unless ($self->user->wantpc16) {
                dbg("PCPROT: don't send users to $self->{call}") if isdbg('chanerr');
                return;
@@ -691,6 +706,24 @@ sub handle_16
                dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr');
                return;
        }
+
+       RouteDB::update($ncall, $self->{call});
+
+       # do we believe this call? 
+       unless ($ncall eq $self->{call} || $self->is_believed($ncall)) {
+               if (my $ivp = Investigate::get($ncall, $self->{call})) {
+                       $ivp->store_pcxx($pcno,$line,$origin,@_);
+               } else {
+                       dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr');
+               }
+               return;
+       }
+
+       if (eph_dup($line)) {
+               dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
+               return;
+       }
+
        my $parent = Route::Node::get($ncall); 
 
        # if there is a parent, proceed, otherwise if there is a latent PC19 in the PC19list, 
@@ -830,6 +863,18 @@ sub handle_17
                return;
        }
 
+       RouteDB::delete($ncall, $self->{call});
+
+       # do we believe this call? 
+       unless ($ncall eq $self->{call} || $self->is_believed($ncall)) {
+               if (my $ivp = Investigate::get($ncall, $self->{call})) {
+                       $ivp->store_pcxx($pcno,$line,$origin,@_);
+               } else {
+                       dbg("PCPROT: We don't believe $ncall on $self->{call}") if isdbg('chanerr');
+               }
+               return;
+       }
+
        my $uref = Route::User::get($ucall);
        unless ($uref) {
                dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
@@ -907,11 +952,6 @@ sub handle_19
        my $i;
        my $newline = "PC19^";
 
-       if (eph_dup($line)) {
-               dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
-               return;
-       }
-
        # new routing list
        my @rout;
 
@@ -931,13 +971,13 @@ sub handle_19
                        my $user = DXUser->get_current($origin);
                        if (!$user) {
                                $user = DXUser->new($origin);
-                               $user->sort('S');
                                $user->priv(1);         # I have relented and defaulted nodes
                                $user->lockout(1);
                                $user->homenode($origin);
                                $user->node($origin);
                                $user->wantroutepc19(1);
                        }
+                       $user->sort('A') unless $user->is_node;
                        $user->put;
                }
                $parent = $op;
@@ -970,12 +1010,35 @@ sub handle_19
                my $user = DXUser->get_current($call);
                if (!$user) {
                        $user = DXUser->new($call);
-                       $user->sort('A');
                        $user->priv(1);         # I have relented and defaulted nodes
                        $user->lockout(1);
                        $user->homenode($call);
                        $user->node($call);
                }
+               $user->sort('A') unless $user->is_node;
+
+               RouteDB::update($call, $self->{call});
+
+               # do we believe this call?
+               my $genline = "PC19^$here^$call^$conf^$ver^$_[-1]^"; 
+               unless ($call eq $self->{call} || $self->is_believed($call)) {
+                       my $pt = $user->lastping($self->{call}) || 0;
+                       if ($pt+$investigation_int < $main::systime && !Investigate::get($call, $self->{call})) {
+                               my $ivp  = Investigate->new($call, $self->{call});
+                               $ivp->version($ver);
+                               $ivp->here($here);
+                               $ivp->store_pcxx($pcno,$genline,$origin,'PC19',$here,$call,$conf,$ver,$_[-1]);
+                       } else {
+                               dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr');
+                       }
+                       $user->put;
+                       next;
+               }
+
+               if (eph_dup($genline)) {
+                       dbg("PCPROT: dup PC19 for $call detected") if isdbg('chanerr');
+                       next;
+               }
 
                my $r = Route::Node::get($call);
                my $flags = Route::here($here)|Route::conf($conf);
@@ -1058,6 +1121,18 @@ sub handle_21
                return;
        }
 
+       RouteDB::delete($call, $self->{call});
+
+       # check if we believe this
+       unless ($call eq $self->{call} || $self->is_believed($call)) {
+               if (my $ivp = Investigate::get($call, $self->{call})) {
+                       $ivp->store_pcxx($pcno,$line,$origin,@_);
+               } else {
+                       dbg("PCPROT: We don't believe $call on $self->{call}") if isdbg('chanerr');
+               }
+               return;
+       }
+
        # check to see if we are in the pc19list, if we are then don't bother with any of
        # this routing table manipulation, just remove it from the list and dump it
        my @rout;
@@ -1124,7 +1199,10 @@ sub handle_23
                }
        }
 
-       return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7]);
+       # only do a rspf check on PC23 (not 27)
+       if ($pcno == 23) {
+               return if $rspfcheck and !$self->rspfcheck(1, $_[8], $_[7])
+       }
 
        # do some de-duping
        my $d = cltounix($_[1], sprintf("%02d18Z", $_[2]));
@@ -1420,6 +1498,9 @@ sub handle_50
        my $origin = shift;
 
        my $call = $_[1];
+
+       RouteDB::update($call, $self->{call});
+
        my $node = Route::Node::get($call);
        if ($node) {
                return unless $node->call eq $self->{call};
@@ -1467,25 +1548,35 @@ sub handle_51
                                                        my $nopings = $tochan->user->nopings || $obscount;
                                                        push @{$tochan->{pingtime}}, $t;
                                                        shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
-
-                                                               # cope with a missed ping, this means you must set the pingint large enough
+                                                       
+                                                       # cope with a missed ping, this means you must set the pingint large enough
                                                        if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
                                                                $t -= $tochan->{pingint};
                                                        }
-
-                                                               # calc smoothed RTT a la TCP
+                                                       
+                                                       # calc smoothed RTT a la TCP
                                                        if (@{$tochan->{pingtime}} == 1) {
                                                                $tochan->{pingave} = $t;
                                                        } else {
                                                                $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
                                                        }
                                                        $tochan->{nopings} = $nopings; # pump up the timer
+                                                       if (my $ivp = Investigate::get($from, $self->{call})) {
+                                                               $ivp->handle_ping;
+                                                       }
+                                               } elsif (my $rref = Route::Node::get($r->{call})) {
+                                                       if (my $ivp = Investigate::get($from, $self->{call})) {
+                                                               $ivp->handle_ping;
+                                                       }
                                                }
-                                       } 
+                                       }
                                }
                        }
                }
        } else {
+
+               RouteDB::update($from, $self->{call});
+
                if (eph_dup($line)) {
                        dbg("PCPROT: dup PC51 detected") if isdbg('chanerr');
                        return;
@@ -1623,6 +1714,8 @@ sub process
                }
        }
 
+       Investigate::process();
+
        # every ten seconds
        if ($t - $last10 >= 10) {       
                # clean out ephemera 
@@ -1703,20 +1796,8 @@ 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($_[6]);
-       if (@dxcc > 0) {
-               $wwv_dxcc = $dxcc[1]->dxcc;
-               $wwv_itu = $dxcc[1]->itu;
-               $wwv_cq = $dxcc[1]->cq;                                         
-       }
-       @dxcc = Prefix::extract($_[7]);
-       if (@dxcc > 0) {
-               $org_dxcc = $dxcc[1]->dxcc;
-               $org_itu = $dxcc[1]->itu;
-               $org_cq = $dxcc[1]->cq;                                         
-       }
-       
+       my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]);
+
        # 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) {
@@ -1725,7 +1806,7 @@ sub send_wwv_spot
                my $routeit;
                my ($filter, $hops);
 
-               $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, @dxcc);
        }
 }
 
@@ -1749,19 +1830,7 @@ 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($_[10]);
-       if (@dxcc > 0) {
-               $wcy_dxcc = $dxcc[1]->dxcc;
-               $wcy_itu = $dxcc[1]->itu;
-               $wcy_cq = $dxcc[1]->cq;                                         
-       }
-       @dxcc = Prefix::extract($_[11]);
-       if (@dxcc > 0) {
-               $org_dxcc = $dxcc[1]->dxcc;
-               $org_itu = $dxcc[1]->itu;
-               $org_cq = $dxcc[1]->cq;                                         
-       }
+       my @dxcc = ((Prefix::cty_data($_[10]))[0..2], (Prefix::cty_data($_[11]))[0..2]);
        
        # 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
@@ -1769,7 +1838,7 @@ sub send_wcy_spot
                next if $dxchan == $main::me;
                next if $dxchan == $self;
 
-               $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, @dxcc);
        }
 }
 
@@ -1813,28 +1882,13 @@ 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;
-       }
-
+       my @a = Prefix::cty_data($_[0]);
+       my @b = Prefix::cty_data($_[4]);
        if ($self->{inannfilter}) {
                my ($filter, $hops) = 
                        $self->{inannfilter}->it(@_, $self->{call}, 
-                                                                        $ann_dxcc, $ann_itu, $ann_cq,
-                                                                        $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
+                                                                        @a[0..2],
+                                                                        @b[0..2], $a[3], $b[3]);
                unless ($filter) {
                        dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
                        return;
@@ -1853,7 +1907,8 @@ sub send_announce
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self && $self->is_node;
-               $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call},
+                                                 @a[0..2], @b[0..2]);
        }
 }
 
@@ -1883,28 +1938,13 @@ sub send_chat
        }
        
        # 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;
-       }
-
+       my @a = Prefix::cty_data($_[0]);
+       my @b = Prefix::cty_data($_[4]);
        if ($self->{inannfilter}) {
                my ($filter, $hops) = 
                        $self->{inannfilter}->it(@_, $self->{call}, 
-                                                                        $ann_dxcc, $ann_itu, $ann_cq,
-                                                                        $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
+                                                                        @a[0..2],
+                                                                        @b[0..2], $a[3], $b[3]);
                unless ($filter) {
                        dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
                        return;
@@ -1934,7 +1974,8 @@ sub send_chat
                        }
                }
                
-               $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
+               $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], 
+                                         $text, @_, $self->{call}, @a[0..2], @b[0..2]);
        }
 }
 
@@ -2015,6 +2056,7 @@ sub send_local_config
 #
 # is called route(to, pcline);
 #
+
 sub route
 {
        my ($self, $call, $line) = @_;
@@ -2026,7 +2068,9 @@ sub route
 
        # always send it down the local interface if available
        my $dxchan = DXChannel->get($call);
-       unless ($dxchan) {
+       if ($dxchan) {
+               dbg("route: $call -> $dxchan->{call} direct" ) if isdbg('route');
+       } else {
                my $cl = Route::get($call);
                $dxchan = $cl->dxchan if $cl;
                if (ref $dxchan) {
@@ -2034,8 +2078,23 @@ sub route
                                dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
                                return;
                        }
+                       dbg("route: $call -> $dxchan->{call} using normal route" ) if isdbg('route');
                }
        }
+
+       # try the backstop method
+       unless ($dxchan) {
+               my $rcall = RouteDB::get($call);
+               if ($rcall) {
+                       if ($self && $rcall eq $self->{call}) {
+                               dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chanerr');
+                               return;
+                       }
+                       $dxchan = DXChannel->get($rcall);
+                       dbg("route: $call -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
+               }
+       }
+
        if ($dxchan) {
                my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
                if ($routeit) {
@@ -2107,14 +2166,23 @@ sub load_hops
 # add a ping request to the ping queues
 sub addping
 {
-       my ($from, $to) = @_;
+       my ($from, $to, $via) = @_;
        my $ref = $pings{$to} || [];
        my $r = {};
        $r->{call} = $from;
        $r->{t} = [ gettimeofday ];
-       route(undef, $to, pc51($to, $main::mycall, 1));
+       if ($via && (my $dxchan = DXChannel->get($via))) {
+               $dxchan->send(pc51($to, $main::mycall, 1));
+       } else {
+               route(undef, $to, pc51($to, $main::mycall, 1));
+       }
        push @$ref, $r;
        $pings{$to} = $ref;
+       my $u = DXUser->get_current($to);
+       if ($u) {
+               $u->lastping(($via || $from), $main::systime);
+               $u->put;
+       }
 }
 
 sub process_rcmd
@@ -2239,6 +2307,8 @@ sub disconnect
                        eph_del_regex("^PC1[679].*$c");
                }
        }
+
+       RouteDB::delete_interface($call);
        
        # remove them from the pc19list as well
        while (my ($k,$v) = each %pc19list) {
@@ -2438,6 +2508,7 @@ sub eph_dup
        $s =~ s/\^H\d\d?\^?\~?$//;
        $r = 1 if exists $eph{$s};    # pump up the dup if it keeps circulating
        $eph{$s} = $main::systime + $t;
+       dbg("PCPROT: emphemeral duplicate") if $r && isdbg('chanerr'); 
        return $r;
 }