perl/rbn.pl

   1 #!/usr/bin/perl
   2 #
   3 # An RBN deduping filter
   4 #
   5 # Copyright (c) 2017 Dirk Koopman G1TLH
   6 #
   7
   8 use strict;
   9 use 5.10.1;
  10 use IO::Socket::IP -register;
  11 use Math::Round qw(nearest);
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 my $host = 'telnet.reversebeacon.net';
  16 my $port = 7000;
  17
  18 my $minspottime = 60*60;                # minimum length of time between successive identical spots
  19 my $showstats;                                  # show RBN and Spot stats
  20
  21 my $attempts;
  22 my $sock;
  23 my $dbg;
  24 my $wantcw = 1;
  25 my $wantrtty = 1;
  26 my $wantpsk = 1;
  27 my $wantbeacon = 1;
  28 my $wantdx = 1;
  29 my $wantft = 1;
  30 my $wantpsk = 1;
  31 my $wantraw = 0;
  32 my $showrbn;
  33 my $help = 0;
  34 my $man = 0;
  35 my $mycall;
  36
  37 #Getopt::Long::Configure( qw(auto_abbrev) );
  38 GetOptions('host=s' => \$host,
  39                    'port=i' => \$port,
  40                    'debug' => \$dbg,
  41                    'rbn' => \$showrbn,
  42                    'stats' => \$showstats,
  43                    'raw' => \$wantraw,
  44                    'repeattime|rt=i' => sub { $minspottime = $_[1] * 60 },
  45                    'want=s' => sub {
  46                            my ($name, $value) = @_;
  47                            $wantcw = $wantrtty = $wantpsk = $wantbeacon = $wantdx = $wantft = $wantpsk = 0;
  48                            for (split /[:,\|]/, $value) {
  49                                    ++$wantcw if /^cw$/i;
  50                                    ++$wantpsk if /^psk$/i;
  51                                    ++$wantrtty if /^rtty$/i;
  52                                    ++$wantbeacon if /^beacon/i;
  53                                    ++$wantdx if /^dx$/i;
  54                                    ++$wantft if /^ft$/;
  55                                    ++$wantft, ++$wantrtty, ++$wantpsk if /^digi/;
  56                            }
  57                    },
  58                    'help|?' => \$help,
  59                    'man' => \$man,
  60                    '<>' => sub { $mycall = shift },
  61                   ) or pod2usage(2);
  62
  63 $mycall ||= shift;
  64
  65 pod2usage(1) if $help || !$mycall;
  66 pod2usage(-exitval => 0, -verbose => 2) if $man;
  67
  68
  69 for ($attempts = 1; $attempts <= 5; ++$attempts) {
  70         say "ADMIN,connecting to $host $port.. (attempt $attempts) " if $dbg;
  71         $sock = IO::Socket::IP->new(
  72                                                                 PeerHost => $host,
  73                                                                 PeerPort => $port,
  74                                                                 Timeout => 2,
  75                                                            );
  76         last if $sock;
  77 }
  78
  79 die "ADMIN,Cannot connect to $host:$port after 5 attempts $!\n" unless $sock;
  80 say "ADMIN,connected" if $dbg;
  81 $sock->timeout(0);
  82
  83 print $sock "$mycall\r\n";
  84 say "ADMIN,call $mycall sent" if $dbg;
  85
  86 my %d;
  87 my %spot;
  88
  89 my $last = 0;
  90 my $noraw = 0;
  91 my $norbn = 0;
  92 my $nospot = 0;
  93
  94 while (<$sock>) {
  95         chomp;
  96         s/\s*$//;
  97
  98         my $tim = time;
  99
 100         # parse line
 101         say "RAW,$_" if $wantraw;
 102
 103         if (/call:/) {
 104                 print $sock "$mycall\r\n";
 105                 say "ADMIN,call $mycall sent" if $dbg;
 106         }
 107
 108         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/;
 109         my $b;
 110
 111         if ($t || $tx) {
 112
 113                 # fix up times for things like 'NXDXF B' etc
 114                 if ($tx && $t !~ /^\d{4}Z$/) {
 115                         if ($tx =~ /^\d{4}Z$/) {
 116                                 $b = $t;
 117                                 $t = $tx;
 118                         } else {
 119                                 say "ERR,$_";
 120                                 next;
 121                         }
 122                 }
 123
 124                 # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
 125                 # This works because the skimmers are NTP controlled (or should be) and will receive
 126                 # the spot at the same time (velocity factor of the atmosphere and network delays
 127                 # carefully (not) taken into account :-)
 128
 129                 # Note, there is no intelligence here, but there are clearly basic heuristics that could
 130                 # be applied at this point that reject (more likely rewrite) the call of a busted spot that would
 131                 # useful for a zonal hotspot requirement from the cluster node.
 132
 133                 # In reality, this mechanism would be incorporated within the cluster code, utilising the dxqsl database,
 134                 # and other resources in DXSpider, thus creating a zone map for an emitted spot. This is then passed through the
 135                 # normal "to-user" spot system (where normal spots are sent to be displayed per user) and then be
 136                 # processed through the normal, per user, spot filtering system - like a regular spot.
 137
 138                 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
 139         # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
 140                 # 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)
 141                 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
 142         # and spotted. A map can be generated once per user and spotter as they are essentially mostly static.
 143                 # The spotted will only get a coarse position unless other info is available. Programs that parse
 144                 # DX bulletins and the online data online databases could be be used and then cached.
 145
 146                 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
 147                 # ignored.
 148
 149                 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
 150                 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
 151                 # process to just the standard "message passing" which has been shown to be able to sustain over 5000
 152                 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
 153
 154                 my $p = "$t|$call";
 155                 ++$noraw;
 156                 next if $d{$p};
 157
 158                 # new RBN input
 159                 $d{$p} = $tim;
 160                 ++$norbn;
 161                 $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
 162                 if (!$wantraw && ($dbg || $showrbn)) {
 163                         my $s = join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 164                         $s .= ",$b" if $b;
 165                         say $s;
 166                 }
 167
 168                 # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
 169                 # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
 170                 # before then "RESPOT" it.
 171                 my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
 172                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 173                 my $ts = $spot{$sp};
 174
 175                 if (!$ts || ($minspottime > 0 && $tim - $ts >= $minspottime)) {
 176                         my $want;
 177
 178                         ++$want if $wantbeacon && $sort =~ /^BEA|NCD/;
 179                         ++$want if $wantcw && $mode =~ /^CW/;
 180                         ++$want if $wantrtty && $mode =~ /^RTTY/;
 181                         ++$want if $wantpsk && $mode =~ /^PSK/;
 182                         ++$want if $wantdx && $mode =~ /^DX/;
 183                         ++$want if $wantft && $mode =~ /^FT/;
 184                         if ($want) {
 185                                 ++$nospot;
 186                                 my $tag = $ts ? "RESPOT" : "SPOT";
 187                                 $t .= ",$b" if $b;
 188                                 say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 189                                 $spot{$sp} = $tim;
 190                         }
 191                 }
 192         } else {
 193                 say "DATA,$_" if $dbg && !$wantraw;
 194         }
 195
 196         # periodic clearing out of the two caches
 197         if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
 198                 my $count = 0;
 199                 my $removed = 0;
 200
 201                 while (my ($k,$v) = each %d) {
 202                         if ($tim-$v > 60) {
 203                                 delete $d{$k};
 204                                 ++$removed
 205                         } else {
 206                                 ++$count;
 207                         }
 208                 }
 209                 say "ADMIN,rbn cache: $removed removed $count remain" if $dbg;
 210                 $count = $removed = 0;
 211                 while (my ($k,$v) = each %spot) {
 212                         if ($tim-$v > $minspottime*2) {
 213                                 delete $spot{$k};
 214                                 ++$removed;
 215                         } else {
 216                                 ++$count;
 217                         }
 218                 }
 219                 say "ADMIN,spot cache: $removed removed $count remain" if $dbg;
 220
 221                 say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
 222                 $noraw = $norbn = $nospot = 0;
 223
 224                 $last = int($tim / 60) * 60;
 225         }
 226 }
 227
 228
 229 close $sock;
 230 exit 0;
 231
 232 __END__
 233
 234 =head1 NAME
 235
 236 rbn.pl - an experimental RBN filter program
 237
 238 =head1 SYNOPSIS
 239
 240 rbn.pl [options] <any callsign>
 241
 242 We read the raw data
 243 from the RBN. We collect similar spots on a frequency within 100hz and try to
 244 deduce which if them is likely to be the true callsign. Emitted spots are cached and thereafter ignored
 245 for a period until it is spotted again, when it may be emitted again - but marked as a RESPOT.
 246
 247 This is just technology demonstrator designed to scope out the issues and make sure that the line decoding works
 248 in all circumstances. But even on busy weekends it seems to cope just fine deduping away within its limits.
 249
 250 To see it work at its best, run it as: rbn.pl -stats <any callsign>
 251
 252 Leave it running for some time, preferably several (10s of) minutes.
 253 You will see it slowly reduce the number of new spots until you start to see "RESPOT" lines. Reductions
 254 of more than one order of magnitude is normal. Particularly when there are many more spotters.
 255
 256 =head1 OPTIONS
 257
 258 =over 8
 259
 260 =item B<-help>
 261
 262 Print a brief help message and exits.
 263
 264 =item B<-man>
 265
 266 Prints the manual page and exits.
 267
 268 =item B<-host>=telnet.reversebeacon.net
 269
 270 As default, this program will connect to C<telnet.reversebeacon.net>. Use this argument to change that.
 271
 272 =item B<-port>=7000
 273
 274 As default, this program will connect to port 7000. Use this argument to change that to some other port.
 275
 276 =item B<-want>=cw,rtty,dx,beacon,psk,ft,digital
 277
 278 The program will print all spots in all classes in the 'mode/calling' column [cw, rtty, beacon, dx, psk, ft, digital]. You can choose one or more of
 279 these classes if you want specific types of spots. The class 'digital' is equivalent to [rtty,psk,ft]. The class 'beacon' includes
 280 NCDXF beacons.
 281
 282 E.g. rbn.pl -want=psk,ft,beacon g9tst
 283
 284 =item B<-stats>
 285
 286 Print a comma separated line of statistics once a minute which consists of:
 287
 288 STAT,E<lt>raw RBN spotsE<gt>,E<lt>de-duped RBN spotsE<gt>,E<lt>new spotsE<gt>
 289
 290 =item B<-repeattime=60>
 291
 292 A cache of callsigns and QRGs is kept. If a SPOT comes in after B<repeattime> minutes then it re-emitted
 293 but with a RESPOT tag instead. Set this argument to 0 (or less) if you do not want any repeats.
 294
 295 =item B<-rbn>
 296
 297 Show the de-duplicated RBN lines as they come in.
 298
 299 =item B<-raw>
 300
 301 Show the raw RBN lines as they come in.
 302
 303 =back
 304
 305 =head1 DESCRIPTION
 306
 307 B<This program> connects (as default) to RBN C<telnet.reversebeacon.net:7000> and parses the raw output
 308 which it deduplicates and then outputs unique spots. It is possible to select one or more types of spot.
 309
 310 The output is the RBN spot line which has been separated out into a comma separated list. One line per spot.
 311
 312 Like this:
 313
 314   SPOT,DK3UA-#,3560.0,DL6ZB,CW,27,dB,26,WPM,CQ,2152Z
 315   SPOT,WB6BEE-#,14063.0,KD6SX,CW,24,dB,15,WPM,CQ,2152Z
 316   RESPOT,S50ARX-#,1811.5,OM0CS,CW,37,dB,19,WPM,CQ,2152Z
 317   SPOT,DF4UE-#,3505.0,TA1PT,CW,11,dB,23,WPM,CQ,2152Z
 318   SPOT,AA4VV-#,14031.0,TF3Y,CW,16,dB,22,WPM,CQ,2152Z
 319   SPOT,SK3W-#,3600.0,OK0EN,CW,13,dB,11,WPM,BEACON,2152Z
 320   STAT,263,64,27
 321
 322 If the -raw flag is set then these lines will be interspersed with the raw line from the RBN source, prefixed
 323 with "RAW,". For example:
 324
 325   RAW,DX de PJ2A-#:    14025.4  IP0TRC         CW    16 dB  31 WPM  CQ      1307Z
 326   RAW,DX de PJ2A-#:    10118.9  K1JD           CW     2 dB  28 WPM  CQ      1307Z
 327   RAW,DX de K2PO-#:     1823.4  HL5IV          CW     8 dB  22 WPM  CQ      1307Z
 328   SPOT,K2PO-#,1823.4,HL5IV,CW,8,dB,22,WPM,CQ,1307Z
 329   RAW,DX de LZ7AA-#:   14036.6  HA8GZ          CW     7 dB  27 WPM  CQ      1307Z
 330   RAW,DX de DF4UE-#:   14012.0  R7KM           CW    32 dB  33 WPM  CQ      1307Z
 331   RAW,DX de G7SOZ-#:   14012.2  R7KM           CW    17 dB  31 WPM  CQ      1307Z
 332
 333
 334 =cut
 335