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