X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=d3b39cb32097963b2ba0da0023b54fef9df8505b;hb=ffaa3ab68ea631b0a7b3c3767883141a74daa8fe;hp=2e43068a6951c7f42517c98a5170b57bd76fba68;hpb=bda1cef129c5b201f7640433ce1844af45a68fcb;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 2e43068a..d3b39cb3 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -32,14 +32,21 @@ use BadWords; use DXHash; use Route; use Route::Node; +use Script; use strict; -use vars qw($me $pc11_max_age $pc23_max_age - $last_hour $last10 %eph %pings %rcmds - %nodehops $baddx $badspotter $badnode $censorpc + +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($pc11_max_age $pc23_max_age $last_pc50 + $last_hour $last10 %eph %pings %rcmds $ann_to_talk + %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); -$me = undef; # the channel id for this cluster $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 $pc23_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc23 @@ -52,7 +59,9 @@ $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; +$ann_to_talk = 1; +$rspfcheck = 1; @checklist = ( @@ -175,14 +184,17 @@ sub init { my $user = DXUser->get($main::mycall); $DXProt::myprot_version += $main::version*100; - $me = DXProt->new($main::mycall, 0, $user); - $me->{here} = 1; - $me->{state} = "indifferent"; + $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 $@; - $me->{sort} = 'S'; # S for spider - $me->{priv} = 9; -# $Route::Node::me->adddxchan($me); + $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); } # @@ -209,22 +221,29 @@ 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; $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 +251,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,22 +263,24 @@ sub start $self->{pingint} = $ping; $self->{nopings} = $user->nopings || 2; $self->{pingtime} = [ ]; - $self->{pingave} = 0; + $self->{pingave} = 999; + $self->{metric} ||= 100; + $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"); + # run a script send the output to the debug file + my $script = new Script(lc $call) || new Script('node_default'); + $script->run($self) if $script; } # @@ -299,6 +320,9 @@ sub normal SWITCH: { if ($pcno == 10) { # incoming talk + # rsfp check + return if $rspfcheck and !$self->rspfcheck(0, $field[6], $field[1]); + # will we allow it at all? if ($censorpc) { my @bad; @@ -309,20 +333,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; } @@ -337,6 +391,9 @@ sub normal } } + # rsfp check + return if $rspfcheck and !$self->rspfcheck(1, $field[7], $field[6]); + # if this is a 'nodx' node then ignore it if ($badnode->in($field[7])) { dbg("PCPROT: Bad Node, dropped") if isdbg('chanerr'); @@ -422,7 +479,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; @@ -466,6 +523,9 @@ sub normal } if ($pcno == 12) { # announces + + return if $rspfcheck and !$self->rspfcheck(1, $field[5], $field[1]); + # announce duplicate checking $field[3] =~ s/^\s+//; # remove leading blanks if (AnnTalk::dup($field[1], $field[2], $field[3])) { @@ -480,38 +540,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; } @@ -527,6 +578,11 @@ sub normal if ($pcno == 16) { # add a user + if (eph_dup($line)) { + dbg("PCPROT: dup PC16 detected") if isdbg('chanerr'); + return; + } + # general checks my $dxchan; my $ncall = $field[1]; @@ -536,17 +592,17 @@ sub normal dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chanerr'); return; } - $dxchan = DXChannel->get($ncall); - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); - return; - } my $parent = Route::Node::get($ncall); unless ($parent) { dbg("PCPROT: Node $ncall not in config") if isdbg('chanerr'); return; } - + $dxchan = $parent->dxchan; + if ($dxchan && $dxchan ne $self) { + dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + return; + } + # input filter if required return unless $self->in_filter_route($parent); @@ -556,10 +612,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 +633,7 @@ sub normal $r->flags($flags); push @rout, $r; } - $r->addparent($ncall); + $r->addparent($parent); } else { push @rout, $parent->add_user($call, $flags); } @@ -581,7 +647,6 @@ sub normal $user->lastin($main::systime) unless DXChannel->get($call); $user->put; } - # queue up any messages (look for privates only) DXMsg::queue_msg(1) if $self->state eq 'normal'; @@ -594,25 +659,41 @@ sub normal my $dxchan; my $ncall = $field[2]; my $ucall = $field[1]; + + if (eph_dup($line)) { + dbg("PCPROT: dup PC17 detected") 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; } - $dxchan = DXChannel->get($ncall); - if ($dxchan && $dxchan ne $self) { - dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + + 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; + } + + $dxchan = $parent->dxchan; + if ($dxchan && $dxchan ne $self) { + dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chanerr'); + return; } # input filter if required return unless $self->in_filter_route($parent); + + my @rout = $parent->del_user($uref); - my @rout = $parent->del_user($ucall); $self->route_pc17($parent, @rout) if @rout; return; } @@ -623,7 +704,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 @@ -633,6 +714,11 @@ sub normal my $i; my $newline = "PC19^"; + if (eph_dup($line)) { + dbg("PCPROT: dup PC19 detected") if isdbg('chanerr'); + return; + } + # new routing list my @rout; my $parent = Route::Node::get($self->{call}); @@ -649,6 +735,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 +787,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 +795,7 @@ sub normal $user->put; } + $self->route_pc19(@rout) if @rout; return; } @@ -714,11 +804,20 @@ 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]; + + if (eph_dup($line)) { + dbg("PCPROT: dup PC21 detected") if isdbg('chanerr'); + return; + } + + eph_del_regex("^PC1[79].*$call"); + my @rout; my $parent = Route::Node::get($self->{call}); unless ($parent) { @@ -726,14 +825,21 @@ sub normal $self->disconnect; return; } - my $node = Route::Node::get($call); if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me! if ($call eq $self->{call}) { dbg("PCPROT: Trying to disconnect myself with PC21") if isdbg('chanerr'); return; } + my $node = Route::Node::get($call); if ($node) { + + my $dxchan = $node->dxchan; + if ($dxchan && $dxchan ne $self) { + dbg("PCPROT: PC21 from $self->{call} trying to alter locally connected $call, ignored!") if isdbg('chanerr'); + return; + } + # input filter it return unless $self->in_filter_route($node); @@ -744,12 +850,14 @@ sub normal dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chanerr'); return; } + $self->route_pc21(@rout) if @rout; return; } if ($pcno == 22) { $self->state('normal'); + $self->{lastping} = 0; return; } @@ -763,6 +871,8 @@ sub normal } } + return if $rspfcheck and !$self->rspfcheck(1, $field[8], $field[7]); + # do some de-duping my $d = cltounix($field[1], sprintf("%02d18Z", $field[2])); my $sfi = unpad($field[3]); @@ -824,7 +934,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) { @@ -847,6 +957,7 @@ sub normal } if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling + return if $pcno == 49 && eph_dup($line); if ($pcno == 49 || $field[1] eq $main::mycall) { DXMsg::process($self, $line); } else { @@ -874,6 +985,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'); } @@ -887,6 +999,11 @@ sub normal # my $ref = Route::get($call) || Route->new($call); # return unless $self->in_filter_route($ref); + if ($field[3] eq $field[2] || $field[3] =~ /^\s*$/) { + dbg('PCPROT: invalid value') if isdbg('chanerr'); + return; + } + # add this station to the user database, if required my $user = DXUser->get_current($call); $user = DXUser->new($call) if !$user; @@ -954,6 +1071,7 @@ sub normal my $to = $field[1]; my $from = $field[2]; my $flag = $field[3]; + # is it for us? if ($to eq $main::mycall) { @@ -975,20 +1093,37 @@ 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}; } - $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}) / 6); + } +# 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); } @@ -1056,7 +1191,7 @@ sub normal dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chanerr'); } else { unless ($self->{isolate}) { - broadcast_ak1a($line, $self); # send it to everyone but me + DXChannel::broadcast_nodes($line, $self); # send it to everyone but me } } } @@ -1070,20 +1205,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($main::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; - } + next if $dxchan == $main::me; + # 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) { @@ -1128,7 +1265,7 @@ sub send_dx_spot # 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) { - next if $dxchan == $me; + next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; $dxchan->dx_spot($line, $self->{isolate}, @_, $self->{call}); } @@ -1175,13 +1312,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; @@ -1191,7 +1328,7 @@ sub send_wwv_spot # 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) { - next if $dxchan == $me; + next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; my $routeit; my ($filter, $hops); @@ -1222,13 +1359,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; @@ -1238,7 +1375,7 @@ sub send_wcy_spot # 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) { - next if $dxchan == $me; + 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); @@ -1282,8 +1419,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); @@ -1300,15 +1436,25 @@ 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) { - next if $dxchan == $me; + next if $dxchan == $main::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); } } @@ -1319,6 +1465,7 @@ sub announce my $isolate = shift; my $to = shift; my $target = shift; + my $text = shift; my ($filter, $hops); if ($self->{annfilter}) { @@ -1346,7 +1493,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}); @@ -1398,103 +1545,13 @@ sub route if ($dxchan) { my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name if ($routeit) { - $dxchan->send($routeit) unless $dxchan == $me; + $dxchan->send($routeit) unless $dxchan == $main::me; } } else { dbg("PCPROT: No route available, dropped") if isdbg('chanerr'); } } -# broadcast a message to all clusters taking into account isolation -# [except those mentioned after buffer] -sub broadcast_ak1a -{ - my $s = shift; # the line to be rebroadcast - my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @dxchan = DXChannel::get_all_nodes(); - my $dxchan; - - # send it if it isn't the except list and isn't isolated and still has a hop count - foreach $dxchan (@dxchan) { - next if grep $dxchan == $_, @except; - next if $dxchan == $me; - - my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name - $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit; - } -} - -# broadcast a message to all clusters ignoring isolation -# [except those mentioned after buffer] -sub broadcast_all_ak1a -{ - my $s = shift; # the line to be rebroadcast - my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @dxchan = DXChannel::get_all_nodes(); - my $dxchan; - - # send it if it isn't the except list and isn't isolated and still has a hop count - foreach $dxchan (@dxchan) { - next if grep $dxchan == $_, @except; - next if $dxchan == $me; - - my $routeit = adjust_hops($dxchan, $s); # adjust its hop count by node name - $dxchan->send($routeit); - } -} - -# broadcast to all users -# storing the spot or whatever until it is in a state to receive it -sub broadcast_users -{ - my $s = shift; # the line to be rebroadcast - my $sort = shift; # the type of transmission - my $fref = shift; # a reference to an object to filter on - my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @dxchan = DXChannel::get_all_users(); - my $dxchan; - my @out; - - foreach $dxchan (@dxchan) { - next if grep $dxchan == $_, @except; - push @out, $dxchan; - } - broadcast_list($s, $sort, $fref, @out); -} - -# broadcast to a list of users -sub broadcast_list -{ - my $s = shift; - my $sort = shift; - my $fref = shift; - my $dxchan; - - foreach $dxchan (@_) { - my $filter = 1; - next if $dxchan == $me; - - if ($sort eq 'dx') { - next unless $dxchan->{dx}; - ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; - next unless $filter; - } - next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i; - next if $sort eq 'wwv' && !$dxchan->{wwv}; - next if $sort eq 'wcy' && !$dxchan->{wcy}; - next if $sort eq 'wx' && !$dxchan->{wx}; - - $s =~ s/\a//og unless $dxchan->{beep}; - - if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'talk') { - $dxchan->send($s); - } else { - $dxchan->delay($s); - } - } -} - - # # obtain the hops from the list for this callsign and pc no # @@ -1667,6 +1724,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"))); } @@ -1675,7 +1734,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); } @@ -1708,11 +1766,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 @@ -1729,7 +1787,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); @@ -1742,7 +1800,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) { @@ -1767,13 +1825,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 == $main::me; $dxchan->send_route($generate, @_); - } else { - $dxchan->send_route($generate, @_) unless $self->{isolate} || $dxchan->{isolate}; } } } @@ -1836,12 +1892,24 @@ 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 +{ + my $regex = shift; + my ($key, $val); + while (($key, $val) = each %eph) { + if ($key =~ m{$regex}) { + delete $eph{$key}; + } + } } sub eph_clean @@ -1849,7 +1917,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}; } }