From: Dirk Koopman <djk@tobit.co.uk>
Date: Mon, 2 Jan 2017 21:48:51 +0000 (+0000)
Subject: add rbn.pl - a deduplicating RBN spot filter
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=51d87fa76d0619748d20c522809f952eb4c2bb0d;p=spider.git

add rbn.pl - a deduplicating RBN spot filter

This is some experimental preparatory work for adding in handling
of an RBN feed to DXSpider.
---

diff --git a/Changes b/Changes
index d23c9733..5d16d91f 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 02Jan17=======================================================================
 1. Add CTY-2615 prefixes
+2. Add rbn.pl - an experimental rbn deduplicating spot filter. 
 26Dec16=======================================================================
 1. Fix some possible routes to $myalias callsigns becoming nodes.
 22Nov16=======================================================================
diff --git a/perl/rbn.pl b/perl/rbn.pl
new file mode 100755
index 00000000..0c966473
--- /dev/null
+++ b/perl/rbn.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+#
+# An RBN deduping filter
+#
+# Copyright (c) 2017 Dirk Koopman G1TLH
+#
+
+use strict;
+use 5.10.1;
+use IO::Socket::IP -register;
+use Math::Round qw(nearest);
+
+my $host = 'telnet.reversebeacon.net';
+my $port = 7000;
+my $mycall = shift or die "usage:rbn.pl <callsign> [debug] [<time between repeat spots in minutes>]\n"; 
+
+my $minspottime = 15*60;		# minimum length of time between successive spots
+
+my $attempts;
+my $sock;
+my $dbg;
+
+while (@ARGV) {
+	my $arg = shift;
+
+	++$dbg if $arg =~ /^deb/i;
+	$minspottime = $arg * 60 if $arg =~ /^\d+$/;
+}
+
+for ($attempts = 1; $attempts <= 5; ++$attempts) {
+	say "admin,connecting to $host $port.. (attempt $attempts) " if $dbg;
+	$sock = IO::Socket::IP->new(
+								PeerHost => $host,
+								PeerPort => $port,
+								Timeout => 2,
+							   );
+	last if $sock;
+}
+
+die "admin,Cannot connect to $host:$port after 5 attempts $!" unless $sock;
+say "admin,connected" if $dbg;
+print $sock "$mycall\r\n";
+say "admin,call sent" if $dbg;
+
+my %d;
+my %spot;
+
+my $last = time;
+
+while (<$sock>) {
+	chomp;
+	my $tim = time;
+
+	# parse line
+	my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) = split /[:\s]+/;
+	if ($t) {
+
+		# We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
+		# This works because the skimmers are NTP controlled (or should be) and will receive
+		# the spot at the same time (velocity factor of the atmosphere taken into account :-)
+		my $p = "$t|$call";
+		next if $d{$p};
+
+		# new RBN input
+		$d{$p} = $tim;
+		$qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
+		say join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if $dbg;
+
+		# Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
+		# if we have, has it been a "while" since the last time we spotted it? If it has been spotted
+		# before then "RESPOT" it.
+		my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
+		my $sp = "$call|$nqrg";		  # hopefully the skimmers will be calibrated at least this well! 
+		my $ts = $spot{$sp};
+		if (!$ts || $tim - $ts >= $minspottime) {
+			my $tag = $ts ? "RESPOT" : "SPOT";
+			say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
+			$spot{$sp} = $tim;
+		}
+	} else {
+		say "data,$_" if $dbg;
+	}
+
+	# periodic clearing out of the two caches
+	if ($tim > $last+60) {
+		my $count = 0;
+		my $removed = 0;
+		
+		while (my ($k,$v) = each %d) {
+			if ($tim-$v > 60) {
+				delete $d{$k};
+				++$removed
+			} else {
+				++$count;
+			}
+		}
+		say "admin,rbn cache: $removed removed $count remain" if $dbg;
+		$count = $removed = 0;
+		while (my ($k,$v) = each %spot) {
+			if ($tim-$v > $minspottime*2) {
+				delete $spot{$k};
+				++$removed;
+			} else {
+				++$count;
+			}
+		}
+		say "admin,spot cache: $removed removed $count remain" if $dbg;
+		$last = $tim;
+	}
+}
+
+
+close $sock;
+exit 0;