X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=a16789c7e31a5ee94e8353be9996265e790e92c5;hb=8942c27356acc5d5f5a20134461bcf7e6bd6a044;hp=8bd96984b3278837974d71d6600c91859cf0cd2f;hpb=f3adc82a0299652d929b73c718127fa38571eec5;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 8bd96984..a16789c7 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -22,10 +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 @@ -37,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 { @@ -67,6 +74,9 @@ sub init $wwvdup{$dupkey} = $_->[1]; } + # load the baddx file + do "$baddxfn" if -e "$baddxfn"; + print "$@\n" if $@; } # @@ -97,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"); @@ -118,8 +133,11 @@ sub start sub normal { my ($self, $line) = @_; - my @field = split /[\^\~]/, $line; + my @field = split /\^/, $line; + pop @field if $field[-1] eq '~'; +# print join(',', @field), "\n"; + # ignore any lines that don't start with PC return if !$field[0] =~ /^PC/; @@ -128,6 +146,14 @@ sub normal return unless $pcno; return if $pcno < 10 || $pcno > 51; + # local processing 1 + my $pcr; + eval { + $pcr = Local::pcprot($self, $pcno, @field); + }; +# dbg('local', "Local::pcprot error $@") if $@; + return if $pcr; + SWITCH: { if ($pcno == 10) { # incoming talk @@ -140,7 +166,7 @@ sub normal Log('talk', $call, $field[1], $field[6], $text); $call = $main::myalias if $call eq $main::mycall; my $ref = DXChannel->get($call); - $ref->send("$call de $field[1]: $text") if $ref; + $ref->send("$call de $field[1]: $text") if $ref && $ref->{talk}; } else { route($field[2], $line); # relay it on its way } @@ -154,9 +180,9 @@ sub normal # convert the date to a unix date my $d = cltounix($field[3], $field[4]); - # bang out (and don't pass on) if date is invalid or the spot is too old - if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) { - dbg('chan', "Spot ignored, invalid date or too old\n"); + # bang out (and don't pass on) if date is invalid or the spot is too old (or too young) + if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) { + dbg('chan', "Spot ignored, invalid date or out of range ($field[3] $field[4])\n"); return; } @@ -176,19 +202,56 @@ 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::spot($self, @spot); + }; +# dbg('local', "Local::spot1 error $@") if $@; + return if $r; + + # DON'T be silly and send on PC26s! + return if $pcno == 26; + + # send out the filtered spots + 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 $dxchan == $self; + my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name + my $filter = Filter::it($dxchan->{spotfilter}, @spot) if $dxchan->{spotfilter}; + if ($filter) { + $dxchan->send($routeit) if $routeit; + } else { + $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit; + } + } + # send orf to the users - if ($spot && $pcno == 11) { + if (@spot) { my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter); - broadcast_users("$buf\a\a"); + broadcast_users("$buf\a\a", 'dx', $spot[0]); } - # DON'T be silly and send on PC26s! - return if $pcno == 26; - - last SWITCH; + return; } if ($pcno == 12) { # announces @@ -216,9 +279,9 @@ sub normal $target = "All" if !$target; if (@list > 0) { - broadcast_list("$to$target de $field[1]: $text", @list); + broadcast_list("$to$target de $field[1]: $text", 'ann', undef, @list); } else { - broadcast_users("$target de $field[1]: $text"); + broadcast_users("$target de $field[1]: $text", 'ann', undef); } Log('ann', $target, $field[1], $text); @@ -250,7 +313,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?) @@ -364,13 +427,27 @@ sub normal dbg('chan', "Dup WWV Spot ignored\n"); return; } - + if ($d > $main::systime + 900 || $field[2] < 0 || $field[2] > 23) { + dbg('chan', "WWV Date ($field[1] $field[2]) out of range"); + return; + } $wwvdup{$dupkey} = $d; - Geomag::update($field[1], $field[2], $sfi, $k, $i, @field[6..$#field]); + $field[6] =~ s/-\d+$//o; # remove spotter's ssid + + my $wwv = Geomag::update($d, $field[2], $sfi, $k, $i, @field[6..$#field]); + + my $r; + eval { + $r = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]); + }; +# 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, A=$k, K=$i, $field[6]", 'wwv', $wwv ); last SWITCH; } @@ -510,7 +587,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; } @@ -637,8 +714,11 @@ sub send_local_config @nodes = (DXCluster->get_exact($main::mycall)); } else { # create a list of all the nodes that are not connected to this connection - @nodes = DXNode::get_all(); + # 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 { !($_->dxchan && $_->dxchan->isolate) } @nodes; } my @s = $me->pc19(@nodes); @@ -696,28 +776,51 @@ sub broadcast_ak1a } # 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 = get_all_users(); my $dxchan; + my @out; foreach $dxchan (@dxchan) { next if grep $dxchan == $_, @except; - $s =~ s/\a//og if !$dxchan->{beep}; - $dxchan->send($s); # send it if it isn't the except list or hasn't a passout flag + 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 (@_) { - $dxchan->send($s); # send it + my $filter = 1; + + 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 { + $dxchan->delay($s); + } } }