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