fix syntax error
[spider.git] / perl / DXProt.pm
index 736cab4d41d1a58496cb0b7bfcb305dec26f557d..c1583c21377d1e19715311d335cacccc76bb59b4 100644 (file)
@@ -42,7 +42,7 @@ $main::build += $VERSION;
 $main::branch += $BRANCH;
 
 use vars qw($me $pc11_max_age $pc23_max_age $last_pc50
-                       $last_hour $last10 %eph  %pings %rcmds
+                       $last_hour $last10 %eph  %pings %rcmds $ann_to_talk
                        %nodehops $baddx $badspotter $badnode $censorpc
                        $allowzero $decode_dk0wcy $send_opernam @checklist);
 
@@ -60,6 +60,7 @@ $baddx = new DXHash "baddx";
 $badspotter = new DXHash "badspotter";
 $badnode = new DXHash "badnode";
 $last10 = $last_pc50 = time;
+$ann_to_talk = 1;
 
 @checklist = 
 (
@@ -216,6 +217,10 @@ sub start
        my ($self, $line, $sort) = @_;
        my $call = $self->{call};
        my $user = $self->{user};
+
+       # log it
+       my $host = $self->{conn}->{peerhost} || "unknown";
+       Log('DXProt', "$call connected from $host");
        
        # remember type of connection
        $self->{consort} = $line;
@@ -254,22 +259,19 @@ 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;
 
        # send info to all logged in thingies
        $self->tell_login('loginn');
-
-       Log('DXProt', "$call connected");
 }
 
 #
@@ -319,20 +321,50 @@ sub normal
                        }
 
                        # is it for me or one of mine?
-                       my ($to, $via, $call, $dxchan);
+                       my ($from, $to, $via, $call, $dxchan);
+                       $from = $field[1];
                        if ($field[5] gt ' ') {
-                               $call = $via = $field[2];
+                               $via = $field[2];
                                $to = $field[5];
                        } else {
-                               $call = $to = $field[2];
+                               $to = $field[2];
+                       }
+
+                       # 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])) {
+                                       dbg("DXPROT: Dupe talk from announce, dropped") if isdbg('chanerr');
+                                       return;
+                               }
                        }
-                       $dxchan = DXChannel->get($main::myalias) if $call eq $main::mycall;
-                       $dxchan = DXChannel->get($call) unless $dxchan;
+
+                       # it is here and logged on
+                       $dxchan = DXChannel->get($main::myalias) if $to eq $main::mycall;
+                       $dxchan = DXChannel->get($to) unless $dxchan;
                        if ($dxchan && $dxchan->is_user) {
                                $field[3] =~ s/\%5E/^/g;
-                               $dxchan->talk($field[1], $to, $via, $field[3]);
-                       } else {
-                               $self->route($field[2], $line); # relay it on its way
+                               $dxchan->talk($from, $to, $via, $field[3]);
+                               return;
+                       }
+
+                       # is it elsewhere, visible on the cluster via the to address?
+                       # note: this discards the via unless the to address is on
+                       # the via address
+                       my ($ref, $vref);
+                       if ($ref = Route::get($to)) {
+                               $vref = Route::Node::get($via) if $via;
+                               $vref = undef unless $vref && grep $to eq $_, $vref->users;
+                               $ref->dxchan->talk($from, $to, $vref ? $via : undef, $field[3], $field[6]);
+                               return;
+                       }
+
+                       # not visible here, send a message of condolence
+                       $vref = undef;
+                       $ref = Route::get($from);
+                       $vref = $ref = Route::Node::get($field[6]) unless $ref; 
+                       if ($ref) {
+                               $dxchan = $ref->dxchan;
+                               $dxchan->talk($main::mycall, $from, $vref ? $vref->call : undef, $dxchan->msg('talknh', $to) );
                        }
                        return;
                }
@@ -490,38 +522,29 @@ sub normal
                                        return;
                                }
                        }
-                       
+
                        if ($field[2] eq '*' || $field[2] eq $main::mycall) {
-                               
-                               # global ann filtering on INPUT
-                               if ($self->{inannfilter}) {
-                                       my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
-                                       my @dxcc = Prefix::extract($field[1]);
-                                       if (@dxcc > 0) {
-                                               $ann_dxcc = $dxcc[1]->dxcc;
-                                               $ann_itu = $dxcc[1]->itu;
-                                               $ann_cq = $dxcc[1]->cq();                                               
-                                       }
-                                       @dxcc = Prefix::extract($field[5]);
-                                       if (@dxcc > 0) {
-                                               $org_dxcc = $dxcc[1]->dxcc;
-                                               $org_itu = $dxcc[1]->itu;
-                                               $org_cq = $dxcc[1]->cq();                                               
-                                       }
-                                       my ($filter, $hops) = $self->{inannfilter}->it(@field[1..6], $self->{call}, 
-                                                                                                       $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
-                                       unless ($filter) {
-                                               dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
-                                               return;
+
+
+                               # here's a bit of fun, convert incoming ann with a callsign in the first word
+                               # or one saying 'to <call>' to a talk if we can route to the recipient
+                               if ($ann_to_talk) {
+                                       my $call = AnnTalk::is_talk_candidate($field[1], $field[3]);
+                                       if ($call) {
+                                               my $ref = Route::get($call);
+                                               if ($ref) {
+                                                       my $dxchan = $ref->dxchan;
+                                                       $dxchan->talk($field[1], $call, undef, $field[3], $field[5]) if $dxchan != $self;
+                                                       return;
+                                               }
                                        }
                                }
-
+       
                                # send it
                                $self->send_announce($line, @field[1..6]);
                        } else {
                                $self->route($field[2], $line);
                        }
-                       
                        return;
                }
                
@@ -571,7 +594,15 @@ sub normal
                                
                                $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) {
@@ -622,17 +653,17 @@ sub normal
                                dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr');
                                return;
                        }
-                       my $parent = Route::Node::get($ncall);
-                       unless ($parent) {
-                               dbg("PCPROT: Route::Node $ncall not in config") 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);
@@ -753,6 +784,7 @@ sub normal
                        $self->send_local_config();
                        $self->send(pc22());
                        $self->state('normal');
+                       $self->{lastping} = 0;
                        return;
                }
                
@@ -798,6 +830,7 @@ sub normal
                
                if ($pcno == 22) {
                        $self->state('normal');
+                       $self->{lastping} = 0;
                        return;
                }
                                
@@ -936,7 +969,7 @@ sub normal
 #                      my $ref = Route::get($call) || Route->new($call);
 #                      return unless $self->in_filter_route($ref);
 
-                       if ($field[3] eq $field[2]) {
+                       if ($field[3] eq $field[2] || $field[3] =~ /^\s*$/) {
                                dbg('PCPROT: invalid value') if isdbg('chanerr');
                                return;
                        }
@@ -1030,14 +1063,27 @@ 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
+                                                                       if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
+                                                                               $t -= $tochan->{pingint};
+                                                                       }
+
+                                                                       # calc smoothed RTT a la TCP
+                                                                       if (@{$tochan->{pingtime}} == 1) {
+                                                                               $tochan->{pingave} = $t;
+                                                                       } else {
+                                                                               $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
                                                                        }
-                                                                       $tochan->{pingave} = $st / @{$tochan->{pingtime}};
+#                                                                      my $st;
+#                                                                      for (@{$tochan->{pingtime}}) {
+#                                                                              $st += $_;
+#                                                                      }
+#                                                                      $tochan->{pingave} = $st / @{$tochan->{pingtime}};
+                                                                       $tochan->{nopings} = $nopings; # pump up the timer
                                                                }
                                                        } 
                                                }
@@ -1236,13 +1282,13 @@ sub send_wwv_spot
        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($_[7]);
+       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($_[8]);
+       @dxcc = Prefix::extract($_[7]);
        if (@dxcc > 0) {
                $org_dxcc = $dxcc[1]->dxcc;
                $org_itu = $dxcc[1]->itu;
@@ -1283,13 +1329,13 @@ sub send_wcy_spot
        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($_[11]);
+       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($_[12]);
+       @dxcc = Prefix::extract($_[11]);
        if (@dxcc > 0) {
                $org_dxcc = $dxcc[1]->dxcc;
                $org_itu = $dxcc[1]->itu;
@@ -1343,8 +1389,7 @@ sub send_announce
                $to = '';
        }
        $target = "ALL" if !$target;
-       
-       Log('ann', $target, $_[0], $text);
+
 
        # obtain country codes etc 
        my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
@@ -1361,6 +1406,19 @@ sub send_announce
                $org_cq = $dxcc[1]->cq;                                         
        }
 
+       if ($self->{inannfilter}) {
+               my ($filter, $hops) = 
+                       $self->{inannfilter}->it(@_, $self->{call}, 
+                                                                        $ann_dxcc, $ann_itu, $ann_cq,
+                                                                        $org_dxcc, $org_itu, $org_cq);
+               unless ($filter) {
+                       dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
+                       return;
+               }
+       }
+
+       Log('ann', $target, $_[0], $text);
+
        # 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) {
@@ -1768,11 +1826,11 @@ sub disconnect
 #
 sub talk
 {
-       my ($self, $from, $to, $via, $line) = @_;
+       my ($self, $from, $to, $via, $line, $origin) = @_;
        
        $line =~ s/\^/\\5E/g;                   # remove any ^ characters
-       $self->send(DXProt::pc10($from, $to, $via, $line));
-       Log('talk', $self->call, $from, $via?$via:$main::mycall, $line);
+       $self->send(DXProt::pc10($from, $to, $via, $line, $origin));
+       Log('talk', $self->call, $from, $via?$via:$main::mycall, $line) unless $origin && $origin ne $main::mycall;
 }
 
 # send it if it isn't the except list and isn't isolated and still has a hop count
@@ -1789,7 +1847,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);
@@ -1802,7 +1860,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) {
@@ -1827,13 +1885,11 @@ sub broadcast_route
        my $dxchan;
        my $line;
        
-       foreach $dxchan (@dxchan) {
-               next if $dxchan == $self;
-               next if $dxchan == $me;
-               if ($dxchan->{routefilter}) {
+       unless ($self->{isolate}) {
+               foreach $dxchan (@dxchan) {
+                       next if $dxchan == $self;
+                       next if $dxchan == $me;
                        $dxchan->send_route($generate, @_);
-               } else {
-                       $dxchan->send_route($generate, @_) unless $self->{isolate} || $dxchan->{isolate};
                }
        }
 }
@@ -1896,12 +1952,13 @@ sub in_filter_route
 sub eph_dup
 {
        my $s = shift;
+       my $r;
 
        # chop the end off
        $s =~ s/\^H\d\d?\^?\~?$//;
-       return 1 if exists $eph{$s};
+       $r = 1 if exists $eph{$s};    # pump up the dup if it keeps circulating
        $eph{$s} = $main::systime;
-       return undef;
+       return $r;
 }
 
 sub eph_del_regex
@@ -1920,7 +1977,7 @@ sub eph_clean
        my ($key, $val);
        
        while (($key, $val) = each %eph) {
-               if ($main::systime - $val > 90) {
+               if ($main::systime - $val > 180) {
                        delete $eph{$key};
                }
        }