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