]> gb7djk.dxcluster.net Git - spider.git/blob - perl/rbn.pl
limit the no of spots stored for a search
[spider.git] / 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 $wantdx = 1;
29 my $wantft = 1;
30 my $wantpsk = 1;
31 my $wantraw = 0;
32 my $showrbn;
33 my $help = 0;
34 my $man = 0;
35 my $mycall;
36
37 #Getopt::Long::Configure( qw(auto_abbrev) );
38 GetOptions('host=s' => \$host,
39                    'port=i' => \$port,
40                    'debug' => \$dbg,
41                    'rbn' => \$showrbn,
42                    'stats' => \$showstats,
43                    'raw' => \$wantraw,
44                    'repeattime|rt=i' => sub { $minspottime = $_[1] * 60 },
45                    'want=s' => sub {
46                            my ($name, $value) = @_;
47                            $wantcw = $wantrtty = $wantpsk = $wantbeacon = $wantdx = $wantft = $wantpsk = 0;
48                            for (split /[:,\|]/, $value) {
49                                    ++$wantcw if /^cw$/i;
50                                    ++$wantpsk if /^psk$/i;
51                                    ++$wantrtty if /^rtty$/i;
52                                    ++$wantbeacon if /^beacon/i;
53                                    ++$wantdx if /^dx$/i;
54                                    ++$wantft if /^ft$/;
55                                    ++$wantft, ++$wantrtty, ++$wantpsk if /^digi/;
56                            }
57                    },
58                    'help|?' => \$help,
59                    'man' => \$man,
60                    '<>' => sub { $mycall = shift },
61                   ) or pod2usage(2);
62
63 $mycall ||= shift;
64
65 pod2usage(1) if $help || !$mycall;
66 pod2usage(-exitval => 0, -verbose => 2) if $man;
67
68
69 for ($attempts = 1; $attempts <= 5; ++$attempts) {
70         say "ADMIN,connecting to $host $port.. (attempt $attempts) " if $dbg;
71         $sock = IO::Socket::IP->new(
72                                                                 PeerHost => $host,
73                                                                 PeerPort => $port,
74                                                                 Timeout => 2,
75                                                            );
76         last if $sock;
77 }
78
79 die "ADMIN,Cannot connect to $host:$port after 5 attempts $!\n" unless $sock;
80 say "ADMIN,connected" if $dbg;
81 $sock->timeout(0);
82
83 print $sock "$mycall\r\n";
84 say "ADMIN,call $mycall sent" if $dbg;
85
86 my %d;
87 my %spot;
88
89 my $last = 0;
90 my $noraw = 0;
91 my $norbn = 0;
92 my $nospot = 0;
93
94 while (<$sock>) {
95         chomp;
96         my $tim = time;
97
98         # parse line
99         say "RAW,$_" if $wantraw;
100
101         if (/call:/) {
102                 print $sock "$mycall\r\n";
103                 say "ADMIN,call $mycall sent" if $dbg;
104         }
105
106         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/;
107         my $b;
108         
109         if ($t || $tx) {
110
111                 # fix up times for things like 'NXDXF B' etc
112                 if ($tx && $t !~ /^\d{4}Z$/) {
113                         if ($tx =~ /^\d{4}Z$/) {
114                                 $b = $t;
115                                 $t = $tx;
116                         } else {
117                                 say "ERR,$_";
118                                 next;
119                         }
120                 }
121
122                 # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
123                 # This works because the skimmers are NTP controlled (or should be) and will receive
124                 # the spot at the same time (velocity factor of the atmosphere and network delays
125                 # carefully (not) taken into account :-)
126
127                 # Note, there is no intelligence here, but there are clearly basic heuristics that could
128                 # be applied at this point that reject (more likely rewrite) the call of a busted spot that would
129                 # useful for a zonal hotspot requirement from the cluster node.
130
131                 # In reality, this mechanism would be incorporated within the cluster code, utilising the dxqsl database,
132                 # and other resources in DXSpider, thus creating a zone map for an emitted spot. This is then passed through the
133                 # normal "to-user" spot system (where normal spots are sent to be displayed per user) and then be
134                 # processed through the normal, per user, spot filtering system - like a regular spot.
135
136                 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
137         # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
138                 # data sources (for singleton spots) to then generate a "centre" from and to zone (whatever that will mean if it isn't the usual one)
139                 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
140         # and spotted. A map can be generated once per user and spotter as they are essentially mostly static. 
141                 # The spotted will only get a coarse position unless other info is available. Programs that parse 
142                 # DX bulletins and the online data online databases could be be used and then cached. 
143
144                 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
145                 # ignored.
146
147                 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
148                 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
149                 # process to just the standard "message passing" which has been shown to be able to sustain over 5000 
150                 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).  
151                 
152                 my $p = "$t|$call";
153                 ++$noraw;
154                 next if $d{$p};
155
156                 # new RBN input
157                 $d{$p} = $tim;
158                 ++$norbn;
159                 $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
160                 if (!$wantraw && ($dbg || $showrbn)) {
161                         my $s = join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
162                         $s .= ",$b" if $b;
163                         say $s;
164                 }
165
166                 # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
167                 # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
168                 # before then "RESPOT" it.
169                 my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
170                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well! 
171                 my $ts = $spot{$sp};
172
173                 if (!$ts || ($minspottime > 0 && $tim - $ts >= $minspottime)) {
174                         my $want;
175
176                         ++$want if $wantbeacon && $sort =~ /^BEA|NCD/;
177                         ++$want if $wantcw && $mode =~ /^CW/;
178                         ++$want if $wantrtty && $mode =~ /^RTTY/;
179                         ++$want if $wantpsk && $mode =~ /^PSK/;
180                         ++$want if $wantdx && $mode =~ /^DX/;
181                         ++$want if $wantft && $mode =~ /^FT/;
182                         if ($want) {
183                                 ++$nospot;
184                                 my $tag = $ts ? "RESPOT" : "SPOT";
185                                 $t .= ",$b" if $b;
186                                 say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
187                                 $spot{$sp} = $tim;
188                         }
189                 }
190         } else {
191                 say "DATA,$_" if $dbg && !$wantraw;
192         }
193
194         # periodic clearing out of the two caches
195         if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
196                 my $count = 0;
197                 my $removed = 0;
198
199                 while (my ($k,$v) = each %d) {
200                         if ($tim-$v > 60) {
201                                 delete $d{$k};
202                                 ++$removed
203                         } else {
204                                 ++$count;
205                         }
206                 }
207                 say "ADMIN,rbn cache: $removed removed $count remain" if $dbg;
208                 $count = $removed = 0;
209                 while (my ($k,$v) = each %spot) {
210                         if ($tim-$v > $minspottime*2) {
211                                 delete $spot{$k};
212                                 ++$removed;
213                         } else {
214                                 ++$count;
215                         }
216                 }
217                 say "ADMIN,spot cache: $removed removed $count remain" if $dbg;
218
219                 say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
220                 $noraw = $norbn = $nospot = 0;
221
222                 $last = int($tim / 60) * 60;
223         }
224 }
225
226
227 close $sock;
228 exit 0;
229
230 __END__
231
232 =head1 NAME
233
234 rbn.pl - an experimental RBN filter program 
235
236 =head1 SYNOPSIS
237
238 rbn.pl [options] <any callsign>
239
240 We read the raw data
241 from the RBN. We collect similar spots on a frequency within 100hz and try to
242 deduce which if them is likely to be the true callsign. Emitted spots are cached and thereafter ignored
243 for a period until it is spotted again, when it may be emitted again - but marked as a RESPOT. 
244
245 This is just technology demonstrator designed to scope out the issues and make sure that the line decoding works
246 in all circumstances. But even on busy weekends it seems to cope just fine deduping away within its limits.
247
248 To see it work at its best, run it as: rbn.pl -stats <any callsign>
249
250 Leave it running for some time, preferably several (10s of) minutes.
251 You will see it slowly reduce the number of new spots until you start to see "RESPOT" lines. Reductions
252 of more than one order of magnitude is normal. Particularly when there are many more spotters. 
253
254 =head1 OPTIONS
255
256 =over 8
257
258 =item B<-help>
259
260 Print a brief help message and exits.
261
262 =item B<-man>
263
264 Prints the manual page and exits.
265
266 =item B<-host>=telnet.reversebeacon.net 
267
268 As default, this program will connect to C<telnet.reversebeacon.net>. Use this argument to change that.
269
270 =item B<-port>=7000
271
272 As default, this program will connect to port 7000. Use this argument to change that to some other port.
273
274 =item B<-want>=cw,rtty,dx,beacon,psk,ft,digital
275
276 The program will print all spots in all classes in the 'mode/calling' column [cw, rtty, beacon, dx, psk, ft, digital]. You can choose one or more of
277 these classes if you want specific types of spots. The class 'digital' is equivalent to [rtty,psk,ft]. The class 'beacon' includes
278 NCDXF beacons. 
279
280 E.g. rbn.pl -want=psk,ft,beacon g9tst
281
282 =item B<-stats>
283
284 Print a comma separated line of statistics once a minute which consists of:
285
286 STAT,E<lt>raw RBN spotsE<gt>,E<lt>de-duped RBN spotsE<gt>,E<lt>new spotsE<gt>
287
288 =item B<-repeattime=60>
289
290 A cache of callsigns and QRGs is kept. If a SPOT comes in after B<repeattime> minutes then it re-emitted
291 but with a RESPOT tag instead. Set this argument to 0 (or less) if you do not want any repeats. 
292
293 =item B<-rbn>
294
295 Show the de-duplicated RBN lines as they come in.
296
297 =item B<-raw>
298
299 Show the raw RBN lines as they come in.
300
301 =back
302
303 =head1 DESCRIPTION
304
305 B<This program> connects (as default) to RBN C<telnet.reversebeacon.net:7000> and parses the raw output
306 which it deduplicates and then outputs unique spots. It is possible to select one or more types of spot. 
307
308 The output is the RBN spot line which has been separated out into a comma separated list. One line per spot.
309
310 Like this:
311
312   SPOT,DK3UA-#,3560.0,DL6ZB,CW,27,dB,26,WPM,CQ,2152Z
313   SPOT,WB6BEE-#,14063.0,KD6SX,CW,24,dB,15,WPM,CQ,2152Z
314   RESPOT,S50ARX-#,1811.5,OM0CS,CW,37,dB,19,WPM,CQ,2152Z
315   SPOT,DF4UE-#,3505.0,TA1PT,CW,11,dB,23,WPM,CQ,2152Z
316   SPOT,AA4VV-#,14031.0,TF3Y,CW,16,dB,22,WPM,CQ,2152Z
317   SPOT,SK3W-#,3600.0,OK0EN,CW,13,dB,11,WPM,BEACON,2152Z
318   STAT,263,64,27
319
320 If the -raw flag is set then these lines will be interspersed with the raw line from the RBN source, prefixed 
321 with "RAW,". For example:
322
323   RAW,DX de PJ2A-#:    14025.4  IP0TRC         CW    16 dB  31 WPM  CQ      1307Z
324   RAW,DX de PJ2A-#:    10118.9  K1JD           CW     2 dB  28 WPM  CQ      1307Z
325   RAW,DX de K2PO-#:     1823.4  HL5IV          CW     8 dB  22 WPM  CQ      1307Z
326   SPOT,K2PO-#,1823.4,HL5IV,CW,8,dB,22,WPM,CQ,1307Z
327   RAW,DX de LZ7AA-#:   14036.6  HA8GZ          CW     7 dB  27 WPM  CQ      1307Z
328   RAW,DX de DF4UE-#:   14012.0  R7KM           CW    32 dB  33 WPM  CQ      1307Z
329   RAW,DX de G7SOZ-#:   14012.2  R7KM           CW    17 dB  31 WPM  CQ      1307Z
330
331
332 =cut
333