X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRBN.pm;h=4c28575365fee363b478e5cce3fcbd4c1e338ee4;hb=refs%2Fheads%2Ftest;hp=3a906dbe7e0b5b5d816f83d59b85b93097245211;hpb=1d545cc6840241395b88cc10addaa1928d9a1166;p=spider.git diff --git a/perl/RBN.pm b/perl/RBN.pm index 3a906dbe..6924626f 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -75,7 +75,7 @@ our $startup_delay = 5*60; # don't send anything out until this timer has expir # this is to allow the feed to "warm up" with duplicates # so that the "big rush" doesn't happen. -our $respottime = 30*60; # the time between respots of a callsign - if a call is +our $respottime = 3*60; # the time between respots of a callsign - if a call is # still being spotted (on the same freq) and it has been # spotted before, it's spotted again after this time # until the next respottime has passed. @@ -172,9 +172,9 @@ sub start my $name = $user->{name}; # log it - my $host = $self->{conn}->peerhost; - $host ||= "unknown"; - $self->{hostname} = $host; + unless ($self->{hostname}) { + $self->{hostname} = $self->{conn}->peerhost || 'unknown'; + } $self->{name} = $name ? $name : $call; $self->state('prompt'); # a bit of room for further expansion, passwords etc @@ -194,7 +194,7 @@ sub start $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type - LogDbg('DXCommand', "$call connected from $self->{hostname}"); + LogDbg('err', "$call connected from $self->{hostname}"); # set some necessary flags on the user if they are connecting $self->{registered} = 1; @@ -202,11 +202,10 @@ sub start $self->{priv} = 0; # get the filters - my $nossid = $call; - $nossid =~ s/-\d+$//; +# $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1) +# || Filter::read_in('rbn', 'node_default', 1); - $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1) - || Filter::read_in('rbn', 'node_default', 1); + Filter::load_dxchan($self, 'rbn', 1); # clean up qra locators my $qra = $user->qra; @@ -247,6 +246,15 @@ sub normal my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line; + # fix up "direct" (from a "skimmer server") connections + # basically the $mode is missing so everything is shifted down one + # so "cheat" and modify the line and do it again + if ($mode =~ /^\d+$/) { + $line =~ s/ $mode\s+dB/CW $mode dB/i; + (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line; + dbg "RBN: inserted CW for missing mode" if $dbgrbn; + } + # fix up FT8 spots from 7001 $t = $u, $u = '' if !$t && is_ztime($u); $t = $sort, $sort = '' if !$t && is_ztime($sort); @@ -259,6 +267,14 @@ sub normal return; } + # is it 'baddx' + if ($DXProt::baddx->in($call)) { + dbg("RBN: Bad DX spot '$call', ignored"); + dbg($line) if isdbg('nologchan'); + return; + } + + # remove all extraneous crap from the origin - just leave the base callsign my $norigin = basecall($origin); unless ($norigin) { @@ -347,24 +363,27 @@ sub normal # # But before we do anything, if this call is in the seeme hash then just send the spot to them # - if (exists $seeme{$call} && (my $scall = $seeme{basecall($call)})) { - my $uchan = DXChannel::get($call); - if ($uchan) { - if ($uchan->is_user) { - if (isdbg('seeme')) { - dbg("seeme: $line"); - dbg( qq{seemme:decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra}); + if (exists $seeme{$call} && (my $ref = $seeme{$call})) { + foreach my $rcall ( @$ref) { + my $uchan = DXChannel::get($rcall); + if ($uchan) { + if ($uchan->is_user) { + if (isdbg('seeme')) { + dbg("seeme: $line"); + dbg( qq{seemme:decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra}); + } + my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#'); + my $buf = $uchan->format_dx_spot(@s); + dbg("seeme: result '$buf'") if isdbg('seeme'); + $uchan->local_send('S', $buf); + } else { + LogDbg('err',"RBN Someone is playing silly persons $rcall is not a user and cannot do 'seeme', ignored and reset"); + del_seeme($rcall); } - my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#'); - my $buf = $uchan->format_dx_spot(@s); - dbg("seeme: result '$buf'") if isdbg('seeme'); - $uchan->local_send('S', $buf) if $scall; - } else { - LogDbg("RBN Someone is playing silly persons $call is not a user and cannot do 'seeme', ignored and reset"); - delete $seeme{$call}; } } } + # find it? my $cand = $spots->{$sp}; unless ($cand) { @@ -451,7 +470,7 @@ sub send_dx_spot my $self = shift; my $quality = shift; my $cand = shift; - + ++$self->{norbn}; ++$self->{norbn10}; ++$self->{norbnhour}; @@ -841,7 +860,7 @@ sub per_minute next unless $dxchan->is_rbn; dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} retrieved spots: $dxchan->{norbn} delivered: $dxchan->{nospot} after filtering to users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats'); if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) { - LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting"); + LogDbg('err', "RBN: no input from $dxchan->{call}, disconnecting"); $dxchan->disconnect; } $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {}; @@ -897,7 +916,10 @@ sub finish sub write_cache { + return unless $json; + my $ta = [ gettimeofday ]; + $json->indent(1)->canonical(1) if isdbg 'rbncache'; my $s = eval {$json->encode($spots)}; if ($s) { @@ -966,12 +988,24 @@ sub check_cache sub add_seeme { my $call = shift; - $seeme{basecall($call)} = 1; + my $base = basecall($call); + my $ref = $seeme{$base} || []; + push @$ref, $call unless grep $_ eq $call, @$ref; + $seeme{$base} = $ref; } sub del_seeme { my $call = shift; - delete $seeme{basecall($call)}; + my $base = basecall($call); + my $ref = $seeme{$base}; + return unless $ref && @$ref; + + @$ref = grep {$_ ne $call} @$ref; + if (@$ref) { + $seeme{$base} = $ref; + } else { + delete $seeme{basecall($call)}; + } } 1;