X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=04d62e4b55b02c3c23820cb3761c047b44af99e1;hb=77727aa5c288b8b34cb0e05cea45a367fa1f9b6c;hp=655da52b20ba2e45e1870593036854c74c9e6923;hpb=cce161221036760959ff1d0b7628a55942bf558a;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 655da52b..04d62e4b 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -21,20 +21,33 @@ use DXCommandmode; 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 %dup $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 $pc12_dup_age + %anndup); $me = undef; # the channel id for this cluster $pc11_max_age = 1*3600; # the maximum age for an incoming 'real-time' pc11 -$pc11_dup_age = 24*3600; # the maximum time to keep the dup list for -%dup = (); # the pc11 and 26 dup hash +$pc11_dup_age = 24*3600; # the maximum time to keep the spot dup list for +$pc23_dup_age = 24*3600; # the maximum time to keep the wwv dup list for +$pc12_dup_age = 24*3600; # the maximum time to keep the ann dup list for +%spotdup = (); # the pc11 and 26 dup hash +%wwvdup = (); # the pc23 and 27 dup hash +%anndup = (); # the PC12 dup hash $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 { @@ -46,6 +59,27 @@ sub init do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl"; confess $@ if $@; # $me->{sort} = 'M'; # M for me + + # now prime the spot duplicates file with today's and yesterday's data + my @today = Julian::unixtoj(time); + my @spots = Spot::readfile(@today); + @today = Julian::sub(@today, 1); + push @spots, Spot::readfile(@today); + for (@spots) { + my $dupkey = "$_->[0]$_->[1]$_->[2]$_->[3]$_->[4]"; + $spotdup{$dupkey} = $_->[2]; + } + + # now prime the wwv duplicates file with just this month's data + my @wwv = Geomag::readfile(time); + for (@wwv) { + my $dupkey = "$_->[1].$_->[2]$_->[3]$_->[4]"; + $wwvdup{$dupkey} = $_->[1]; + } + + # load the baddx file + do "$baddxfn" if -e "$baddxfn"; + print "$@\n" if $@; } # @@ -76,6 +110,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"); @@ -97,8 +136,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/; @@ -107,6 +149,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 @@ -119,7 +169,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 } @@ -133,8 +183,12 @@ sub normal # convert the date to a unix date my $d = cltounix($field[3], $field[4]); - return if !$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age); # bang out (and don't pass on) if date is invalid or the spot is too old - + # 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; + } + # strip off the leading & trailing spaces from the comment my $text = unpad($field[5]); @@ -143,22 +197,62 @@ sub normal $spotter =~ s/-\d+$//o; # strip off the ssid from the spotter # do some de-duping - my $dupkey = "$field[1]$field[2]$d$text$field[6]"; - return if $dup{$dupkey}; - $dup{$dupkey} = $d; - - my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter); + my $freq = $field[1] - 0; + my $dupkey = "$freq$field[2]$d$text$spotter"; + if ($spotdup{$dupkey}) { + dbg('chan', "Duplicate Spot ignored\n"); + return; + } - # 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"); + $spotdup{$dupkey} = $d; + + # is it 'baddx' + if (grep $field[2] eq $_, @baddx) { + dbg('chan', "Bad DX spot, ignored"); + return; } - last SWITCH; + 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 + send_dx_spot($self, $line, @spot) if @spot; + return; } if ($pcno == 12) { # announces + # announce duplicate checking + my $text = uc unpad($field[3]); + my $dupkey = $field[1].$field[2].$text.$field[4].$field[6]; + if ($anndup{$dupkey}) { + dbg('chan', "Duplicate Announce ignored\n"); + return; + } + $anndup{$dupkey} = $main::systime; + + # global ann filtering + my ($filter, $hops) = Filter::it($self->{annfilter}, @field[1..6], $self->{call} ) if $self->{annfilter}; + if ($self->{annfilter} && !$filter) { + dbg('chan', "Rejected by filter"); + return; + } if ($field[2] eq '*' || $field[2] eq $main::mycall) { @@ -183,9 +277,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); @@ -211,12 +305,13 @@ sub normal if ($pcno == 16) { # add a user my $node = DXCluster->get_exact($field[1]); last SWITCH if !$node; # ignore if havn't seen a PC19 for this one yet + last SWITCH unless $node->isa('DXNode'); my $i; for ($i = 2; $i < $#field; $i++) { - my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (-) (\d)/o; - next if length $call < 3; + my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o; + 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?) @@ -250,7 +345,7 @@ sub normal $self->send_local_config(); $self->send(pc20()); $self->state('init'); - last SWITCH; + return; # we don't pass these on } if ($pcno == 19) { # incoming cluster list @@ -299,6 +394,7 @@ sub normal # queue mail DXMsg::queue_msg(0); + return; } @@ -320,7 +416,37 @@ sub normal } if ($pcno == 23 || $pcno == 27) { # WWV info - Geomag::update(@field[1..$#field]); + # do some de-duping + my $d = cltounix($field[1], sprintf("%02d18Z", $field[2])); + my $sfi = unpad($field[3]); + my $k = unpad($field[4]); + my $i = unpad($field[5]); + my $dupkey = "$d.$sfi$k$i"; + if ($wwvdup{$dupkey}) { + 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; + $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; } @@ -331,8 +457,32 @@ sub normal last SWITCH; } - if ($pcno == 25) { - last SWITCH; + if ($pcno == 25) { # merge request + unless ($field[1] eq $main::mycall) { + dbg('chan', "merge request to $field[1] from $field[2] ignored"); + return; + } + + Log('DXProt', "Merge request for $field[3] spots and $field[4] WWV from $field[1]"); + + # spots + if ($field[3] > 0) { + my @in = reverse Spot::search(1, undef, undef, 0, $field[3]-1); + my $in; + foreach $in (@in) { + $self->send(pc26(@{$in}[0..4], $in->[7])); + } + } + + # wwv + if ($field[4] > 0) { + my @in = reverse Geomag::search(0, $field[4], time, 1); + my $in; + foreach $in (@in) { + $self->send(pc27(@{$in})); + } + } + return; } if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling @@ -343,8 +493,9 @@ sub normal if ($pcno == 34 || $pcno == 36) { # remote commands (incoming) if ($field[1] eq $main::mycall) { my $ref = DXUser->get_current($field[2]); + my $cref = DXCluster->get($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]); - unless ($field[3] =~ /rcmd/i) { # not allowed to relay RCMDS! + unless ($field[3] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) { # not allowed to relay RCMDS! if ($ref->{priv}) { # you have to have SOME privilege, the commands have further filtering $self->{remotecmd} = 1; # for the benefit of any command that needs to know my @in = (DXCommandmode::run_cmd($self, $field[3])); @@ -354,9 +505,11 @@ sub normal Log('rcmd', 'out', $field[2], $_); } delete $self->{remotecmd}; + } else { + $self->send(pc35($main::mycall, $field[2], "$main::mycall:sorry...!")); } } else { - $self->send(pc35($main::mycall, $field[2], "$main::mycall:Tut tut tut...!")); + $self->send(pc35($main::mycall, $field[2], "$main::mycall:your attempt is logged, Tut tut tut...!")); } } else { route($field[1], $line); @@ -436,7 +589,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; } @@ -504,8 +657,16 @@ sub process my $cutoff; if ($main::systime - 3600 > $last_hour) { $cutoff = $main::systime - $pc11_dup_age; - while (($key, $val) = each %dup) { - delete $dup{$key} if $val < $cutoff; + while (($key, $val) = each %spotdup) { + delete $spotdup{$key} if $val < $cutoff; + } + $cutoff = $main::systime - $pc23_dup_age; + while (($key, $val) = each %wwvdup) { + delete $wwvdup{$key} if $val < $cutoff; + } + $cutoff = $main::systime - $pc12_dup_age; + while (($key, $val) = each %anndup) { + delete $anndup{$key} if $val < $cutoff; } $last_hour = $main::systime; } @@ -529,8 +690,8 @@ sub finish my $node; foreach $node (@gonenodes) { - next if $node->call eq $call; - broadcast_ak1a(pc21($node->call, 'Gone'), $self) unless $self->{isolate}; # done like this 'cos DXNodes don't have a pc21 method + next if $node->call eq $call; + broadcast_ak1a(pc21($node->call, 'Gone') , $self) unless $self->{isolate}; $node->del(); } @@ -547,35 +708,82 @@ 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 && $dxchan->{dx}) { + my $buf = Spot::formatb($_[0], $_[1], $_[2], $_[3], $_[4]); + $buf .= "\a\a" if $dxchan->{beep}; + if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') { + $dxchan->send($buf) if !$hops || ($hops && $filter); + } else { + $dxchan->delay($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($_) if $routeit; + $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) { my $routeit = adjust_hops($self, $_); - $self->send($_) if $routeit; + $self->send($routeit) if $routeit; } } } @@ -595,13 +803,14 @@ sub route if ($dxchan) { my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name if ($routeit) { - $dxchan->send($line) if $dxchan; + $dxchan->send($routeit) if $dxchan; } } } } -# 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 @@ -612,34 +821,74 @@ sub broadcast_ak1a # 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($s) unless $dxchan->{isolate} || !$routeit; + 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 = 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 { 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); + } } } @@ -701,28 +950,29 @@ sub get_hops sub adjust_hops { my $self = shift; + my $s = shift; my $call = $self->{call}; my $hops; - if (($hops) = $_[0] =~ /\^H(\d+)\^~?$/o) { - my ($pcno) = $_[0] =~ /^PC(\d\d)/o; - confess "$call called adjust_hops with '$_[0]'" unless $pcno; + if (($hops) = $s =~ /\^H(\d+)\^~?$/o) { + my ($pcno) = $s =~ /^PC(\d\d)/o; + confess "$call called adjust_hops with '$s'" unless $pcno; my $ref = $nodehops{$call} if %nodehops; if ($ref) { my $newhops = $ref->{$pcno}; - return 0 if defined $newhops && $newhops == 0; + return "" if defined $newhops && $newhops == 0; $newhops = $ref->{default} unless $newhops; - return 0 if defined $newhops && $newhops == 0; + return "" if defined $newhops && $newhops == 0; $newhops = $hops if !$newhops; - $_[0] =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; + $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; } else { # simply decrement it $hops--; - return 0 if !$hops; - $_[0] =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; + return "" if !$hops; + $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; } } - return 1; + return $s; } #