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