From cbb522ef802d48991734a4ce803fa6ffa9774588 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Thu, 6 Aug 2020 20:13:55 +0100 Subject: [PATCH] Add latest RBN chnages and data stats --- .gitignore | 1 + Changes | 10 +++++++ cmd/show/data_stats.pl | 43 +++++++++++++++++++++++++++ perl/EphMsg.pm | 2 ++ perl/ExtMsg.pm | 2 ++ perl/IntMsg.pm | 2 ++ perl/Msg.pm | 32 +++++++++++++------- perl/RBN.pm | 67 ++++++++++++++++++++++++------------------ perl/call.pl | 37 ----------------------- perl/cluster.pl | 9 ++++-- 10 files changed, 127 insertions(+), 78 deletions(-) create mode 100644 cmd/show/data_stats.pl delete mode 100755 perl/call.pl diff --git a/.gitignore b/.gitignore index ae974f3d..bdb912e6 100644 --- a/.gitignore +++ b/.gitignore @@ -20,3 +20,4 @@ tutor* db core a.out +perl5lib/* diff --git a/Changes b/Changes index 10184a0d..250699eb 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,15 @@ 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. diff --git a/cmd/show/data_stats.pl b/cmd/show/data_stats.pl new file mode 100644 index 00000000..7b37da06 --- /dev/null +++ b/cmd/show/data_stats.pl @@ -0,0 +1,43 @@ +# +# 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)))); +} + diff --git a/perl/EphMsg.pm b/perl/EphMsg.pm index 2fa7a593..bf43a334 100644 --- a/perl/EphMsg.pm +++ b/perl/EphMsg.pm @@ -61,6 +61,8 @@ sub dequeue $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'); diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index 6b3a30b1..064bd90a 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -107,6 +107,8 @@ sub dequeue } 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'); diff --git a/perl/IntMsg.pm b/perl/IntMsg.pm index e5f05ff1..4361b7b5 100644 --- a/perl/IntMsg.pm +++ b/perl/IntMsg.pm @@ -40,6 +40,8 @@ sub dequeue } 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; diff --git a/perl/Msg.pm b/perl/Msg.pm index 3e30372f..d0ad7330 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -20,9 +20,10 @@ use Mojo::IOLoop::Stream; 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; @@ -43,15 +44,19 @@ sub new 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++; @@ -350,6 +355,9 @@ sub _send_stuff 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"); } @@ -425,6 +433,8 @@ sub dequeue } else { $conn->{msg} = pop @lines; } + $conn->{linesin} += @lines; + $total_lines_in += @lines; for (@lines) { last if $conn->{disconnecting}; &{$conn->{rproc}}($conn, defined $_ ? $_ : ''); @@ -440,8 +450,8 @@ sub _rcv { # Complement to _send 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; diff --git a/perl/RBN.pm b/perl/RBN.pm index 9ff7dd48..15b4aa47 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -67,7 +67,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 $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. @@ -440,13 +440,9 @@ sub dx_spot 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; @@ -463,17 +459,13 @@ sub dx_spot # 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) { @@ -501,21 +493,8 @@ sub dx_spot 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}) { @@ -571,15 +550,46 @@ sub process 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); @@ -593,7 +603,8 @@ sub process $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'; } } @@ -605,7 +616,7 @@ sub per_minute { 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; @@ -638,7 +649,7 @@ sub per_10_minute 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} = {}; } } @@ -648,7 +659,7 @@ sub per_hour 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} = {}; } } diff --git a/perl/call.pl b/perl/call.pl deleted file mode 100755 index 8c089e00..00000000 --- a/perl/call.pl +++ /dev/null @@ -1,37 +0,0 @@ -# -# 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 , 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); diff --git a/perl/cluster.pl b/perl/cluster.pl index ca70610f..36989dee 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -31,7 +31,6 @@ $yes = 'Yes'; # visual representation of yes $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; @@ -41,12 +40,16 @@ BEGIN { 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"; @@ -491,6 +494,8 @@ sub setup_start } STDOUT->autoflush(1); + # log our path + dbg "Perl path: " . join(':', @INC); # try to load the database if (DXSql::init($dsn)) { -- 2.43.0