use DXDebug;
use Filter;
use Local;
+use DXDb;
+use Time::HiRes qw(gettimeofday tv_interval);
use Carp;
$decode_dk0wcy = undef; # if set use this callsign to decode announces from the EU WWV data beacon
$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
-$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 = 12*3600; # the maximum time to keep the ann dup list for
-$pc12_dup_lth = 72; # the length of ANN text to save for deduping
+$pc11_dup_age = 3*3600; # the maximum time to keep the spot dup list for
+$pc23_dup_age = 3*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
+$pc12_dup_lth = 60; # the length of ANN text to save for deduping
%spotdup = (); # the pc11 and 26 dup hash
%wwvdup = (); # the pc23 and 27 dup hash
%anndup = (); # the PC12 dup hash
%nodehops = (); # node specific hop control
@baddx = (); # list of illegal spotted callsigns
+
$baddxfn = "$main::data/baddx.pl";
sub init
}
$self->state('init');
$self->pc50_t(time);
+ $self->pingint($user->pingint || 3*60);
+ $self->nopings(3);
+ $self->lastping($main::systime);
+ $self->pingtime(0);
+ $self->pingrec(0);
Log('DXProt', "$call connected");
}
my $ref = DXChannel->get($call);
$ref->send("$call de $field[1]: $text") if $ref && $ref->{talk};
} else {
- route($field[2], $line); # relay it on its way
+ $self->route($field[2], $line); # relay it on its way
}
return;
}
# route 'foreign' pc26s
if ($pcno == 26) {
if ($field[7] ne $main::mycall) {
- route($field[7], $line);
+ $self->route($field[7], $line);
return;
}
}
if ($pcno == 12) { # announces
# announce duplicate checking
my $text = substr(uc unpad($field[3]), 0, $pc12_dup_lth);
- my $dupkey = $field[1].$field[2].$text.$field[4].$field[6];
+ my $dupkey = $field[1].$field[2].$text;
if ($anndup{$dupkey}) {
dbg('chan', "Duplicate Announce ignored\n");
return;
if ($decode_dk0wcy && $field[1] eq $decode_dk0wcy) {
my ($hour, $k, $next, $a, $r, $sfi, $alarm) = $field[3] =~ /^Aurora Beacon\s+(\d+)UTC,\s+Kiel\s+K=(\d+),.*ed\s+K=(\d+),\s+A=(\d+),\s+R=(\d+),\s+SFI=(\d+),.*larm:\s+(\w+)/;
$alarm = ($alarm =~ /^Y/i) ? ', Aurora in DE' : '';
- my $wwv = Geomag::update($main::systime, $hour, $sfi, $a, $k, "R=$r, Next K=$next$alarm", $decode_dk0wcy, $field[5], $r);
+ my $wwv = Geomag::update($main::systime, $hour, $sfi, $a, $k, "R=$r, Next K=$next$alarm", $decode_dk0wcy, $field[5], $r) if $sfi && $r;
}
} else {
- route($field[2], $line);
+ $self->route($field[2], $line);
}
return;
# route 'foreign' pc27s
if ($pcno == 27) {
if ($field[8] ne $main::mycall) {
- route($field[8], $line);
+ $self->route($field[8], $line);
return;
}
}
dbg('chan', "Dup WWV Spot ignored\n");
return;
}
- if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 900 || $field[2] < 0 || $field[2] > 23) {
+ if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
dbg('chan', "WWV Date ($field[1] $field[2]) out of range");
return;
}
if ($pcno == 25) { # merge request
if ($field[1] ne $main::mycall) {
- route($field[1], $line);
+ $self->route($field[1], $line);
return;
}
if ($field[2] eq $main::mycall) {
if ($pcno == 49 || $field[1] eq $main::mycall) {
DXMsg::process($self, $line);
} else {
- route($field[1], $line);
+ $self->route($field[1], $line);
}
return;
}
$self->send(pc35($main::mycall, $field[2], "$main::mycall:your attempt is logged, Tut tut tut...!"));
}
} else {
- route($field[1], $line);
+ $self->route($field[1], $line);
}
return;
}
delete $rcmds{$field[2]} if !$dxchan;
}
} else {
- route($field[1], $line);
+ $self->route($field[1], $line);
}
return;
}
last SWITCH;
}
if ($pcno == 37 || $pcno == 44 || $pcno == 45 || $pcno == 46 || $pcno == 47) {
- if ($field[1] eq $main::mycall) {
- ;
- } else {
- route($field[1], $line);
- }
+ DXDb::process($self, $line);
return;
}
# 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;
+ while (@$ref) {
+ my $r = shift @$ref;
+ my $dxchan = DXChannel->get($r->{call});
+ next unless $dxchan;
+ my $t = tv_interval($r->{t}, [ gettimeofday ]);
+ if ($dxchan->is_user) {
+ my $s = sprintf "%.2f", $t;
+ $dxchan->send($dxchan->msg('pingi', $field[2], $s))
+ } elsif ($dxchan->is_ak1a) {
+ my $tochan = DXChannel->get($field[2]);
+ if ($tochan) {
+ $tochan->nopings(3); # pump up the timer
+ $tochan->{pingtime} += $t;
+ $tochan->{pingrec} += 1;
+ $tochan->{pingave} = $tochan->{pingtime} / $tochan->{pingrec};
+ }
+ }
+ }
}
}
-
} else {
# route down an appropriate thingy
- route($field[1], $line);
+ $self->route($field[1], $line);
}
return;
}
# REBROADCAST!!!!
#
- if (!$self->{isolate}) {
+ unless ($self->{isolate}) {
broadcast_ak1a($line, $self); # send it to everyone but me
}
}
if ($t >= $dxchan->pc50_t + $DXProt::pc50_interval) {
$dxchan->send(pc50());
$dxchan->pc50_t($t);
+ }
+
+ # send a ping out on this channel
+ if ($t >= $dxchan->pingint + $dxchan->lastping) {
+ if ($dxchan->nopings <= 0) {
+ $dxchan->disconnect;
+ } else {
+ addping($main::mycall, $dxchan->call);
+ $dxchan->nopings($dxchan->nopings - 1);
+ $dxchan->lastping($t);
+ }
}
}
#
sub route
{
- my ($call, $line) = @_;
+ my ($self, $call, $line) = @_;
my $cl = DXCluster->get_exact($call);
- if ($cl) {
+ if ($cl) { # don't route it back down itself
+ if (ref $self && $call eq $self->{call}) {
+ dbg('chan', "Trying to route back to source, dropped");
+ return;
+ }
my $hops;
my $dxchan = $cl->{dxchan};
if ($dxchan) {
sub addping
{
my ($from, $to) = @_;
- my $ref = $pings{$to};
- $ref = $pings{$to} = [] if !$ref;
+ my $ref = $pings{$to} || [];
my $r = {};
$r->{call} = $from;
- $r->{t} = $main::systime;
- route($to, pc51($to, $main::mycall, 1));
+ $r->{t} = [ gettimeofday ];
+ route(undef, $to, pc51($to, $main::mycall, 1));
push @$ref, $r;
+ $pings{$to} = $ref;
}
# add a rcmd request to the rcmd queues
$r->{call} = $from;
$r->{t} = $main::systime;
$r->{cmd} = $cmd;
- route($to, pc34($main::mycall, $to, $cmd));
+ route(undef, $to, pc34($main::mycall, $to, $cmd));
$rcmds{$to} = $r;
}
1;
projects / spider.git / blobdiff