X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=dded0e6451073153fea76fd1e77b8834e8cced9b;hb=8b0c842c51c3a51b45ff8c4940d6b5fad00cdde8;hp=0cc714135317ff1119a0dc786a326b2b81c8c23f;hpb=d16a47c69c71370281d87c975bc6089d976eaa7b;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 0cc71413..dded0e64 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -22,12 +22,15 @@ use DXLog; use Spot; use DXProtout; use DXDebug; +use Filter; use Local; use Carp; use strict; -use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $last_hour %pings %rcmds %nodehops); +use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age + %spotdup %wwvdup $last_hour %pings %rcmds + %nodehops @baddx $baddxfn); $me = undef; # the channel id for this cluster $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 @@ -39,7 +42,9 @@ $last_hour = time; # last time I did an hourly periodic update %pings = (); # outstanding ping requests outbound %rcmds = (); # outstanding rcmd requests outbound %nodehops = (); # node specific hop control +@baddx = (); # list of illegal spotted callsigns +$baddxfn = "$main::data/baddx.pl"; sub init { @@ -69,6 +74,9 @@ sub init $wwvdup{$dupkey} = $_->[1]; } + # load the baddx file + do "$baddxfn" if -e "$baddxfn"; + print "$@\n" if $@; } # @@ -99,6 +107,11 @@ sub start $self->{isolate} = $user->{isolate}; $self->{consort} = $line; # save the connection type $self->{here} = 1; + + # get the filters + $self->{spotfilter} = Filter::read_in('spots', $call); + $self->{wwvfilter} = Filter::read_in('wwv', $call); + $self->{annfilter} = Filter::read_in('ann', $call); # set unbuffered $self->send_now('B',"0"); @@ -138,7 +151,7 @@ sub normal eval { $pcr = Local::pcprot($self, $pcno, @field); }; - dbg('local', "Local::pcprot error $@") if $@; +# dbg('local', "Local::pcprot error $@") if $@; return if $pcr; SWITCH: { @@ -189,27 +202,36 @@ sub normal } $spotdup{$dupkey} = $d; + + # is it 'baddx' + if (grep $field[2] eq $_, @baddx) { + dbg('chan', "Bad DX spot, ignored"); + return; + } - my $spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]); + my @spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]); + + # + # @spot at this point contains:- + # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node + # then spotted itu, spotted cq, spotters itu, spotters cq + # you should be able to route on any of these + # # local processing my $r; eval { - $r = Local::spot1($self, $freq, $field[2], $d, $text, $spotter, $field[7]); + $r = Local::spot($self, @spot); }; - dbg('local', "Local::spot1 error $@") if $@; +# dbg('local', "Local::spot1 error $@") if $@; return if $r; - # send orf to the users - if ($spot && $pcno == 11) { - my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter); - broadcast_users("$buf\a\a", 'dx', $spot); - } - # DON'T be silly and send on PC26s! return if $pcno == 26; - - last SWITCH; + + # send out the filtered spots + send_dx_spot($self, $line, @spot) if @spot; + return; } if ($pcno == 12) { # announces @@ -271,7 +293,7 @@ sub normal for ($i = 2; $i < $#field; $i++) { my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; - next if length $call < 3 || length $call > 8; + next if !$call || length $call < 3 || length $call > 8; next if !$confmode; $call = uc $call; next if DXCluster->get_exact($call); # we already have this (loop?) @@ -354,6 +376,7 @@ sub normal # queue mail DXMsg::queue_msg(0); + return; } @@ -396,16 +419,16 @@ sub normal my $r; eval { - $r = Local::wwv2($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]); + $r = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]); }; - dbg('local', "Local::wwv2 error $@") if $@; +# dbg('local', "Local::wwv2 error $@") if $@; return if $r; # DON'T be silly and send on PC27s! return if $pcno == 27; # broadcast to the eager users - broadcast_users("WWV de $field[7] <$field[2]>: SFI=$sfi, K=$k, A=$i, $field[6]", 'wwv', $wwv ); + broadcast_users("WWV de $field[7] <$field[2]>: SFI=$sfi, A=$k, K=$i, $field[6]", 'wwv', $wwv ); last SWITCH; } @@ -545,7 +568,7 @@ sub normal if ($pcno == 50) { # keep alive/user list my $ref = DXCluster->get_exact($field[1]); - $ref->update_users($field[2]) if $ref; + $ref->update_users($field[2]) if $ref; last SWITCH; } @@ -660,30 +683,73 @@ sub finish # # some active measures # +sub send_dx_spot +{ + my $self = shift; + my $line = shift; + my @dxchan = DXChannel->get_all(); + my $dxchan; + + # 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) { + my $routeit; + my ($filter, $hops) = Filter::it($dxchan->{spotfilter}, @_, $self->{call} ) if $dxchan->{spotfilter}; + if ($dxchan->is_ak1a) { + next if $dxchan == $self; + if ($hops) { + $routeit = $line; + $routeit =~ s/\^H\d+\^\~$/\^H$hops\^\~/; + } else { + $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name + next unless $routeit; + } + if ($filter) { + $dxchan->send($routeit) if $routeit; + } else { + $dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate}; + + } + } elsif ($dxchan->is_user) { + my $buf = Spot::formatb($_[0], $_[1], $_[2], $_[3], $_[4]); + $buf .= "\a\a" if $dxchan->beep; + $dxchan->send($buf) if !$hops || ($hops && $filter); + } + } +} sub send_local_config { my $self = shift; my $n; my @nodes; - + my @localnodes; + my @remotenodes; + # send our nodes if ($self->{isolate}) { - @nodes = (DXCluster->get_exact($main::mycall)); + @localnodes = (DXCluster->get_exact($main::mycall)); } else { # 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 @nodes = DXNode::get_all(); - @nodes = grep { $_->dxchan != $self } @nodes; + @nodes = grep { $_->{call} ne $main::mycall } @nodes; + @nodes = grep { $_->dxchan != $self } @nodes if @nodes; + @nodes = grep { !$_->dxchan->{isolate} } @nodes if @nodes; + @localnodes = grep { $_->dxchan->{call} eq $_->{call} } @nodes if @nodes; + unshift @localnodes, DXCluster->get_exact($main::mycall); + @remotenodes = grep { $_->dxchan->{call} ne $_->{call} } @nodes if @nodes; } - my @s = $me->pc19(@nodes); + my @s = $me->pc19(@localnodes, @remotenodes); for (@s) { my $routeit = adjust_hops($self, $_); $self->send($routeit) if $routeit; } # get all the users connected on the above nodes and send them out - foreach $n (@nodes) { + foreach $n (@localnodes, @remotenodes) { my @users = values %{$n->list}; my @s = pc16($n, @users); for (@s) { @@ -714,7 +780,8 @@ sub route } } -# broadcast a message to all clusters [except those mentioned after buffer] +# 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 @@ -730,6 +797,23 @@ sub broadcast_ak1a } } +# 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 = get_all_ak1a(); + 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; + 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 @@ -758,13 +842,19 @@ sub broadcast_list my $dxchan; foreach $dxchan (@_) { + my $filter = 1; - next if $sort eq 'dx' && !$dxchan->{dx}; + if ($sort eq 'dx') { + next unless $dxchan->{dx}; + ($filter) = Filter::it($dxchan->{spotfilter}, @{$fref}) if ref $fref; + next unless $filter; + } next if $sort eq 'ann' && !$dxchan->{ann}; next if $sort eq 'wwv' && !$dxchan->{wwv}; next if $sort eq 'wx' && !$dxchan->{wx}; $s =~ s/\a//og unless $dxchan->{beep}; + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { $dxchan->send($s); } else {