# RBN-Telnet-Filter/Server # # Connects to the Reverse Beacon Network telnet feed (or any other Skimmer # telnet feed, if desired) and provides a telnet server which only distributes # filtered spots. # # Originally developed for the FOC Marathon 2011, but it may be useful for all # kind of clubs or contests, that's why I released the source code into the # public domain. Feel free to do whatever you want with it. # # Contact: Fabian Kurz, DJ1YFK # URL: http://fkurz.net/ham/stuff.html?rbnfilter # # members.txt = plain text file with all calls that are not filtered out # # Before you use this, make sure you set your callsign here: $mycall = "N0CALL"; # This program should run on all machines that have a reasonably recent version # of Perl installed. use strict; use warnings; use threads; use threads::shared; use Thread::Queue; use IO::Socket::INET; use Net::Telnet (); $| = 1; my $listener = IO::Socket::INET->new( LocalPort => 7300, Listen => 32768, Reuse => 1, Timeout => 172800) || die "Cannot create socket\n"; my $client; my $client_num = 0; my @thr; my @thr_cmd; my @dat : shared; my %callhash : shared; my %callcount; # Calls that will pass the spot filter open CALLS, "members.txt"; while (my $a = ) { chomp($a); $callhash{$a} = 1; } close CALLS; open STAT, "spotstats.txt"; ; while (my $a = ) { my @tmp = split(/\s+/, $a); $callcount{$tmp[0]} = $tmp[1]; } close STAT; # This thread connects to the RBN and receives / redistributes spots my $feedthread = threads->new(\&rbn); my $line : shared; while (1) { $client = $listener->accept; $client_num++; push(@dat, Thread::Queue->new); $thr[$client_num] = threads->create(\&start_thread_out, $client, $client_num); $thr_cmd[$client_num] = threads->create(\&start_thread_in, $client, $client_num); } sub start_thread_out { threads->self->detach(); my ($client, $client_num) = @_; my $command; print "thread out created for client $client_num\n"; print $client "Callsign: "; my $clientcall; $client->recv($clientcall, 700000); $clientcall = uc($clientcall); $clientcall =~ s/[^a-zA-Z0-9-]//g; print $client "Hello $clientcall !\r\n\r\n"; print $client "Welcome to the filtered RBN feed of FUBAR ARC.\r\n"; print $client "http://fkurz.net/ham/stuff.html#rbnfilter\r\n\r\n"; print "User: $clientcall\n"; open LOG, ">>log"; my $date = `date`; print LOG "$date $clientcall\n"; close LOG; while (1) { my $data = $dat[$client_num-1]->dequeue; if ($client->connected) { print $client $data; } else { print "Client $client_num disappeared\n"; open LOG, ">>log"; my $date = `date`; print LOG "$date $clientcall OUT\n"; close LOG; last; } } } sub start_thread_in { threads->self->detach(); my ($client, $client_num) = @_; my $command; print "thread in created for client $client_num\n"; my $cmd; while (1) { sleep 1; $client->recv($cmd, 700000); if ($cmd =~ /set\/member ([a-z0-9\/]+)/i) { my $newcall = uc($1); open LOG, ">>members.txt"; print LOG "$newcall\n"; close LOG; print $client "Added $newcall to the member database.\r\n"; $callhash{$newcall} = 1; } } print "input dead $client_num\n"; } sub rbn { threads->self->detach(); my @lines; print "rbn: connecting\n"; my $t = new Net::Telnet (Timeout => 30, Port => 7000, Prompt => '/./'); $t->open("telnet.reversebeacon.net"); $t->print("$mycall\n"); $t->print("set/nobell\n"); print @lines; while (1) { $line = $t->getline(Timeout => 1000); if (!$line) { print "RBN feed died!\n"; exit; } next unless ($line =~ /^DX/); my $c = substr($line, 28, 10); $c =~ s#[^A-Z0-9/]##g; if ($callhash{$c}) { print "Member:\n"; $callcount{$c}++; save_callcount(); foreach (@dat) { $_->enqueue($line."\r"); } } print $line; } } sub save_callcount () { open STAT, ">spotstats.txt"; print STAT "RBN statistics (started 2011-02-22 22:00z)\r\n"; foreach (sort keys %callcount) { if ($callcount{$_}) { print STAT "$_ \t $callcount{$_}\r\n"; } } close STAT; }