perl/RBN.pm

   1 #
   2 # The RBN connection system
   3 #
   4 # Copyright (c) 2020 Dirk Koopman G1TLH
   5 #
   6
   7 use warnings;
   8 use strict;
   9
  10 package RBN;
  11
  12 use 5.10.1;
  13
  14 use lib qw {.};
  15
  16 use DXDebug;
  17 use DXUtil;
  18 use DXLog;
  19 use DXUser;
  20 use DXChannel;
  21 use Math::Round qw(nearest nearest_floor);
  22 use Date::Parse;
  23 use Time::HiRes qw(gettimeofday);
  24 use Spot;
  25 use DXJSON;
  26 use IO::File;
  27
  28 use constant {
  29                           ROrigin => 0,
  30                           RQrg => 1,
  31                           RCall => 2,
  32                           RMode => 3,
  33                           RStrength => 4,
  34                           RTime => 5,
  35                           RUtz => 6,
  36                           Respot => 7,
  37                           RQra => 8,
  38                           RSpotData => 9,
  39                          };
  40
  41 use constant {
  42                           SQrg => 0,
  43                           SCall => 1,
  44                           STime => 2,
  45                           SComment => 3,
  46                           SOrigin => 4,
  47                           SZone => 11,
  48                          };
  49 use constant {
  50                           OQual => 0,
  51                           OAvediff => 1,
  52                           OSpare => 2,
  53                           ODiff => 3,
  54                          };
  55 use constant {
  56                           CTime => 0,
  57                           CQual => 1,
  58                           CData => 2,
  59                          };
  60
  61 use constant {
  62                           DScore => 0,
  63                           DGood => 1,
  64                           DBad => 2,
  65                           DLastin => 3,
  66                           DEviants => 4,
  67                          };
  68
  69
  70 our $DATA_VERSION = 1;
  71
  72 our @ISA = qw(DXChannel);
  73
  74 our $startup_delay = 5*60;              # don't send anything out until this timer has expired
  75                                 # this is to allow the feed to "warm up" with duplicates
  76                                 # so that the "big rush" doesn't happen.
  77
  78 our $minspottime = 30*60;               # the time between respots of a callsign - if a call is
  79                                 # still being spotted (on the same freq) and it has been
  80                                 # spotted before, it's spotted again after this time
  81                                 # until the next minspottime has passed.
  82
  83 our $beacontime = 5*60;                 # same as minspottime, but for beacons (and shorter)
  84
  85 our $dwelltime = 10;                    # the amount of time to wait for duplicates before issuing
  86                                 # a spot to the user (no doubt waiting with bated breath).
  87
  88 our $limbotime = 5*60;                  # if there are fewer than $minqual candidates and $dwelltime
  89                                 # has expired then allow this spot to live a bit longer. It may
  90                                 # simply be that it is not in standard spot coverage. (ask G4PIQ
  91                                 # about this).
  92
  93 our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why :-).
  94
  95 my $spots;                                              # the GLOBAL spot cache
  96
  97 my %runtime;                                    # how long each channel has been running
  98
  99 our $cachefn = localdata('rbn_cache');
 100 our $cache_valid = 4*60;                # The cache file is considered valid if it is not more than this old
 101
 102 our $maxqrgdiff = 10;                   # the maximum
 103 our $minqual = 2;                               # the minimum quality we will accept for output
 104 our $maxqual = 9;                               # if there is enough quality, then short circuit any remaining dwelltime.
 105
 106 my $json;
 107 my $noinrush = 0;                               # override the inrushpreventor if set
 108 our $maxdeviants = 5;                   # the number of deviant QRGs to record for skimmer records
 109
 110 our %seeme;                                     # the list of users that want to see themselves
 111
 112
 113 sub init
 114 {
 115         $json = DXJSON->new;
 116         $json->canonical(0);
 117         if (check_cache()) {
 118                 $noinrush = 1;
 119         } else {
 120                 $spots = {VERSION=>$DATA_VERSION};
 121         }
 122         if (defined $DB::VERSION) {
 123                 $noinrush = 1;
 124                 $json->indent(1);
 125         }
 126
 127 }
 128
 129 sub new
 130 {
 131         my $self = DXChannel::alloc(@_);
 132
 133         # routing, this must go out here to prevent race condx
 134         my $pkg = shift;
 135         my $call = shift;
 136
 137         $self->{last} = 0;
 138         $self->{noraw} = 0;
 139         $self->{nospot} = 0;
 140         $self->{nouser} = {};
 141         $self->{norbn} = 0;
 142         $self->{noraw10} = 0;
 143         $self->{nospot10} = 0;
 144         $self->{nouser10} = {};
 145         $self->{norbn10} = 0;
 146         $self->{nospothour} = 0;
 147         $self->{nouserhour} = {};
 148         $self->{norbnhour} = 0;
 149         $self->{norawhour} = 0;
 150         $self->{sort} = 'N';
 151         $self->{lasttime} = $main::systime;
 152         $self->{minspottime} = $minspottime;
 153         $self->{beacontime} = $beacontime;
 154         $self->{showstats} = 0;
 155         $self->{pingint} = 0;
 156         $self->{nopings} = 0;
 157         $self->{queue} = {};
 158
 159         return $self;
 160 }
 161
 162 sub start
 163 {
 164         my ($self, $line, $sort) = @_;
 165         my $user = $self->{user};
 166         my $call = $self->{call};
 167         my $name = $user->{name};
 168
 169         # log it
 170         my $host = $self->{conn}->peerhost;
 171         $host ||= "unknown";
 172         $self->{hostname} = $host;
 173
 174         $self->{name} = $name ? $name : $call;
 175         $self->state('prompt');         # a bit of room for further expansion, passwords etc
 176         $self->{lang} = $user->lang || $main::lang || 'en';
 177         if ($line =~ /host=/) {
 178                 my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/;
 179                 $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h;
 180                 unless ($h) {
 181                         ($h) = $line =~ /host=([\da..fA..F:]+)/;
 182                         $line =~ s/\s*host=[\da..fA..F:]+// if $h;
 183                 }
 184                 if ($h) {
 185                         $h =~ s/^::ffff://;
 186                         $self->{hostname} = $h;
 187                 }
 188         }
 189         $self->{width} = 80 unless $self->{width} && $self->{width} > 80;
 190         $self->{consort} = $line;       # save the connection type
 191
 192         LogDbg('DXCommand', "$call connected from $self->{hostname}");
 193
 194         # set some necessary flags on the user if they are connecting
 195         $self->{registered} = 1;
 196         # sort out privilege reduction
 197         $self->{priv} = 0;
 198
 199         # get the filters
 200         my $nossid = $call;
 201         $nossid =~ s/-\d+$//;
 202
 203         $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1)
 204                 || Filter::read_in('rbn', 'node_default', 1);
 205
 206         # clean up qra locators
 207         my $qra = $user->qra;
 208         $qra = undef if ($qra && !DXBearing::is_qra($qra));
 209         unless ($qra) {
 210                 my $lat = $user->lat;
 211                 my $long = $user->long;
 212                 $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);
 213         }
 214
 215         # if we have been running and stopped for a while
 216         # if the cache is warm enough don't operate the inrush preventor
 217         $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ?  0 : $main::systime + $startup_delay;
 218         dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}");
 219 }
 220
 221 my @queue;                                              # the queue of spots ready to send
 222
 223 sub normal
 224 {
 225         my $self = shift;
 226         my $line = shift;
 227         my @ans;
 228         my $dbgrbn = isdbg('rbn');
 229
 230         # remove leading and trailing spaces
 231         chomp $line;
 232         $line =~ s/^\s*//;
 233         $line =~ s/\s*$//;
 234
 235         # add base RBN
 236
 237         my $now = $main::systime;
 238
 239         # parse line
 240         dbg "RBN:RAW,$line" if isdbg('rbnraw');
 241         return unless $line=~/^DX\s+de/;
 242
 243         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
 244
 245         # fix up FT8 spots from 7001
 246         $t = $u, $u = '' if !$t && is_ztime($u);
 247         $t = $sort, $sort = '' if !$t && is_ztime($sort);
 248         my $qra = $spd, $spd = '' if is_qra($spd);
 249         $u = $qra if $qra;
 250
 251         # is this anything like a callsign?
 252         unless (is_callsign($call)) {
 253                 dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped");
 254                 return;
 255         }
 256
 257         # remove all extraneous crap from the origin - just leave the base callsign
 258         my $norigin = basecall($origin);
 259         unless ($norigin) {
 260                 dbg("RBN: ERROR '$origin' is an invalid callsign, dumped");
 261                 return;
 262         }
 263         $origin = $norigin;
 264
 265         # is this callsign in badspotter list?
 266         if ($DXProt::badspotter->in($origin) || $DXProt::badnode->in($origin)) {
 267                 dbg("RBN: ERROR $origin is a bad spotter/node, dumped");
 268                 return;
 269         }
 270
 271         # is the qrg valid
 272         unless ($qrg =~ /^\d+\.\d{1,3}$/) {
 273                 dbg("RBN: ERROR qrg $qrg from $origin invalid, dumped");
 274                 return;
 275         }
 276
 277         $sort ||= '';
 278         $tx ||= '';
 279         $qra ||= '';
 280     dbg qq{RBN:input decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra} if $dbgrbn && isdbg('rbn');
 281
 282         ++$self->{noraw};
 283         ++$self->{noraw10};
 284         ++$self->{norawhour};
 285
 286         my $b;
 287
 288         if ($t || $tx) {
 289
 290                 # fix up times for things like 'NXDXF B' etc
 291                 if ($tx && is_ztime($t)) {
 292                         if (is_ztime($tx)) {
 293                                 $b = $t;
 294                                 $t = $tx;
 295                         } else {
 296                                 dbg "RBN:ERR,$line";
 297                                 return (0);
 298                         }
 299                 }
 300                 if ($sort && $sort eq 'NCDXF') {
 301                         $mode = 'DXF';
 302                         $t = $tx;
 303                 }
 304                 if ($sort && $sort eq 'BEACON') {
 305                         $mode = 'BCN';
 306                 }
 307                 if ($mode =~ /^PSK/) {
 308                         $mode = 'PSK';
 309                 }
 310                 if ($mode eq 'RTTY') {
 311                         $mode = 'RTT';
 312                 }
 313
 314                 # The main de-duping key is [call, $frequency], but we probe a bit around that frequency to find a
 315                 # range of concurrent frequencies that might be in play.
 316
 317                 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
 318         # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
 319                 # data sources (for singleton spots) to then generate a "centre" from and to zone (whatever that will mean if it isn't the usual one)
 320                 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
 321         # and spotted. A map can be generated once per user and spotter as they are essentially mostly static.
 322                 # The spotted will only get a coarse position unless other info is available. Programs that parse
 323                 # DX bulletins and the online data online databases could be be used and then cached.
 324
 325                 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
 326                 # ignored.
 327
 328                 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
 329                 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
 330                 # process to just the standard "message passing" which has been shown to be able to sustain over 5000
 331                 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
 332
 333                 my $search = 5;
 334                 my $nqrg = nearest(1, $qrg * 10);  # normalised to nearest Khz
 335                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 336
 337                 # deal with the unix time
 338                 my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
 339                 my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
 340                 $utz -= 86400 if $utz > $now+3600;                                         # too far ahead, drag it back one day
 341
 342                 #
 343                 # But before we do anything, if this call is in the seeme hash then just send the spot to them
 344                 #
 345                 if (exists $seeme{$call} && (my $scall = $seeme{$call})) {
 346                         my $uchan = DXChannel::get($call);
 347                         if ($uchan->is_user) {
 348                                 if (isdbg('seeme')) {
 349                                         dbg("seeme: $line");
 350                                         dbg( qq{seemme:decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra});
 351                                 }
 352                                 my @s =  Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#');
 353                                 my $buf = $uchan->format_dx_spot(@s);
 354                                 dbg("seeme: result '$buf'") if isdbg('seeme');
 355                                 $uchan->local_send('S', $buf) if $scall;
 356                         } else {
 357                                 LogDbg("RBN Someone is playing silly persons $call is not a user and cannot do 'seeme', ignored and reset");
 358                                 delete $seeme{$call};
 359                         }
 360                 }
 361                 # find it?
 362                 my $cand = $spots->{$sp};
 363                 unless ($cand) {
 364                         my ($i, $new);
 365                         for ($i = $nqrg; !$cand && $i <= $nqrg+$search; $i += 1) {
 366                                 $new = "$call|$i";
 367                                 $cand = $spots->{$new}, last if exists $spots->{$new};
 368                         }
 369                         if ($cand) {
 370                                 my $diff = $i - $nqrg;
 371                                 dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
 372                                 $sp = $new;
 373                         }
 374                 }
 375                 unless ($cand) {
 376                         my ($i, $new);
 377                         for ($i = $nqrg; !$cand && $i >= $nqrg-$search; $i -= 1) {
 378                                 $new = "$call|$i";
 379                                 $cand = $spots->{$new}, last if exists $spots->{$new};
 380                         }
 381                         if ($cand) {
 382                                 my $diff = $nqrg - $i;
 383                                 dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
 384                                 $sp = $new;
 385                         }
 386                 }
 387
 388                 # if we have one and there is only one slot and that slot's time isn't expired for respot then return
 389                 my $respot = 0;
 390                 if ($cand && ref $cand) {
 391                         if (@$cand <= CData) {
 392                                 if ($self->{minspottime} > 0 && $now - $cand->[CTime] < $self->{minspottime}) {
 393                                         dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
 394                                         return;
 395                                 }
 396
 397                                 dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
 398                                 $cand->[CTime] = $now;
 399                                 ++$respot;
 400                         }
 401
 402                         # otherwise we have a spot being built up at the moment
 403                 } elsif ($cand) {
 404                         dbg("RBN: key '$sp' = '$cand' not ref");
 405                         return;
 406                 } else {
 407                         # new spot / frequency
 408                         $spots->{$sp} = $cand = [$now, 0];
 409                         dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if $dbgrbn && isdbg('rbn');
 410                 }
 411
 412                 # add me to the display queue unless we are waiting for initial in rush to finish
 413                 return unless $noinrush || $self->{inrushpreventor} < $main::systime;
 414
 415                 # build up a new record and store it in the buildup
 416                 # create record and add into the buildup
 417                 my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
 418                 my @s =  Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
 419                 if ($s[5] == 666) {
 420                         dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped");
 421                         return;
 422                 }
 423
 424                 if ($self->{inrbnfilter}) {
 425                         my ($want, undef) = $self->{inrbnfilter}->it($s);
 426                         return unless $want;
 427                 }
 428                 $r->[RSpotData] = \@s;
 429
 430                 ++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record)
 431
 432                 dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin respot: $respot") if $dbgrbn && isdbg('rbn');
 433
 434                 push @$cand, $r;
 435
 436         } else {
 437                 dbg "RBN:DATA,$line" if $dbgrbn && isdbg('rbn');
 438         }
 439 }
 440
 441 # we should get the spot record minus the time, so just an array of record (arrays)
 442 sub send_dx_spot
 443 {
 444         my $self = shift;
 445         my $quality = shift;
 446         my $cand = shift;
 447
 448         ++$self->{norbn};
 449         ++$self->{norbn10};
 450         ++$self->{norbnhour};
 451
 452         # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
 453
 454         my $mode = $cand->[CData]->[RMode]; # as all the modes will be the same;
 455
 456         my @dxchan = DXChannel::get_all();
 457
 458         foreach my $dxchan (@dxchan) {
 459                 next unless $dxchan->is_user;
 460                 my $user = $dxchan->{user};
 461                 next unless $user &&  $user->wantrbn;
 462
 463                 # does this user want this sort of spot at all?
 464                 my $want = 0;
 465                 ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
 466                 ++$want if $user->wantcw && $mode =~ /^CW/;
 467                 ++$want if $user->wantrtty && $mode =~ /^RTT/;
 468                 ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/;
 469                 ++$want if $user->wantft && $mode =~ /^FT/;
 470
 471                 dbg(sprintf("RBN: spot selection for $dxchan->{call} mode: '$mode' want: $want flags rbn:%d ft:%d bcn:%d cw:%d psk:%d rtty:%d",
 472                                         $user->wantrbn,
 473                                         $user->wantft,
 474                                         $user->wantbeacon,
 475                                         $user->wantcw,
 476                                         $user->wantpsk,
 477                                         $user->wantrtty,
 478                                    )) if isdbg('rbnll');
 479
 480                 # send one spot to one user out of the ones that we have
 481                 $self->dx_spot($dxchan, $quality, $cand) if $want;
 482         }
 483 }
 484
 485 sub dx_spot
 486 {
 487         my $self = shift;
 488         my $dxchan = shift;
 489         my $quality = shift;
 490         my $cand = shift;
 491         my $call = $dxchan->{call};
 492         my $strength = 100;             # because it could if we talk about FTx
 493         my $saver;
 494         my %zone;
 495         my $respot;
 496         my $qra;
 497
 498         ++$self->{nousers}->{$call};
 499         ++$self->{nousers10}->{$call};
 500         ++$self->{nousershour}->{$call};
 501
 502         my $filtered;
 503         my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter};
 504         my $comment;
 505
 506         foreach my $r (@$cand) {
 507                 # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra];
 508                 # Spot::prepare($qrg, $call, $utz, $comment, $origin);
 509                 next unless $r && ref $r;
 510
 511                 $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]);
 512
 513                 $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength];
 514                 my $s = $r->[RSpotData];                # the prepared spot
 515                 $s->[SComment] = $comment;              # apply new generated comment
 516
 517                 ++$zone{$s->[SZone]};           # save the spotter's zone
 518
 519                 # save the lowest strength one
 520                 if ($r->[RStrength] < $strength) {
 521                         $strength = $r->[RStrength];
 522                         $saver = $s;
 523                         dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll';
 524                 }
 525
 526                 if ($rf) {
 527                         my ($want, undef) = $rf->it($s);
 528                         dbg("RBN: FILTERING for $call spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] com: '$s->[SComment]' want: " . ($want ? 'YES':'NO')) if isdbg 'rbnll';
 529                         next unless $want;
 530                         $filtered = $s;
 531                 }
 532         }
 533
 534         if ($rf) {
 535                 $saver = $filtered;             # if nothing passed the filter's lips then $saver == $filtered == undef !
 536         }
 537
 538         if ($saver) {
 539                 my $buf;
 540                 # create a zone list of spotters
 541                 delete $zone{$saver->[SZone]};  # remove this spotter's zone (leaving all the other zones)
 542                 my $z = join ',', sort {$a <=> $b} keys %zone;
 543
 544                 # alter spot data accordingly
 545                 $saver->[SComment] .= " Z:$z" if $z;
 546
 547                 send_final($dxchan, $saver);
 548
 549                 ++$self->{nospot};
 550                 ++$self->{nospot10};
 551                 ++$self->{nospothour};
 552
 553                 if ($qra) {
 554                         my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]);
 555                         unless ($user->qra && is_qra($user->qra)) {
 556                                 $user->qra($qra);
 557                                 dbg("RBN: update qra on $saver->[SCall] to $qra");
 558                         }
 559                         # update lastseen if nothing else
 560                         $user->put;
 561                 }
 562         }
 563 }
 564
 565 sub send_final
 566 {
 567         my $dxchan = shift;
 568         my $saver = shift;
 569         my $call = $dxchan->{call};
 570         my $buf;
 571
 572         dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll';
 573         if ($dxchan->{ve7cc}) {
 574                 my $call = $saver->[SOrigin];
 575                 $saver->[SOrigin] .= '-#';
 576                 $buf = VE7CC::dx_spot($dxchan, @$saver);
 577                 $saver->[SOrigin] = $call;
 578         } else {
 579                 my $call = $saver->[SOrigin];
 580                 $saver->[SOrigin] = substr($call, 0, 6);
 581                 $saver->[SOrigin] .= '-#';
 582                 $buf = $dxchan->format_dx_spot(@$saver);
 583                 $saver->[SOrigin] = $call;
 584         }
 585         $dxchan->local_send('R', $buf);
 586 }
 587
 588 # per second
 589 sub process
 590 {
 591         my $rbnskim = isdbg('rbnskim');
 592
 593         foreach my $dxchan (DXChannel::get_all()) {
 594                 next unless $dxchan->is_rbn;
 595
 596                 # At this point we run the queue to see if anything can be sent onwards to the punter
 597                 my $now = $main::systime;
 598                 my $ta = [gettimeofday];
 599                 my $items = 0;
 600
 601                 # now run the waiting queue which just contains KEYS ($call|$qrg)
 602                 foreach my $sp (keys %{$dxchan->{queue}}) {
 603                         my $cand = $spots->{$sp};
 604                         ++$items;
 605
 606                         unless ($cand && $cand->[CTime]) {
 607                                 dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime";
 608                                 delete $spots->{$sp};
 609                                 delete $dxchan->{queue}->{$sp};    # remove
 610                                 next;
 611                         }
 612
 613                         my $ctime = $cand->[CTime];
 614                         my $quality = @$cand - CData;
 615                         my $dwellsecs =  $now - $ctime;
 616                         if ($quality >= $maxqual || $dwellsecs >= $dwelltime || $dwellsecs >= $limbotime) {
 617                                 # we have a candidate, create qualitee value(s);
 618                                 unless (@$cand > CData) {
 619                                         dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbnqueue';
 620                                         delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
 621                                         delete $dxchan->{queue}->{$sp};
 622                                         next;
 623                                 }
 624                                 dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue';
 625                                 my $spotters = $quality;
 626
 627                                 # dump it and remove it from the queue if it is of unadequate quality, but only if it is no longer in Limbo and can be reasonably passed on to its demise
 628                                 my $r = $cand->[CData];
 629                                 if ($dwellsecs > $limbotime && $quality < $minqual) {
 630                                         if ( $rbnskim && isdbg('rbnskim')) {
 631                                                 $r = $cand->[CData];
 632                                                 if ($r) {
 633                                                         my $lastin = difft($ctime, $now, 2);
 634                                                         my $s = "RBN:SKIM time in Limbo exceeded DUMPED (lastin: $lastin Q:$quality < Q:$minqual) key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] route: $dxchan->{call}";
 635                                                         dbg($s);
 636                                                 }
 637                                         }
 638                                         delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
 639                                         delete $dxchan->{queue}->{$sp};
 640                                         next;
 641                                 }
 642
 643                                 # we have a possible removal from Limbo, check for more than one skimmer and reset the quality if required
 644                                 # DOES THIS TEST CAUSE RACES?
 645                                 if (!$r->[Respot] && $quality >= $minqual && $dwellsecs > $dwelltime+1) {
 646
 647                                         # because we don't need to check for repeats by the same skimmer in the normal case, we do here
 648                                         my %seen;
 649                                         my @origin;
 650                                         foreach my $wr (@$cand) {
 651                                                 next unless ref $wr;
 652                                                 push @origin, $wr->[ROrigin];
 653                                                 if (exists $seen{$wr->[ROrigin]}) {
 654                                                         next;
 655                                                 }
 656                                                 $seen{$wr->[ROrigin]} = $wr;
 657                                         }
 658                                         # reset the quality to ignore dupes
 659                                         my $oq = $quality;
 660                                         $quality = keys %seen;
 661                                         if ($quality >= $minqual) {
 662                                                 if ( $rbnskim && isdbg('rbnskim')) {
 663                                                         my $lastin = difft($ctime, $now, 2);
 664                                                         my $sk = join ' ', keys %seen;
 665                                                         my $or = join ' ', @origin;
 666                                                         my $s = "RBN:SKIM promoted from Limbo - key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk";
 667                                                         $s .= " was $or" if $or ne $sk;
 668                                                         $s .= ')';
 669                                                         dbg($s);
 670                                                 }
 671                                         } elsif ($oq != $quality) {
 672                                                 if ( $rbnskim && isdbg('rbnskim')) {
 673                                                         my $lastin = difft($ctime, $now, 2);
 674                                                         my $sk = join ' ', keys %seen;
 675                                                         my $or = join ' ', @origin;
 676                                                         my $s = "RBN:SKIM quality reset key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk was: $or)";
 677                                                         dbg($s);
 678                                                 }
 679                                                 # remove the excess
 680                                                 my @ncand = (@$cand[CTime, CQual], values %seen);
 681                                                 $spots->{$sp} = \@ncand;
 682                                         }
 683                                 }
 684
 685                                 # we now kick this spot into Limbo
 686                                 if ($quality < $minqual) {
 687                                         next;
 688                                 }
 689
 690                                 $quality = 9 if $quality > 9;
 691                                 $cand->[CQual] = $quality if $quality > $cand->[CQual];
 692
 693                                 # this scores each candidate according to its skimmer's QRG score (i.e. how often it agrees with its peers)
 694                                 # what happens is hash of all QRGs in candidates are incremented by that skimmer's reputation for "accuracy"
 695                                 # or, more exactly, past agreement with the consensus. This score can be from -5 -> +5.
 696                                 my %qrg = ();
 697                                 my $skimmer;
 698                                 my $sk;
 699                                 my $band;
 700                                 my %seen = ();
 701                                 foreach $r (@$cand) {
 702                                         next unless ref $r;
 703                                         if (exists $seen{$r->[ROrigin]}) {
 704                                                 $r = 0;
 705                                                 next;
 706                                         }
 707                                         $seen{$r->[ROrigin]} = 1;
 708                                         $band ||= int $r->[RQrg] / 1000;
 709                                         $sk = "SKIM|$r->[ROrigin]|$band"; # thus only once per set of candidates
 710                                         $skimmer = $spots->{$sk};
 711                                         unless ($skimmer) {
 712                                                 $skimmer = $spots->{$sk} = [1, 0, 0, $now, []]; # this first time, this new skimmer gets the benefit of the doubt on frequency.
 713                                                 dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if  $rbnskim && isdbg('rbnskim');
 714                                         }
 715                                         $qrg{$r->[RQrg]} += ($skimmer->[DScore] || 1);
 716                                 }
 717
 718                                 # determine the most likely qrg and then set it - NOTE (-)ve votes, generated by the skimmer scoring system above, are ignored
 719                                 my @deviant;
 720                                 my $c = 0;
 721                                 my $mv = 0;
 722                                 my $qrg = 0;
 723                                 while (my ($k, $votes) = each %qrg) {
 724                                         if ($votes >= $mv) {
 725                                                 $qrg = $k;
 726                                                 $mv = $votes;
 727                                         }
 728                                         ++$c;
 729                                 }
 730
 731                                 # Ignore possible spots with 0 QRG score - as determined by the skimmer scoring system above -  as they are likely to be wrong
 732                                 unless ($qrg > 0) {
 733                                         if ( $rbnskim && isdbg('rbnskim')) {
 734                                                 my $keys;
 735                                                 while (my ($k, $v) = (each %qrg)) {
 736                                                         $keys .= "$k=>$v, ";
 737                                                 }
 738                                                 $keys =~ /,\s*$/;
 739                                                 my $i = 0;
 740                                                 foreach $r (@$cand) {
 741                                                         next unless $r && ref $r;
 742                                                         dbg "RBN:SKIM cand $i QRG likely wrong from '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] (qrgs: $keys c: $c) route: $dxchan->{call}, ignored";
 743                                                         ++$i;
 744                                                 }
 745                                         }
 746                                         delete $spots->{$sp}; # get rid
 747                                         delete $dxchan->{queue}->{$sp};
 748                                         next;
 749                                 }
 750
 751                                 # detemine and spit out the deviants. Then adjust the scores according to whether it is a deviant or good
 752                                 # NOTE: deviant nodes can become good (or less bad), and good nodes bad (or less good) on each spot that
 753                                 # they generate. This is based solely on each skimmer's agreement (or not) with the "consensus" score generated
 754                                 # above ($qrg). The resultant score + good + bad is stored per band and will be used the next time a spot
 755                                 # appears on this band from each skimmer.
 756                                 foreach $r (@$cand) {
 757                                         next unless $r && ref $r;
 758                                         my $diff = $c > 1 ? nearest(.1, $r->[RQrg] - $qrg) : 0;
 759                                         $sk = "SKIM|$r->[ROrigin]|$band";
 760                                         $skimmer = $spots->{$sk};
 761                                         if ($diff) {
 762                                                 ++$skimmer->[DBad] if $skimmer->[DBad] < $maxdeviants;
 763                                                 --$skimmer->[DGood] if $skimmer->[DGood] > 0;
 764                                                 push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff);
 765                                                 push @{$skimmer->[DEviants]}, $diff;
 766                                                 shift @{$skimmer->[DEviants]} while @{$skimmer->[DEviants]} > $maxdeviants;
 767                                         } else {
 768                                                 ++$skimmer->[DGood] if $skimmer->[DGood] < $maxdeviants;
 769                                                 --$skimmer->[DBad] if $skimmer->[DBad] > 0;
 770                                                 shift @{$skimmer->[DEviants]};
 771                                         }
 772                                         $skimmer->[DScore] = $skimmer->[DGood] - $skimmer->[DBad];
 773                                         if ($rbnskim && isdbg('rbnskim')) {
 774                                                 my $lastin = difft($skimmer->[DLastin], $now, 2);
 775                                                 my $difflist = join(', ', @{$skimmer->[DEviants]});
 776                                                 $difflist = " band qrg diffs: $difflist" if $difflist;
 777                                                 dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff Skimmer score: $skimmer->[DGood] - $skimmer->[DBad] = $skimmer->[DScore] lastseen:$lastin ago$difflist");
 778                                         }
 779                                         $skimmer->[DLastin] = $now;
 780                                         $r->[RSpotData]->[SQrg] = $qrg if $qrg && $c > 1; # set all the QRGs to the agreed value
 781                                 }
 782
 783                                 $qrg = (sprintf "%.1f",  $qrg)+0;
 784                                 $r = $cand->[CData];
 785                                 $r->[RQrg] = $qrg;
 786                                 my $squality = "Q:$cand->[CQual]";
 787                                 $squality .= '*' if $c > 1;
 788                                 $squality .= '+' if $r->[Respot];
 789
 790                                 if (isdbg('progress')) {
 791                                         my $rt = difft($ctime, $now, 2);
 792                                         my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call} dwell:$rt";
 793                                         my $td = @deviant;
 794                                         $s .= " QRGScore: $mv Deviants: $td/$spotters";
 795                                         $s .= ' (' . join(', ', sort @deviant) . ')' if $td;
 796                                         dbg($s);
 797                                 }
 798
 799                                 # finally send it out to any waiting public
 800                                 send_dx_spot($dxchan, $squality, $cand);
 801
 802                                 # clear out the data and make this now just "spotted", but no further action required until respot time
 803                                 dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn';
 804
 805                                 delete $dxchan->{queue}->{$sp};
 806
 807                                 # calculate new sp (which will be 70% likely the same as the old one)
 808                                 # we do this to cope with the fact that the first spotter may well be "wrongly calibrated" giving a qrg that disagrees with the majority.
 809                                 # and we want to store the key that corresponds to majority opinion.
 810                                 my $nqrg = nearest(1, $qrg * 10);  # normalised to nearest Khz
 811                                 my $nsp = "$r->[RCall]|$nqrg";
 812                                 if ($sp ne $nsp) {
 813                                         dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if  $rbnskim && isdbg('rbnskim');
 814                                         delete $spots->{$sp};
 815                                         $spots->{$nsp} = [$now, $cand->[CQual]];
 816                                 } else {
 817                                         $spots->{$sp} = [$now, $cand->[CQual]];
 818                                 }
 819                         }
 820                         else {
 821                                 dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue';
 822                         }
 823                 }
 824                 if (isdbg('rbntimer')) {
 825                         my $diff = _diffus($ta);
 826                         dbg "RBN: TIMER process queue for call: $dxchan->{call} $items spots $diff uS";
 827                 }
 828         }
 829 }
 830
 831 sub per_minute
 832 {
 833         foreach my $dxchan (DXChannel::get_all()) {
 834                 next unless $dxchan->is_rbn;
 835                 dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} retrieved spots: $dxchan->{norbn} delivered: $dxchan->{nospot} after filtering to users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats');
 836                 if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) {
 837                         LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting");
 838                         $dxchan->disconnect;
 839                 }
 840                 $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {};
 841                 $runtime{$dxchan->{call}} += 60;
 842         }
 843
 844         # save the spot cache
 845         write_cache() unless $main::systime + $startup_delay < $main::systime;;
 846 }
 847
 848 sub per_10_minute
 849 {
 850         my $count = 0;
 851         my $removed = 0;
 852         while (my ($k,$cand) = each %{$spots}) {
 853                 next if $k eq 'VERSION';
 854                 next if $k =~ /^O\|/;
 855                 next if $k =~ /^SKIM\|/;
 856
 857                 if ($main::systime - $cand->[CTime] > $minspottime*2) {
 858                         delete $spots->{$k};
 859                         ++$removed;
 860                 }
 861                 else {
 862                         ++$count;
 863                 }
 864         }
 865         dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn');
 866         foreach my $dxchan (DXChannel::get_all()) {
 867                 next unless $dxchan->is_rbn;
 868                 my $nq = keys %{$dxchan->{queue}};
 869                 my $pc = $dxchan->{noraw10} ? sprintf("%.1f%%",$dxchan->{norbn10}*100/$dxchan->{noraw10}) : '0.0%';
 870                 dbg "RBN:STATS 10-minute $dxchan->{call} queue: $nq raw: $dxchan->{noraw10} retrieved spots: $dxchan->{norbn10} ($pc) delivered: $dxchan->{nospot10} after filtering to  users: " . scalar keys %{$dxchan->{nousers10}};
 871                 $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
 872         }
 873 }
 874
 875 sub per_hour
 876 {
 877         foreach my $dxchan (DXChannel::get_all()) {
 878                 next unless $dxchan->is_rbn;
 879                 my $nq = keys %{$dxchan->{queue}};
 880                 my $pc = $dxchan->{norawhour} ? sprintf("%.1f%%",$dxchan->{norbnhour}*100/$dxchan->{norawhour}) : '0.0%';
 881                 dbg "RBN:STATS hour $dxchan->{call} queue: $nq raw: $dxchan->{norawhour} retrieved spots: $dxchan->{norbnhour} ($pc) delivered: $dxchan->{nospothour} after filtering to users: " . scalar keys %{$dxchan->{nousershour}};
 882                 $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
 883         }
 884 }
 885
 886 sub finish
 887 {
 888         write_cache();
 889 }
 890
 891 sub write_cache
 892 {
 893         my $ta = [ gettimeofday ];
 894         $json->indent(1)->canonical(1) if isdbg 'rbncache';
 895         my $s = eval {$json->encode($spots)};
 896         if ($s) {
 897                 my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!");
 898                 $fh->print($s);
 899                 $fh->close;
 900         } else {
 901                 dbg("RBN:Write_cache error '$@'");
 902                 return;
 903         }
 904         $json->indent(0)->canonical(0);
 905         my $diff = _diffms($ta);
 906         my $size = sprintf('%.3fKB', (length($s) / 1000));
 907         dbg("RBN:WRITE_CACHE size: $size time to write: $diff mS");
 908 }
 909
 910 sub check_cache
 911 {
 912         if (-e $cachefn) {
 913                 my $mt = (stat($cachefn))[9];
 914                 my $t = $main::systime - $mt || 1;
 915                 my $p = difft($mt, 2);
 916                 if ($t < $cache_valid) {
 917                         dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old");
 918                         my $fh = IO::File->new($cachefn);
 919                         my $s;
 920                         if ($fh) {
 921                                 local $/ = undef;
 922                                 $s = <$fh>;
 923                                 dbg("RBN:check_cache cache read size " . length $s);
 924                                 $fh->close;
 925                         } else {
 926                                 dbg("RBN:check_cache file read error $!");
 927                                 return undef;
 928                         }
 929                         if ($s) {
 930                                 eval {$spots = $json->decode($s)};
 931                                 if ($spots && ref $spots) {
 932                                         if (exists $spots->{VERSION} && $spots->{VERSION} == $DATA_VERSION) {
 933                                                 # now clean out anything that has spot build ups in progress
 934                                                 while (my ($k, $cand) = each %$spots) {
 935                                                         next if $k eq 'VERSION';
 936                                                         next if $k =~ /^O\|/;
 937                                                         next if $k =~ /^SKIM\|/;
 938                                                         if (@$cand > CData) {
 939                                                                 $spots->{$k} = [$cand->[CTime], $cand->[CQual]];
 940                                                         }
 941                                                 }
 942                                                 dbg("RBN:check_cache spot cache restored");
 943                                                 return 1;
 944                                         }
 945                                 }
 946                                 dbg("RBN::checkcache error decoding $@");
 947                         }
 948                 } else {
 949                         my $d = difft($main::systime-$cache_valid);
 950                         dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");
 951                 }
 952         } else {
 953                 dbg("RBN:check_cache '$cachefn' spot cache not present");
 954         }
 955
 956         return undef;
 957 }
 958
 959 sub add_seeme
 960 {
 961         my $call = shift;
 962         $seeme{$call} = 1;
 963 }
 964
 965 sub del_seeme
 966 {
 967         my $call = shift;
 968         delete $seeme{$call};
 969 }
 970 1;