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 $showrbn;
  29 my $help = 0;
  30 my $man = 0;
  31 my $mycall;
  32
  33 GetOptions('host=s' => \$host,
  34                    'port=i' => \$port,
  35                    'debug' => \$dbg,
  36                    'rbn' => \$showrbn,
  37                    'stats' => \$showstats,
  38                    'repeattime=i' => sub { $minspottime = $_[1] * 60 },
  39                    'want=s' => sub {
  40                            my ($name, $value) = @_;
  41                            $wantcw = $wantrtty = $wantpsk = $wantbeacon = 0;
  42                            for (split /:,|/, $value) {
  43                                    ++$wantcw if /^cw$/i;
  44                                    ++$wantpsk if /^psk$/i;
  45                                    ++$wantrtty if /^rtty$/i;
  46                                    ++$wantbeacon if /^beacon$/i;
  47                            }
  48                    },
  49                    'help|?' => \$help,
  50                    man => \$man,
  51                    '<>' => sub { $mycall = shift },
  52                   ) or pod2usage(2);
  53
  54 $mycall ||= shift;
  55
  56 pod2usage(1) if $help || !$mycall;
  57 pod2usage(-exitval => 0, -verbose => 2) if $man;
  58
  59
  60 for ($attempts = 1; $attempts <= 5; ++$attempts) {
  61         say "admin,connecting to $host $port.. (attempt $attempts) " if $dbg;
  62         $sock = IO::Socket::IP->new(
  63                                                                 PeerHost => $host,
  64                                                                 PeerPort => $port,
  65                                                                 Timeout => 2,
  66                                                            );
  67         last if $sock;
  68 }
  69
  70 die "admin,Cannot connect to $host:$port after 5 attempts $!" unless $sock;
  71 say "admin,connected" if $dbg;
  72 print $sock "$mycall\r\n";
  73 say "admin,call sent" if $dbg;
  74
  75 my %d;
  76 my %spot;
  77
  78 my $last = 0;
  79 my $noraw = 0;
  80 my $norbn = 0;
  81 my $nospot = 0;
  82
  83 while (<$sock>) {
  84         chomp;
  85         my $tim = time;
  86
  87         # parse line
  88         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) = split /[:\s]+/;
  89         if ($t) {
  90
  91                 # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
  92                 # This works because the skimmers are NTP controlled (or should be) and will receive
  93                 # the spot at the same time (velocity factor of the atmosphere taken into account :-)
  94                 my $p = "$t|$call";
  95                 ++$noraw;
  96                 next if $d{$p};
  97
  98                 # new RBN input
  99                 $d{$p} = $tim;
 100                 ++$norbn;
 101                 $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
 102                 say join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if $dbg || $showrbn;
 103
 104                 # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
 105                 # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
 106                 # before then "RESPOT" it.
 107                 my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
 108                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 109                 my $ts = $spot{$sp};
 110
 111                 if (!$ts || ($minspottime > 0 && $tim - $ts >= $minspottime)) {
 112                         if ($wantbeacon && $sort =~ /^BEA/) {
 113                                 ;
 114                         } else {
 115                                 # Haven't used a perl 'goto' like this ever!
 116                                 # Clearly I need to use an event driven framework :-)
 117                                 goto periodic if !$wantcw  && $mode =~ /^CW/;
 118                                 goto periodic if !$wantrtty && $mode =~ /^RTTY/;
 119                                 goto periodic if !$wantpsk && $mode =~ /^PSK/;
 120                         }
 121
 122                         ++$nospot;
 123                         my $tag = $ts ? "RESPOT" : "SPOT";
 124                         say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 125                         $spot{$sp} = $tim;
 126                 }
 127         } else {
 128                 say "data,$_" if $dbg;
 129         }
 130
 131  periodic:
 132         # periodic clearing out of the two caches
 133         if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
 134                 my $count = 0;
 135                 my $removed = 0;
 136
 137                 while (my ($k,$v) = each %d) {
 138                         if ($tim-$v > 60) {
 139                                 delete $d{$k};
 140                                 ++$removed
 141                         } else {
 142                                 ++$count;
 143                         }
 144                 }
 145                 say "admin,rbn cache: $removed removed $count remain" if $dbg;
 146                 $count = $removed = 0;
 147                 while (my ($k,$v) = each %spot) {
 148                         if ($tim-$v > $minspottime*2) {
 149                                 delete $spot{$k};
 150                                 ++$removed;
 151                         } else {
 152                                 ++$count;
 153                         }
 154                 }
 155                 say "admin,spot cache: $removed removed $count remain" if $dbg;
 156
 157                 say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
 158                 $noraw = $norbn = $nospot = 0;
 159
 160                 $last = int($tim / 60) * 60;
 161         }
 162 }
 163
 164
 165 close $sock;
 166 exit 0;
 167
 168 __END__
 169
 170 =head1 NAME
 171
 172 rbn.pl - an experimental RBN filter program that
 173
 174 =head1 SYNOPSIS
 175
 176 rbn.pl [options] <your callsign>
 177
 178 =head1 OPTIONS
 179
 180 =over 8
 181
 182 =item B<-help>
 183
 184 Print a brief help message and exits.
 185
 186 =item B<-man>
 187
 188 Prints the manual page and exits.
 189
 190 =item B<-host>=telnet.reversebeacon.net
 191
 192 As default, this program will connect to C<telnet.reversebeacon.net>. Use this argument to change that.
 193
 194 =item B<-port>=7000
 195
 196 As default, this program will connect to port 7000. Use this argument to change that to some other port.
 197
 198 =item B<-want>=cw,rtty,psk,beacon
 199
 200 The program will print all spots in all classes [cw, rtty, psk, beacon]. You can choose one or more of
 201 these classes if you want specific types of spots.
 202
 203 =item B<-stats>
 204
 205 Print a comma separated line of statistics once a minute which consists of:
 206
 207 STAT,E<lt>raw RBN spotsE<gt>,E<lt>de-duped RBN spotsE<gt>,E<lt>new spotsE<gt>
 208
 209 =item B<-repeattime=60>
 210
 211 A cache of callsigns and QRGs is kept. If a SPOT comes in after B<repeattime> minutes then it re-emitted
 212 but with a RESPOT tag instead. Set this argument to 0 (or less) if you do not want any repeats.
 213
 214 =item B<-rbn>
 215
 216 Show the de-duplicated RBN lines as they come in.
 217
 218 =back
 219
 220 =head1 DESCRIPTION
 221
 222 B<This program> connects (as default) to RBN C<telnet.reversebeacon.net:7000> and parses the raw output
 223 which it deduplicates and then outputs unique spots. It is possible to select one or more types of spot.
 224
 225 The output is the RBN spot line which has been separated out into a comma separated list. One line per spot.
 226
 227 Like this:
 228
 229   SPOT,DK3UA-#,3560.0,DL6ZB,CW,27,dB,26,WPM,CQ,2152Z
 230   SPOT,WB6BEE-#,14063.0,KD6SX,CW,24,dB,15,WPM,CQ,2152Z
 231   RESPOT,S50ARX-#,1811.5,OM0CS,CW,37,dB,19,WPM,CQ,2152Z
 232   SPOT,DF4UE-#,3505.0,TA1PT,CW,11,dB,23,WPM,CQ,2152Z
 233   SPOT,AA4VV-#,14031.0,TF3Y,CW,16,dB,22,WPM,CQ,2152Z
 234   SPOT,SK3W-#,3600.0,OK0EN,CW,13,dB,11,WPM,BEACON,2152Z
 235   STAT,263,64,27
 236
 237 =cut
 238