added some diddling to cope with ab5k not always returning a ping
[spider.git] / perl / DXProt.pm
index ced5b4f05f68c46d7cf9dd431136108075dbb18b..023daa334e9e03b9545a0d0b0598d6f7adab700e 100644 (file)
@@ -34,7 +34,14 @@ use Route;
 use Route::Node;
 
 use strict;
-use vars qw($me $pc11_max_age $pc23_max_age
+
+use vars qw($VERSION $BRANCH);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
+use vars qw($me $pc11_max_age $pc23_max_age $last_pc50
                        $last_hour $last10 %eph  %pings %rcmds
                        %nodehops $baddx $badspotter $badnode $censorpc
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
@@ -52,7 +59,7 @@ $censorpc = 1;                                        # Do a BadWords::check on text fields and reject things
 $baddx = new DXHash "baddx";
 $badspotter = new DXHash "badspotter";
 $badnode = new DXHash "badnode";
-$last10 = time;
+$last10 = $last_pc50 = time;
 
 @checklist = 
 (
@@ -213,18 +220,21 @@ sub start
        # remember type of connection
        $self->{consort} = $line;
        $self->{outbound} = $sort eq 'O';
-       $self->{priv} = $user->priv || 1;     # other clusters can always be 'normal' users
+       my $priv = $user->priv;
+       $priv = $user->priv(1) unless $priv;
+       $self->{priv} = $priv;     # other clusters can always be 'normal' users
        $self->{lang} = $user->lang || 'en';
        $self->{isolate} = $user->{isolate};
        $self->{consort} = $line;       # save the connection type
        $self->{here} = 1;
+       $self->{width} = 80;
 
        # get the output filters
        $self->{spotsfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
        $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0);
        $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0);
        $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ;
-       $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) ;
+       $self->{routefilter} = Filter::read_in('route', $call, 0) || Filter::read_in('route', 'node_default', 0) unless $self->{isolate} ;
 
 
        # get the INPUT filters (these only pertain to Clusters)
@@ -232,7 +242,7 @@ sub start
        $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1);
        $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1);
        $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1);
-       $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1);
+       $self->{inroutefilter} = Filter::read_in('route', $call, 1) || Filter::read_in('route', 'node_default', 1) unless $self->{isolate};
        
        # set unbuffered and no echo
        $self->send_now('B',"0");
@@ -244,15 +254,14 @@ sub start
        $self->{pingint} = $ping;
        $self->{nopings} = $user->nopings || 2;
        $self->{pingtime} = [ ];
-       $self->{pingave} = 0;
+       $self->{pingave} = 999;
+       $self->{lastping} = $main::systime;
 
        # send initialisation string
        unless ($self->{outbound}) {
                $self->send(pc18());
-               $self->{lastping} = $main::systime;
-       } else {
-               $self->{lastping} = $main::systime + ($self->pingint / 2);
        }
+       
        $self->state('init');
        $self->{pc50_t} = $main::systime;
 
@@ -406,7 +415,7 @@ sub normal
                        my $user = DXUser->get_current($spot[4]);
                        if ($user) {
                                my $qra = $user->qra;
-                               unless ($qra && DXBearing::is_qra($qra)) {
+                               unless ($qra && is_qra($qra)) {
                                        my $lat = $user->lat;
                                        my $long = $user->long;
                                        if (defined $lat && defined $long) {
@@ -422,7 +431,7 @@ sub normal
                                        my $node;
                                        my $to = $user->homenode;
                                        my $last = $user->lastoper || 0;
-                                       if ($to ne $main::mycall && $send_opernam && $main::systime > $last + $DXUser::lastoperinterval && $to && ($node = Route::Node::get($to)) ) {
+                                       if ($send_opernam && $to && $to ne $main::mycall && $main::systime > $last + $DXUser::lastoperinterval && ($node = Route::Node::get($to)) ) {
                                                my $cmd = "forward/opernam $spot[4]";
                                                # send the rcmd but we aren't interested in the replies...
                                                my $dxchan = $node->dxchan;
@@ -556,10 +565,20 @@ sub normal
                                my ($call, $conf, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o;
                                next unless $call && $conf && defined $here && is_callsign($call);
                                next if $call eq $main::mycall;
+
+                               eph_del_regex("^PC17\^$call\^$ncall");
                                
                                $conf = $conf eq '*';
 
-                               my $r = Route::User::get($call);
+                               # reject this if we think it is a node already
+                               my $r = Route::Node::get($call);
+                               my $u = DXUser->get_current($call) unless $r;
+                               if ($r || ($u && $u->is_node)) {
+                                       dbg("PCPROT: $call is a node") if isdbg('chanerr');
+                                       next;
+                               }
+                               
+                               $r = Route::User::get($call);
                                my $flags = Route::here($here)|Route::conf($conf);
                                
                                if ($r) {
@@ -567,7 +586,7 @@ sub normal
                                                $r->flags($flags);
                                                push @rout, $r;
                                        }
-                                       $r->addparent($ncall);
+                                       $r->addparent($parent);
                                } else {
                                        push @rout, $parent->add_user($call, $flags);
                                }
@@ -582,6 +601,10 @@ sub normal
                                $user->put;
                        }
 
+                       if (eph_dup($line)) {
+                               dbg("PCPROT: dup PC16 detected") if isdbg('chanerr');
+                               return;
+                       }
                        
                        # queue up any messages (look for privates only)
                        DXMsg::queue_msg(1) if $self->state eq 'normal';     
@@ -594,6 +617,9 @@ sub normal
                        my $dxchan;
                        my $ncall = $field[2];
                        my $ucall = $field[1];
+
+                       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;
@@ -603,16 +629,28 @@ sub normal
                                dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
                                return;
                        }
+
+                       my $uref = Route::User::get($ucall);
+                       unless ($uref) {
+                               dbg("PCPROT: Route::User $ucall not in config") if isdbg('chanerr');
+                               return;
+                       }
                        my $parent = Route::Node::get($ncall);
                        unless ($parent) {
                                dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chanerr');
                                return;
-                       }
+                       }                       
 
                        # input filter if required
                        return unless $self->in_filter_route($parent);
+                       
+                       my @rout = $parent->del_user($uref);
+
+                       if (eph_dup($line)) {
+                               dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
+                               return;
+                       }
 
-                       my @rout = $parent->del_user($ucall);
                        $self->route_pc17($parent, @rout) if @rout;
                        return;
                }
@@ -623,7 +661,7 @@ sub normal
                        # first clear out any nodes on this dxchannel
                        my $parent = Route::Node::get($self->{call});
                        my @rout = $parent->del_nodes;
-                       $self->route_pc21(@rout, $parent);
+                       $self->route_pc21(@rout, $parent) if @rout;
                        $self->send_local_config();
                        $self->send(pc20());
                        return;             # we don't pass these on
@@ -649,6 +687,9 @@ sub normal
                                my $conf = $field[$i+2];
                                my $ver = $field[$i+3];
                                next unless defined $here && defined $conf && is_callsign($call);
+
+                               eph_del_regex("^PC(?:21\^$call|17\^[^\^]+\^$call)");
+                               
                                # check for sane parameters
                                $ver = 5000 if $ver eq '0000';
                                next if $ver < 5000; # only works with version 5 software
@@ -698,7 +739,7 @@ sub normal
                                        $user = DXUser->new($call);
                                        $user->sort('A');
                                        $user->priv(1);                   # I have relented and defaulted nodes
-                                       $self->{priv} = 1;                # to user RCMDs allowed
+                                       $user->lockout(1);
                                        $user->homenode($call);
                                        $user->node($call);
                                }
@@ -706,6 +747,11 @@ sub normal
                                $user->put;
                        }
 
+                       if (eph_dup($line)) {
+                               dbg("PCPROT: dup PC19 detected") if isdbg('chanerr');
+                               return;
+                       }
+
                        $self->route_pc19(@rout) if @rout;
                        return;
                }
@@ -714,11 +760,15 @@ sub normal
                        $self->send_local_config();
                        $self->send(pc22());
                        $self->state('normal');
+                       $self->{lastping} = 0;
                        return;
                }
                
                if ($pcno == 21) {              # delete a cluster from the list
                        my $call = uc $field[1];
+
+                       eph_del_regex("^PC1[79].*$call");
+                       
                        my @rout;
                        my $parent = Route::Node::get($self->{call});
                        unless ($parent) {
@@ -744,12 +794,19 @@ sub normal
                                dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr');
                                return;
                        }
+
+                       if (eph_dup($line)) {
+                               dbg("PCPROT: dup PC21 detected") if isdbg('chanerr');
+                               return;
+                       }
+
                        $self->route_pc21(@rout) if @rout;
                        return;
                }
                
                if ($pcno == 22) {
                        $self->state('normal');
+                       $self->{lastping} = 0;
                        return;
                }
                                
@@ -824,7 +881,7 @@ sub normal
                                return;
                        }
 
-                       Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[1]");
+                       Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[2]");
                        
                        # spots
                        if ($field[3] > 0) {
@@ -874,6 +931,7 @@ 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');
                        }
@@ -884,8 +942,13 @@ sub normal
                        my $call = $field[1];
 
                        # input filter if required
-                       my $ref = Route::get($call) || Route->new($call);
-                       return unless $self->in_filter_route($ref);
+#                      my $ref = Route::get($call) || Route->new($call);
+#                      return unless $self->in_filter_route($ref);
+
+                       if ($field[3] eq $field[2]) {
+                               dbg('PCPROT: invalid value') if isdbg('chanerr');
+                               return;
+                       }
 
                        # add this station to the user database, if required
                        my $user = DXUser->get_current($call);
@@ -896,12 +959,27 @@ sub normal
                        } elsif ($field[2] == 2) {
                                $user->qth($field[3]);
                        } elsif ($field[2] == 3) {
-                               my ($lat, $long) = DXBearing::stoll($field[3]);
-                               $user->lat($lat);
-                               $user->long($long);
-                               $user->qra(DXBearing::lltoqra($lat, $long)) unless $user->qra && DXBearing::is_qra($user->qra);
+                               if (is_latlong($field[3])) {
+                                       my ($lat, $long) = DXBearing::stoll($field[3]);
+                                       $user->lat($lat);
+                                       $user->long($long);
+                                       $user->qra(DXBearing::lltoqra($lat, $long));
+                               } else {
+                                       dbg('PCPROT: not a valid lat/long') if isdbg('chanerr');
+                                       return;
+                               }
                        } elsif ($field[2] == 4) {
                                $user->homenode($field[3]);
+                       } elsif ($field[2] == 5) {
+                               if (is_qra($field[3])) {
+                                       my ($lat, $long) = DXBearing::qratoll($field[3]);
+                                       $user->lat($lat);
+                                       $user->long($long);
+                                       $user->qra($field[3]);
+                               } else {
+                                       dbg('PCPROT: not a valid QRA locator') if isdbg('chanerr');
+                                       return;
+                               }
                        }
                        $user->lastoper($main::systime);   # to cut down on excessive for/opers being generated
                        $user->put;
@@ -939,6 +1017,7 @@ sub normal
                        my $to = $field[1];
                        my $from = $field[2];
                        my $flag = $field[3];
+
                        
                        # is it for us?
                        if ($to eq $main::mycall) {
@@ -960,20 +1039,38 @@ sub normal
                                                                $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
                                                        } elsif ($dxchan->is_node) {
                                                                if ($tochan) {
-                                                                       $tochan->{nopings} = $tochan->user->nopings || 2; # pump up the timer
+                                                                       my $nopings = $tochan->user->nopings || 2;
                                                                        push @{$tochan->{pingtime}}, $t;
                                                                        shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
-                                                                       my $st;
-                                                                       for (@{$tochan->{pingtime}}) {
-                                                                               $st += $_;
+
+                                                                       # cope with a missed ping, this means you must set the pingint large enough
+                                                                       my $miss = ($nopings-$tochan->{nopings}) * $tochan->{pingint}; 
+                                                                       if ($tochan->is_arcluster && $t > $miss  && $t < $miss + $tochan->{nopings} ) {
+                                                                               $t -= $miss;
                                                                        }
-                                                                       $tochan->{pingave} = $st / @{$tochan->{pingtime}};
+
+                                                                       # calc smoothed RTT a la TCP
+                                                                       if (@{$tochan->{pingtime}} == 1) {
+                                                                               $tochan->{pingave} = $t;
+                                                                       } else {
+                                                                               $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 8);
+                                                                       }
+#                                                                      my $st;
+#                                                                      for (@{$tochan->{pingtime}}) {
+#                                                                              $st += $_;
+#                                                                      }
+#                                                                      $tochan->{pingave} = $st / @{$tochan->{pingtime}};
+                                                                       $tochan->{nopings} = $nopings; # pump up the timer
                                                                }
                                                        } 
                                                }
                                        }
                                }
                        } else {
+                               if (eph_dup($line)) {
+                                       dbg("PCPROT: dup PC51 detected") if isdbg('chanerr');
+                                       return;
+                               }
                                # route down an appropriate thingy
                                $self->route($to, $line);
                        }
@@ -1055,20 +1152,22 @@ sub process
        my $t = time;
        my @dxchan = DXChannel->get_all();
        my $dxchan;
+       my $pc50s;
        
+       # send out a pc50 on EVERY channel all at once
+       if ($t >= $last_pc50 + $DXProt::pc50_interval) {
+               $pc50s = pc50($me, scalar DXChannel::get_all_users);
+               eph_dup($pc50s);
+               $last_pc50 = $t;
+       }
+
        foreach $dxchan (@dxchan) {
                next unless $dxchan->is_node();
                next if $dxchan == $me;
-               
-               # send a pc50 out on this channel
-               $dxchan->{pc50_t} = $main::systime unless exists $dxchan->{pc50_t};
-               if ($t >= $dxchan->{pc50_t} + $DXProt::pc50_interval) {
-                       my $s = pc50($me, scalar DXChannel::get_all_users);
-                       eph_dup($s);
-                       $dxchan->send($s);
-                       $dxchan->{pc50_t} = $t;
-               } 
 
+               # send the pc50
+               $dxchan->send($pc50s) if $pc50s;
+               
                # send a ping out on this channel
                if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
                        if ($dxchan->{nopings} <= 0) {
@@ -1130,7 +1229,7 @@ sub dx_spot
                ($filter, $hops) = $self->{spotsfilter}->it(@_);
                return unless $filter;
        }
-       send_prot_line($self, $filter, $hops, $isolate, $line)
+       send_prot_line($self, $filter, $hops, $isolate, $line);
 }
 
 sub send_prot_line
@@ -1146,7 +1245,7 @@ sub send_prot_line
                return unless $routeit;
        }
        if ($filter) {
-               $self->send($routeit) if $routeit;
+               $self->send($routeit);
        } else {
                $self->send($routeit) unless $self->{isolate} || $isolate;
        }
@@ -1290,10 +1389,7 @@ sub send_announce
        foreach $dxchan (@dxchan) {
                next if $dxchan == $me;
                next if $dxchan == $self && $self->is_node;
-               my $routeit;
-               my ($filter, $hops);
-
-               $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}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
        }
 }
 
@@ -1304,6 +1400,7 @@ sub announce
        my $isolate = shift;
        my $to = shift;
        my $target = shift;
+       my $text = shift;
        my ($filter, $hops);
 
        if ($self->{annfilter}) {
@@ -1331,7 +1428,7 @@ sub send_local_config
                # 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
-               my @dxchan = grep { $_->call ne $main::mycall && $_->call ne $self->{call} } DXChannel::get_all_nodes();
+               my @dxchan = grep { $_->call ne $main::mycall && $_ != $self && !$_->{isolate} } DXChannel::get_all_nodes();
                @localnodes = map { my $r = Route::Node::get($_->{call}); $r ? $r : () } @dxchan if @dxchan;
                my @intcalls = map { $_->nodes } @localnodes if @localnodes;
                my $ref = Route::Node::get($self->{call});
@@ -1590,7 +1687,7 @@ sub process_rcmd_reply
                my $s = $rcmds{$fromnode};
                if ($s) {
                        my $dxchan = DXChannel->get($s->{call});
-                       my $ref = DXChannel->get($user) || $dxchan;
+                       my $ref = $user eq $tonode ? $dxchan : (DXChannel->get($user) || $dxchan);
                        $ref->send($line) if $ref;
                        delete $rcmds{$fromnode} if !$dxchan;
                } else {
@@ -1652,6 +1749,8 @@ sub disconnect
        my $pc39flag = shift;
        my $call = $self->call;
 
+       return if $self->{disconnecting}++;
+       
        unless ($pc39flag && $pc39flag == 1) {
                $self->send_now("D", DXProt::pc39($main::mycall, $self->msg('disc1', "System Op")));
        }
@@ -1660,7 +1759,6 @@ sub disconnect
        my $node = Route::Node::get($call);
        my @rout;
        if ($node) {
-               @rout = $node->del_nodes;    # at the next level
                @rout = $node->del($main::routeroot);
        }
        
@@ -1714,7 +1812,7 @@ sub send_route
        for (; @_ && $no; $no--) {
                my $r = shift;
                
-               if ($self->{routefilter}) {
+               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);
@@ -1727,7 +1825,7 @@ sub send_route
                                dbg("was sent a null value") if isdbg('chanerr');
                        }
                } else {
-                       push @rin, $r;
+                       push @rin, $r unless $self->{isolate} && $r->call ne $main::mycall;
                }
        }
        if (@rin) {
@@ -1739,7 +1837,7 @@ sub send_route
                                $routeit = adjust_hops($self, $line);  # adjust its hop count by node name
                                next unless $routeit;
                        }
-                       $self->send($routeit) if $self->{routefilter} || !$self->{isolate};
+                       $self->send($routeit);
                }
        }
 }
@@ -1752,13 +1850,11 @@ sub broadcast_route
        my $dxchan;
        my $line;
        
-       foreach $dxchan (@dxchan) {
-               next if $dxchan == $self;
-               next if $dxchan == $me;
-               if ($dxchan->{routefilter} || !$self->{isolate}) {
-                       $dxchan->send_route($generate, @_) 
-               } else {
-                       dbg('DXPROT: isolated') if isdbg('chanerr');
+       unless ($self->{isolate}) {
+               foreach $dxchan (@dxchan) {
+                       next if $dxchan == $self;
+                       next if $dxchan == $me;
+                       $dxchan->send_route($generate, @_);
                }
        }
 }
@@ -1829,6 +1925,17 @@ sub eph_dup
        return undef;
 }
 
+sub eph_del_regex
+{
+       my $regex = shift;
+       my ($key, $val);
+       while (($key, $val) = each %eph) {
+               if ($key =~ m{$regex}) {
+                       delete $eph{$key};
+               }
+       }
+}
+
 sub eph_clean
 {
        my ($key, $val);