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 taken into account :-)
 125                 my $p = "$t|$call";
 126                 ++$noraw;
 127                 next if $d{$p};
 128
 129                 # new RBN input
 130                 $d{$p} = $tim;
 131                 ++$norbn;
 132                 $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
 133                 if (!$wantraw && ($dbg || $showrbn)) {
 134                         my $s = join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 135                         $s .= ",$b" if $b;
 136                         say $s;
 137                 }
 138
 139                 # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
 140                 # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
 141                 # before then "RESPOT" it.
 142                 my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
 143                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 144                 my $ts = $spot{$sp};
 145
 146                 if (!$ts || ($minspottime > 0 && $tim - $ts >= $minspottime)) {
 147                         my $want;
 148
 149                         ++$want if $wantbeacon && $sort =~ /^BEA|NCD/;
 150                         ++$want if $wantcw && $mode =~ /^CW/;
 151                         ++$want if $wantrtty && $mode =~ /^RTTY/;
 152                         ++$want if $wantpsk && $mode =~ /^PSK/;
 153                         ++$want if $wantdx && $mode =~ /^DX/;
 154                         ++$want if $wantft && $mode =~ /^FT/;
 155                         if ($want) {
 156                                 ++$nospot;
 157                                 my $tag = $ts ? "RESPOT" : "SPOT";
 158                                 $t .= ",$b" if $b;
 159                                 say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 160                                 $spot{$sp} = $tim;
 161                         }
 162                 }
 163         } else {
 164                 say "DATA,$_" if $dbg && !$wantraw;
 165         }
 166
 167         # periodic clearing out of the two caches
 168         if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
 169                 my $count = 0;
 170                 my $removed = 0;
 171
 172                 while (my ($k,$v) = each %d) {
 173                         if ($tim-$v > 60) {
 174                                 delete $d{$k};
 175                                 ++$removed
 176                         } else {
 177                                 ++$count;
 178                         }
 179                 }
 180                 say "ADMIN,rbn cache: $removed removed $count remain" if $dbg;
 181                 $count = $removed = 0;
 182                 while (my ($k,$v) = each %spot) {
 183                         if ($tim-$v > $minspottime*2) {
 184                                 delete $spot{$k};
 185                                 ++$removed;
 186                         } else {
 187                                 ++$count;
 188                         }
 189                 }
 190                 say "ADMIN,spot cache: $removed removed $count remain" if $dbg;
 191
 192                 say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
 193                 $noraw = $norbn = $nospot = 0;
 194
 195                 $last = int($tim / 60) * 60;
 196         }
 197 }
 198
 199
 200 close $sock;
 201 exit 0;
 202
 203 __END__
 204
 205 =head1 NAME
 206
 207 rbn.pl - an experimental RBN filter program that
 208
 209 =head1 SYNOPSIS
 210
 211 rbn.pl [options] <your callsign>
 212
 213 =head1 OPTIONS
 214
 215 =over 8
 216
 217 =item B<-help>
 218
 219 Print a brief help message and exits.
 220
 221 =item B<-man>
 222
 223 Prints the manual page and exits.
 224
 225 =item B<-host>=telnet.reversebeacon.net
 226
 227 As default, this program will connect to C<telnet.reversebeacon.net>. Use this argument to change that.
 228
 229 =item B<-port>=7000
 230
 231 As default, this program will connect to port 7000. Use this argument to change that to some other port.
 232
 233 =item B<-want>=cw,rtty,dx,beacon,psk,ft,digital
 234
 235 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
 236 these classes if you want specific types of spots. The class 'digital' is equivalent to [rtty,psk,ft]. The class 'beacon' includes
 237 NCDXF beacons.
 238
 239 E.g. rbn.pl -want=psk,ft,beacon g9tst
 240
 241 =item B<-stats>
 242
 243 Print a comma separated line of statistics once a minute which consists of:
 244
 245 STAT,E<lt>raw RBN spotsE<gt>,E<lt>de-duped RBN spotsE<gt>,E<lt>new spotsE<gt>
 246
 247 =item B<-repeattime=60>
 248
 249 A cache of callsigns and QRGs is kept. If a SPOT comes in after B<repeattime> minutes then it re-emitted
 250 but with a RESPOT tag instead. Set this argument to 0 (or less) if you do not want any repeats.
 251
 252 =item B<-rbn>
 253
 254 Show the de-duplicated RBN lines as they come in.
 255
 256 =item B<-raw>
 257
 258 Show the raw RBN lines as they come in.
 259
 260 =back
 261
 262 =head1 DESCRIPTION
 263
 264 B<This program> connects (as default) to RBN C<telnet.reversebeacon.net:7000> and parses the raw output
 265 which it deduplicates and then outputs unique spots. It is possible to select one or more types of spot.
 266
 267 The output is the RBN spot line which has been separated out into a comma separated list. One line per spot.
 268
 269 Like this:
 270
 271   SPOT,DK3UA-#,3560.0,DL6ZB,CW,27,dB,26,WPM,CQ,2152Z
 272   SPOT,WB6BEE-#,14063.0,KD6SX,CW,24,dB,15,WPM,CQ,2152Z
 273   RESPOT,S50ARX-#,1811.5,OM0CS,CW,37,dB,19,WPM,CQ,2152Z
 274   SPOT,DF4UE-#,3505.0,TA1PT,CW,11,dB,23,WPM,CQ,2152Z
 275   SPOT,AA4VV-#,14031.0,TF3Y,CW,16,dB,22,WPM,CQ,2152Z
 276   SPOT,SK3W-#,3600.0,OK0EN,CW,13,dB,11,WPM,BEACON,2152Z
 277   STAT,263,64,27
 278
 279 If the -raw flag is set then these lines will be interspersed with the raw line from the RBN source, prefixed
 280 with "RAW,". For example:
 281
 282   RAW,DX de PJ2A-#:    14025.4  IP0TRC         CW    16 dB  31 WPM  CQ      1307Z
 283   RAW,DX de PJ2A-#:    10118.9  K1JD           CW     2 dB  28 WPM  CQ      1307Z
 284   RAW,DX de K2PO-#:     1823.4  HL5IV          CW     8 dB  22 WPM  CQ      1307Z
 285   SPOT,K2PO-#,1823.4,HL5IV,CW,8,dB,22,WPM,CQ,1307Z
 286   RAW,DX de LZ7AA-#:   14036.6  HA8GZ          CW     7 dB  27 WPM  CQ      1307Z
 287   RAW,DX de DF4UE-#:   14012.0  R7KM           CW    32 dB  33 WPM  CQ      1307Z
 288   RAW,DX de G7SOZ-#:   14012.2  R7KM           CW    17 dB  31 WPM  CQ      1307Z
 289
 290
 291 =cut
 292