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
  13 my $host = 'telnet.reversebeacon.net';
  14 my $port = 7000;
  15 my $mycall = shift or die "usage:rbn.pl <callsign> [debug] [stats] [cw] [rtty] [psk] [beacon] [<time between repeat spots in minutes>]\n";
  16
  17 my $minspottime = 30*60;                # minimum length of time between successive spots
  18 my $showstats;                                  # show RBN and Spot stats
  19
  20 my $attempts;
  21 my $sock;
  22 my $dbg;
  23 my $wantcw = 1;
  24 my $wantrtty = 1;
  25 my $wantpsk = 1;
  26 my $wantbeacon = 1;
  27 my $override;
  28
  29 while (@ARGV) {
  30         my $arg = shift;
  31
  32         ++$dbg if $arg =~ /^deb/i;
  33         ++$showstats if $arg =~ /^stat/i;
  34         $minspottime = $arg * 60 if $arg =~ /^\d+$/;
  35         if (!$override && $arg =~ /^cw|rtty|psk|beacon$/i) {
  36                 $override = 1;
  37                 $wantcw = $wantrtty = $wantpsk = $wantbeacon = 0;
  38         }
  39         ++$wantcw if $arg =~ /^cw$/i;
  40         ++$wantpsk if $arg =~ /^psk$/i;
  41         ++$wantrtty if $arg =~ /^rtty$/i;
  42         ++$wantbeacon if $arg =~ /^beacon$/i;
  43 }
  44
  45 for ($attempts = 1; $attempts <= 5; ++$attempts) {
  46         say "admin,connecting to $host $port.. (attempt $attempts) " if $dbg;
  47         $sock = IO::Socket::IP->new(
  48                                                                 PeerHost => $host,
  49                                                                 PeerPort => $port,
  50                                                                 Timeout => 2,
  51                                                            );
  52         last if $sock;
  53 }
  54
  55 die "admin,Cannot connect to $host:$port after 5 attempts $!" unless $sock;
  56 say "admin,connected" if $dbg;
  57 print $sock "$mycall\r\n";
  58 say "admin,call sent" if $dbg;
  59
  60 my %d;
  61 my %spot;
  62
  63 my $last = 0;
  64 my $noraw = 0;
  65 my $norbn = 0;
  66 my $nospot = 0;
  67
  68 while (<$sock>) {
  69         chomp;
  70         my $tim = time;
  71
  72         # periodic clearing out of the two caches
  73         if ($tim % 60 == 0 && $last != $tim) {
  74                 my $count = 0;
  75                 my $removed = 0;
  76
  77                 while (my ($k,$v) = each %d) {
  78                         if ($tim-$v > 60) {
  79                                 delete $d{$k};
  80                                 ++$removed
  81                         } else {
  82                                 ++$count;
  83                         }
  84                 }
  85                 say "admin,rbn cache: $removed removed $count remain" if $dbg;
  86                 $count = $removed = 0;
  87                 while (my ($k,$v) = each %spot) {
  88                         if ($tim-$v > $minspottime*2) {
  89                                 delete $spot{$k};
  90                                 ++$removed;
  91                         } else {
  92                                 ++$count;
  93                         }
  94                 }
  95                 say "admin,spot cache: $removed removed $count remain" if $dbg;
  96
  97                 say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
  98                 $noraw = $norbn = $nospot = 0;
  99
 100                 $last = $tim;
 101         }
 102
 103         # parse line
 104         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) = split /[:\s]+/;
 105         if ($t) {
 106
 107                 # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
 108                 # This works because the skimmers are NTP controlled (or should be) and will receive
 109                 # the spot at the same time (velocity factor of the atmosphere taken into account :-)
 110                 my $p = "$t|$call";
 111                 ++$noraw;
 112                 next if $d{$p};
 113
 114                 # new RBN input
 115                 $d{$p} = $tim;
 116                 ++$norbn;
 117                 $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
 118                 say join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if $dbg;
 119
 120                 # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
 121                 # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
 122                 # before then "RESPOT" it.
 123                 my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
 124                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 125                 my $ts = $spot{$sp};
 126
 127                 if (!$ts || $tim - $ts >= $minspottime) {
 128                         if ($wantbeacon && $sort =~ /^BEA/) {
 129                                 ;
 130                         } else {
 131                                 next if !$wantcw  && $mode =~ /^CW/;
 132                                 next if !$wantrtty && $mode =~ /^RTTY/;
 133                                 next if !$wantpsk && $mode =~ /^PSK/;
 134                         }
 135
 136                         ++$nospot;
 137                         my $tag = $ts ? "RESPOT" : "SPOT";
 138                         say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 139                         $spot{$sp} = $tim;
 140                 }
 141         } else {
 142                 say "data,$_" if $dbg;
 143         }
 144 }
 145
 146
 147 close $sock;
 148 exit 0;