X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=181c75b0f36cebbd1298ba9195f9a914589a30d2;hb=d755df6b0d8636240520f66680972e9e70f98860;hp=c26016ee5048ce9205175a484ae042c3be8b1b31;hpb=aa8cc0d19a7ad2cc5d8891187ceae2fba73eee2d;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index c26016ee..181c75b0 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -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; @@ -267,8 +272,6 @@ sub start # send info to all logged in thingies $self->tell_login('loginn'); - - Log('DXProt', "$call connected"); } # @@ -318,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; } @@ -489,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 ' 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; } @@ -945,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; } @@ -1039,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 } } } @@ -1245,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; @@ -1292,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; @@ -1352,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); @@ -1370,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) { @@ -1777,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 @@ -1903,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 @@ -1927,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}; } }