X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=01b64372b8d4d1cf55847b76d229fea3b65e984c;hb=61cdf7dc2b72c1898850a4d2aa403d712f22f8ee;hp=b8b9b892d47397d42937608114e6b8a0965c6f71;hpb=84d5fec90a21118c556d22b8b36b02c93bc829f1;p=spider.git diff --git a/perl/DXProt.pm b/perl/DXProt.pm index b8b9b892..01b64372 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -21,22 +21,54 @@ use DXCommandmode; use DXLog; use Spot; use DXProtout; +use DXDebug; +use Local; + use Carp; use strict; -use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour); +use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $last_hour %pings %rcmds %nodehops); $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 +%spotdup = (); # the pc11 and 26 dup hash +%wwvdup = (); # the pc23 and 27 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 + sub init { my $user = DXUser->get($main::mycall); - $me = DXProt->new($main::mycall, undef, $user); + $DXProt::myprot_version += $main::version*100; + $me = DXProt->new($main::mycall, 0, $user); + $me->{here} = 1; + $me->{state} = "indifferent"; + 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]; + } + } # @@ -46,7 +78,7 @@ sub init sub new { my $self = DXChannel::alloc(@_); - $self->{sort} = 'A'; # in absence of how to find out what sort of an object I am + $self->{'sort'} = 'A'; # in absence of how to find out what sort of an object I am return $self; } @@ -64,6 +96,7 @@ sub start $self->{outbound} = $sort eq 'O'; $self->{priv} = $user->priv; $self->{lang} = $user->lang; + $self->{isolate} = $user->{isolate}; $self->{consort} = $line; # save the connection type $self->{here} = 1; @@ -77,6 +110,7 @@ sub start } $self->state('init'); $self->pc50_t(time); + Log('DXProt', "$call connected"); } @@ -86,15 +120,27 @@ 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/; # process PC frames my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number + 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 @@ -121,8 +167,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 + if (!$d || ($pcno == 11 && $d < $main::systime - $pc11_max_age)) { + dbg('chan', "Spot ignored, invalid date or too old\n"); + return; + } + # strip off the leading & trailing spaces from the comment my $text = unpad($field[5]); @@ -131,17 +181,33 @@ 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 $freq = $field[1] - 0; + my $dupkey = "$freq$field[2]$d$text$spotter"; + if ($spotdup{$dupkey}) { + dbg('chan', "Duplicate Spot ignored\n"); + return; + } + + $spotdup{$dupkey} = $d; - my $spot = Spot::add($field[1], $field[2], $d, $text, $spotter); + my $spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]); + # local processing + my $r; + eval { + $r = Local::spot1($self, $freq, $field[2], $d, $text, $spotter, $field[7]); + }; + 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"); } + + # DON'T be silly and send on PC26s! + return if $pcno == 26; last SWITCH; } @@ -157,7 +223,7 @@ sub normal my @list; if ($field[4] eq '*') { # sysops - $target = "Sysops"; + $target = "SYSOP"; @list = map { $_->priv >= 5 ? $_ : () } get_all_users(); } elsif ($field[4] gt ' ') { # speciality list handling my ($name) = split /\./, $field[4]; @@ -199,11 +265,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 length $call < 3 || length $call > 8; next if !$confmode; $call = uc $call; next if DXCluster->get_exact($call); # we already have this (loop?) @@ -215,8 +283,9 @@ sub normal $call =~ s/-\d+$//o; # remove ssid for users my $user = DXUser->get_current($call); $user = DXUser->new($call) if !$user; - $user->node($node->call); $user->homenode($node->call) if !$user->homenode; + $user->node($node->call); + $user->lastin($main::systime); $user->put; } @@ -236,7 +305,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 @@ -264,14 +333,17 @@ sub normal if (!$user) { $user = DXUser->new($call); $user->sort('A'); - $user->node($call); + $user->priv(1); # I have relented and defaulted nodes + $self->{priv} = 1; # to user RCMDs allowed $user->homenode($call); - $user->put; + $user->node($call); } + $user->lastin($main::systime); + $user->put; } # queue up any messages - DXMsg::queue_msg() if $self->state eq 'normal'; + DXMsg::queue_msg(0) if $self->state eq 'normal'; last SWITCH; } @@ -281,7 +353,7 @@ sub normal $self->state('normal'); # queue mail - DXMsg::queue_msg(); + DXMsg::queue_msg(0); return; } @@ -295,11 +367,38 @@ sub normal } if ($pcno == 22) { - last SWITCH; + $self->state('normal'); + + # queue mail + DXMsg::queue_msg(0); + return; } 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; + } + + $wwvdup{$dupkey} = $d; + Geomag::update($field[1], $field[2], $sfi, $k, $i, @field[6..$#field]); + + my $r; + eval { + $r = Local::wwv2($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; + last SWITCH; } @@ -310,11 +409,35 @@ 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) { # mail/file handling + if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42 || $pcno == 49) { # mail/file handling DXMsg::process($self, $line); return; } @@ -323,15 +446,19 @@ sub normal if ($field[1] eq $main::mycall) { my $ref = DXUser->get_current($field[2]); Log('rcmd', 'in', $ref->{priv}, $field[2], $field[3]); - 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])); - for (@in) { - s/\s*$//og; - $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_")); - Log('rcmd', 'out', $field[2], $_); + unless ($field[3] =~ /rcmd/i) { # 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])); + for (@in) { + s/\s*$//og; + $self->send(pc35($main::mycall, $field[2], "$main::mycall:$_")); + Log('rcmd', 'out', $field[2], $_); + } + delete $self->{remotecmd}; } - delete $self->{remotecmd}; + } else { + $self->send(pc35($main::mycall, $field[2], "$main::mycall:Tut tut tut...!")); } } else { route($field[1], $line); @@ -341,12 +468,11 @@ sub normal if ($pcno == 35) { # remote command replies if ($field[1] eq $main::mycall) { - my $s = DXChannel::get($main::myalias); - my @ref = grep { $_->pc34to eq $field[2] } DXChannel::get_all(); # people that have rcmded someone - push @ref, $s if $s; - - foreach (@ref) { - $_->send($field[3]); + my $s = $rcmds{$field[2]}; + if ($s) { + my $dxchan = DXChannel->get($s->{call}); + $dxchan->send($field[3]) if $dxchan; + delete $rcmds{$field[2]} if !$dxchan; } } else { route($field[1], $line); @@ -382,13 +508,9 @@ sub normal } elsif ($field[2] == 2) { $user->qth($field[3]); } elsif ($field[2] == 3) { - my ($latd, $latm, $latl, $longd, $longm, $longl) = split /\s+/, $field[3]; - $longd += ($longm/60); - $longd = 0-$longd if (uc $longl) eq 'W'; - $user->long($longd); - $latd += ($latm/60); - $latd = 0-$latd if (uc $latl) eq 'S'; - $user->lat($latd); + my ($lat, $long) = DXBearing::stoll($field[3]); + $user->lat($lat); + $user->long($long); } elsif ($field[2] == 4) { $user->homenode($field[3]); } @@ -413,9 +535,6 @@ sub normal if ($pcno == 48) { last SWITCH; } - if ($pcno == 49) { - last SWITCH; - } if ($pcno == 50) { # keep alive/user list my $ref = DXCluster->get_exact($field[1]); @@ -428,8 +547,18 @@ sub normal # is it for us? if ($field[1] eq $main::mycall) { my $flag = $field[3]; - $flag ^= 1; - $self->send($self->pc51($field[2], $field[1], $flag)); + if ($flag == 1) { + $self->send(pc51($field[2], $field[1], '0')); + } else { + # it's a reply, look in the ping list for this one + my $ref = $pings{$field[2]}; + if ($ref) { + my $r = shift @$ref; + my $dxchan = DXChannel->get($r->{call}); + $dxchan->send($dxchan->msg('pingi', $field[2], atime($main::systime), $main::systime - $r->{t})) if $dxchan; + } + } + } else { # route down an appropriate thingy route($field[1], $line); @@ -446,13 +575,8 @@ sub normal # REBROADCAST!!!! # - my $hops; - if (($hops) = $line =~ /H(\d+)\^\~?$/o) { - my $newhops = $hops - 1; - if ($newhops > 0) { - $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count - broadcast_ak1a($line, $self); # send it to everyone but me - } + if (!$self->{isolate}) { + broadcast_ak1a($line, $self); # send it to everyone but me } } @@ -463,16 +587,17 @@ sub normal sub process { my $t = time; - my @chan = DXChannel->get_all(); - my $chan; + my @dxchan = DXChannel->get_all(); + my $dxchan; - foreach $chan (@chan) { - next if !$chan->is_ak1a(); + foreach $dxchan (@dxchan) { + next unless $dxchan->is_ak1a(); + next if $dxchan == $me; # send a pc50 out on this channel - if ($t >= $chan->pc50_t + $DXProt::pc50_interval) { - $chan->send(pc50()); - $chan->pc50_t($t); + if ($t >= $dxchan->pc50_t + $DXProt::pc50_interval) { + $dxchan->send(pc50()); + $dxchan->pc50_t($t); } } @@ -481,8 +606,12 @@ 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; } $last_hour = $main::systime; } @@ -494,10 +623,11 @@ sub process sub finish { my $self = shift; - my $ref = DXCluster->get_exact($self->call); + my $call = $self->call; + my $ref = DXCluster->get_exact($call); # unbusy and stop and outgoing mail - my $mref = DXMsg::get_busy($self->call); + my $mref = DXMsg::get_busy($call); $mref->stop_msg($self) if $mref; # broadcast to all other nodes that all the nodes connected to via me are gone @@ -505,14 +635,18 @@ sub finish my $node; foreach $node (@gonenodes) { - next if $node->call eq $self->call; - broadcast_ak1a(pc21($node->call, 'Gone'), $self); # 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(); } + + # remove outstanding pings + delete $pings{$call}; # now broadcast to all other ak1a nodes that I have gone - broadcast_ak1a(pc21($self->call, 'Gone.'), $self); - Log('DXProt', $self->call . " Disconnected"); + broadcast_ak1a(pc21($call, 'Gone.'), $self); + + Log('DXProt', $call . " Disconnected"); $ref->del() if $ref; } @@ -524,18 +658,31 @@ sub send_local_config { my $self = shift; my $n; + my @nodes; # send our nodes - my @nodes = DXNode::get_all(); - - # create a list of all the nodes that are not connected to this connection - @nodes = grep { $_->dxchan != $self } @nodes; - $self->send($me->pc19(@nodes)); + if ($self->{isolate}) { + @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(); + @nodes = grep { $_->dxchan != $self } @nodes; + } + + my @s = $me->pc19(@nodes); + 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) { my @users = values %{$n->list}; - $self->send(DXProt::pc16($n, @users)); + my @s = pc16($n, @users); + for (@s) { + my $routeit = adjust_hops($self, $_); + $self->send($routeit) if $routeit; + } } } @@ -551,14 +698,11 @@ sub route if ($cl) { my $hops; my $dxchan = $cl->{dxchan}; - if (($hops) = $line =~ /H(\d+)\^\~?$/o) { - my $newhops = $hops - 1; - if ($newhops > 0) { - $line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/; # change the hop count - $dxchan->send($line) if $dxchan; + if ($dxchan) { + my $routeit = adjust_hops($dxchan, $line); # adjust its hop count by node name + if ($routeit) { + $dxchan->send($routeit) if $dxchan; } - } else { - $dxchan->send($line) if $dxchan; # for them wot don't have Hops } } } @@ -568,12 +712,14 @@ sub broadcast_ak1a { my $s = shift; # the line to be rebroadcast my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @chan = get_all_ak1a(); - my $chan; + my @dxchan = get_all_ak1a(); + my $dxchan; - foreach $chan (@chan) { - next if grep $chan == $_, @except; - $chan->send($s); # send it if it isn't the except list + # 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) unless $dxchan->{isolate} || !$routeit; } } @@ -582,12 +728,13 @@ sub broadcast_users { my $s = shift; # the line to be rebroadcast my @except = @_; # to all channels EXCEPT these (dxchannel refs) - my @chan = get_all_users(); - my $chan; + my @dxchan = get_all_users(); + my $dxchan; - foreach $chan (@chan) { - next if grep $chan == $_, @except; - $chan->send($s); # send it if it isn't the except list + 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 } } @@ -595,10 +742,10 @@ sub broadcast_users sub broadcast_list { my $s = shift; - my $chan; + my $dxchan; - foreach $chan (@_) { - $chan->send($s); # send it + foreach $dxchan (@_) { + $dxchan->send($s); # send it } } @@ -652,6 +799,51 @@ sub get_hops return "H$hops"; } +# +# adjust the hop count on a per node basis using the user loadable +# hop table if available or else decrement an existing one +# + +sub adjust_hops +{ + my $self = shift; + my $s = shift; + my $call = $self->{call}; + my $hops; + + 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 "" if defined $newhops && $newhops == 0; + $newhops = $ref->{default} unless $newhops; + return "" if defined $newhops && $newhops == 0; + $newhops = $hops if !$newhops; + $s =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops; + } else { + # simply decrement it + $hops--; + return "" if !$hops; + $s =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops; + } + } + return $s; +} + +# +# load hop tables +# +sub load_hops +{ + my $self = shift; + return $self->msg('lh1') unless -e "$main::data/hop_table.pl"; + do "$main::data/hop_table.pl"; + return $@ if $@; + return 0; +} + # remove leading and trailing spaces from an input string sub unpad { @@ -659,5 +851,30 @@ sub unpad $s =~ s/^\s+|\s+$//; return $s; } + +# add a ping request to the ping queues +sub addping +{ + my ($from, $to) = @_; + my $ref = $pings{$to}; + $ref = $pings{$to} = [] if !$ref; + my $r = {}; + $r->{call} = $from; + $r->{t} = $main::systime; + route($to, pc51($to, $main::mycall, 1)); + push @$ref, $r; +} + +# add a rcmd request to the rcmd queues +sub addrcmd +{ + my ($from, $to, $cmd) = @_; + my $r = {}; + $r->{call} = $from; + $r->{t} = $main::systime; + $r->{cmd} = $cmd; + route($to, pc34($main::mycall, $to, $cmd)); + $rcmds{$to} = $r; +} 1; __END__