db
core
a.out
+perl5lib/*
06Aug20=======================================================================
1, Add CTY-3013 Prefixes
+2. Make RBN more efficient. Start the process of skimmer node performance
+ caching. Add minimum quality allowed (at 2), which will be overrideable.
+ The format of the rbn_cache has changed and so a full restart will occur.
+3. Collect channel input/output stats. New command: show/data_stats to show
+ them.
+4. Add local::lib qw{/spider/perl5lib} to store cpanm loaded modules just for
+ DXSpider. This is done so that updates needed by future changes can be done
+ as the sysop user and doesn't have to be done as root. This paves the way
+ for UPDATE.pl which will pull down new modules that it needs automatically.
+ When it's written, which will be soon.
29Jul20=======================================================================
1. Add show/rbn command that allows one to see who is online and configured
for RBN. See help sh/rbn for details.
--- /dev/null
+#
+# show the users on this cluster from the routing tables
+#
+# Copyright (c) 1998 Dirk Koopman G1TLH
+#
+#
+#
+
+sub handle
+{
+ my ($self, $line) = @_;
+ my @list = map { uc } split /\s+/, $line; # list of callsigns of nodes
+ my @out;
+ if ($list[0] eq 'ALL') {
+ shift @list;
+ @list = keys %DXChannel::channels;
+ }
+ push @out, "Data Statitics IN OUT";
+ push @out, "Callsign Lines Data Lines Data";
+ push @out, "-----------------------------------------------------------------------------";
+ if (@list) {
+ foreach my $call (sort @list) {
+ next if $call eq $main::mycall;
+ my $dxchan = DXChannel::get($call);
+ if ($dxchan) {
+ my $conn = $dxchan->conn;
+ push @out, sprintf("%-9.9s %16s %16s %16s %16s", $call, comma($conn->{linesin}), comma($conn->{datain}), comma($conn->{linesout}), comma($conn->{dataout}));
+ }
+ }
+ }
+
+ push @out, "-----------------------------------------------------------------------------" if @out > 3;
+ push @out, sprintf("%-9.9s %16s %16s %16s %16s", "TOTALS", comma($Msg::total_lines_in), comma($Msg::total_in), comma($Msg::total_lines_out), comma($Msg::total_out));
+
+ return (1, @out);
+}
+
+sub comma
+{
+ my $num = shift;
+ return scalar reverse(join(",",unpack("(A3)*", reverse int($num))));
+}
+
$conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
}
+ $conn->{linesin} += @lines;
+ $Msg::total_lines_in += @lines;
while (defined ($msg = shift @lines)) {
dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
} else {
$conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
}
+ $conn->{linesin} += @lines;
+ $Msg::total_lines_in += @lines;
while (defined ($msg = shift @lines)) {
dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
} else {
$conn->{msg} =~ s/([^\cM\cJ]*)\cM?\cJ//g;
}
+ $conn->{linesin} += @lines;
+ $Msg::total_lines_in += @lines;
for (@lines) {
if (defined $_) {
s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
use DXDebug;
use Timer;
-use vars qw($now %conns $noconns $cnum $total_in $total_out $connect_timeout $disc_waittime);
+use vars qw($now %conns $noconns $cnum $total_in $total_out $total_lines_in $total_lines_out $connect_timeout $disc_waittime);
$total_in = $total_out = 0;
+$total_lines_in = $total_lines_out = 0;
$now = time;
my $class = $obj || $pkg;
my $conn = {
- rproc => $rproc,
- inqueue => [],
- outqueue => [],
- state => 0,
- lineend => "\r\n",
- csort => 'telnet',
- timeval => 60,
- blocking => 0,
- cnum => (($cnum < 999) ? (++$cnum) : ($cnum = 1)),
+ rproc => $rproc,
+ inqueue => [],
+ outqueue => [],
+ state => 0,
+ lineend => "\r\n",
+ csort => 'telnet',
+ timeval => 60,
+ blocking => 0,
+ cnum => (($cnum < 999) ? (++$cnum) : ($cnum = 1)),
+ linesin => 0,
+ linesout => 0,
+ datain => 0,
+ dataout => 0,
};
$noconns++;
if (defined $sock) {
$sock->write($data);
$total_out += $lth;
+ $conn->{dataout} += $lth;
+ ++$conn->{linesout};
+ ++$total_lines_out;
} else {
dbg("_send_stuff $call ending data ignored: $data");
}
} else {
$conn->{msg} = pop @lines;
}
+ $conn->{linesin} += @lines;
+ $total_lines_in += @lines;
for (@lines) {
last if $conn->{disconnecting};
&{$conn->{rproc}}($conn, defined $_ ? $_ : '');
return if $conn->{disconnecting};
$total_in += length $msg;
+ $conn->{datain} += length $msg;
- my @lines;
if (isdbg('raw')) {
my $call = $conn->{call} || 'none';
my $lth = length $msg;
# this is to allow the feed to "warm up" with duplicates
# so that the "big rush" doesn't happen.
-our $minspottime = 15*60; # the time between respots of a callsign - if a call is
+our $minspottime = 30*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 minspottime has passed.
my $quality = shift;
my $cand = shift;
my $call = $dxchan->{call};
-
-
my $strength = 100; # because it could if we talk about FTx
my $saver;
-
my %zone;
- my %qrg;
my $respot;
my $qra;
# Spot::prepare($qrg, $call, $utz, $comment, $origin);
next unless ref $r;
- $respot = 1 if $r->[Respot];
$qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]);
$comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength];
my $s = $r->[RSpotData]; # the prepared spot
$s->[SComment] = $comment; # apply new generated comment
-
++$zone{$s->[SZone]}; # save the spotter's zone
- ++$qrg{$s->[SQrg]}; # and the qrg
-
# save the lowest strength one
if ($r->[RStrength] < $strength) {
delete $zone{$saver->[SZone]}; # remove this spotter's zone (leaving all the other zones)
my $z = join ',', sort {$a <=> $b} keys %zone;
- # determine the most likely qrg and then set it
- my $mv = 0;
- my $fk;
- my $c = 0;
- while (my ($k, $v) = each %qrg) {
- $fk = $k, $mv = $v if $v > $mv;
- ++$c;
- }
- $saver->[SQrg] = $fk;
- $saver->[SComment] .= '*' if $c > 1;
- $saver->[SComment] .= '+' if $respot;
+ # alter spot data accordingly
$saver->[SComment] .= " Z:$z" if $z;
- if ($c > 1 && (isdbg('rbnqrg') || isdbg('rbn'))) {
-
- }
dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll';
if ($dxchan->{ve7cc}) {
next;
}
dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue';
- my $r = $cand->[CData];
my $quality = @$cand - CData;
$quality = 9 if $quality > 9;
$cand->[CQual] = $quality if $quality > $cand->[CQual];
+
+ my $r;
+ my %qrg;
+ foreach $r (@$cand) {
+ next unless ref $r;
+ ++$qrg{$r->[RQrg]};
+ }
+ # determine the most likely qrg and then set it
+ my @deviant;
+ my $c = 0;
+ my $mv = 0;
+ my $qrg;
+ while (my ($k, $votes) = each %qrg) {
+ $qrg = $k, $mv = $votes if $votes > $mv;
+ ++$c;
+ }
+ # spit out the deviants
+ if ($c > 1) {
+ foreach $r (@$cand) {
+ next unless ref $r;
+ my $diff = nearest(.1, $qrg - $r->[RQrg]);
+ push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff) if $diff != 0;
+ $r->[RSpotData]->[SQrg] = $qrg; # set all the QRGs to the agreed value
+ }
+ }
+
+ $qrg = sprintf "%.1f", $qrg;
+ $r = $cand->[CData];
+ $r->[RQrg] = $qrg;
my $squality = "Q:$cand->[CQual]";
+ $squality .= '*' if $c > 1;
+ $squality .= '+' if $r->[Respot];
if ($cand->[CQual] >= $minqual) {
if (isdbg('progress')) {
my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call}";
+ $s .= " Deviants: " . join(', ', sort @deviant) if @deviant;
dbg($s);
}
send_dx_spot($dxchan, $squality, $cand);
$spots->{$sp} = [$now, $cand->[CQual]];
delete $dxchan->{queue}->{$sp};
- } else {
+ }
+ else {
dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue';
}
}
{
foreach my $dxchan (DXChannel::get_all()) {
next unless $dxchan->is_rbn;
- dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} sent: $dxchan->{norbn} delivered: $dxchan->{nospot} users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats');
+ 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");
$dxchan->disconnect;
foreach my $dxchan (DXChannel::get_all()) {
next unless $dxchan->is_rbn;
my $nq = keys %{$dxchan->{queue}};
- dbg "RBN:STATS 10-minute $dxchan->{call} queue: $nq raw: $dxchan->{noraw10} sent: $dxchan->{norbn10} delivered: $dxchan->{nospot10} users: " . scalar keys %{$dxchan->{nousers10}};
+ dbg "RBN:STATS 10-minute $dxchan->{call} queue: $nq raw: $dxchan->{noraw10} retrieved spots: $dxchan->{norbn10} delivered: $dxchan->{nospot10} after filtering to users: " . scalar keys %{$dxchan->{nousers10}};
$dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
}
}
foreach my $dxchan (DXChannel::get_all()) {
next unless $dxchan->is_rbn;
my $nq = keys %{$dxchan->{queue}};
- dbg "RBN:STATS hour $dxchan->{call} queue: $nq raw: $dxchan->{norawhour} sent: $dxchan->{norbnhour} delivered: $dxchan->{nospothour} users: " . scalar keys %{$dxchan->{nousershour}};
+ dbg "RBN:STATS hour $dxchan->{call} queue: $nq raw: $dxchan->{norawhour} retrieved spots: $dxchan->{norbnhour} delivered: $dxchan->{nospothour} after filtering to users: " . scalar keys %{$dxchan->{nousershour}};
$dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
}
}
+++ /dev/null
-#
-# Query the PineKnot Database server for a callsign
-#
-# from an idea by Steve Franke K9AN and information from Angel EA7WA
-#
-#
-#
-my ($self, $line) = @_;
-my @list = split /\s+/, $line; # generate a list of callsigns
-my $l;
-my $call = $self->call;
-my @out;
-
-return (1, "SHOW/CALL <callsign>, e.g. SH/CALL g1tlh") unless @list;
-
-use Net::Telnet;
-
-my $t = new Net::Telnet;
-
-push @out, $self->msg('call1', 'AA6HF');
-foreach $l (@list) {
- $t->open(Host => "jeifer.pineknot.com",
- Port => 1235,
- Timeout => 5);
- if ($t) {
- $t->print(uc $l);
- Log('call', "$call: show/call \U$l");
- while (my $result = $t->getline) {
- push @out,$result;
- }
- $t->close;
- } else {
- push @out, $self->msg('e18', 'AA6HF');
- }
-}
-
-return (1, @out);
$no = 'No'; # ditto for no
$user_interval = 11*60; # the interval between unsolicited prompts if no traffic
-
# make sure that modules are searched in the order local then perl
BEGIN {
umask 002;
eval {
require local::lib;
};
- import local::lib unless ($@);
+ unless ($@) {
+# import local::lib;
+ import local::lib qw(/spider/perl5lib);
+ }
# root of directory tree for this system
$root = "/spider";
$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+ unshift @INC, "$root/perl5lib" unless grep {$_ eq "$root/perl5lib"} @INC;
unshift @INC, "$root/perl"; # this IS the right way round!
unshift @INC, "$root/local";
}
STDOUT->autoflush(1);
+ # log our path
+ dbg "Perl path: " . join(':', @INC);
# try to load the database
if (DXSql::init($dsn)) {
projects / spider.git / commitdiff