From 83445c4f6ec6c885260944a9abe648aced399c40 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 16 Feb 2019 00:29:12 +0000 Subject: [PATCH] Add a ring buffer to debugging + other things Add a ring buffer to debugging to allow sysops to reduce the amount of pointless debugging info that is continually logged. Likely this is something that big sites or RPi users might want. The biggy is 'chan'. You want this in the ring buffer, but not logging. To do this: set/debug chan nologchan You can log the ring contents at any time with: show/debug_ring NOTE: you should probably have watchdbg running for this to be much use unless you are doing this as a matter of record. export_users has been fixed and is forced to be dumped into /spider/local_data as default. show/debug now sorts its output. LogDbg has been fixed to log stuff to the correct category. --- cmd/crontab | 2 +- cmd/export_users.pl | 9 +++-- cmd/show/cmd_cache.pl | 4 +-- cmd/show/debug.pl | 2 +- cmd/show/debug_ring.pl | 13 ++++++++ perl/DXDebug.pm | 74 ++++++++++++++++++++++++++++++++++++------ perl/DXLog.pm | 3 +- perl/DXUser.pm | 18 +++++----- perl/cluster.pl | 2 +- perl/watchdbg | 6 ++-- 10 files changed, 103 insertions(+), 30 deletions(-) create mode 100644 cmd/show/debug_ring.pl diff --git a/cmd/crontab b/cmd/crontab index 4343d76b..ebc0d24c 100644 --- a/cmd/crontab +++ b/cmd/crontab @@ -5,6 +5,6 @@ # create and edit the one in /spider/local_cmd/crontab # for doing connections and things # -1 0 * * 3 DXUser::export(localdata("user_asc")) +1 0 * * 3 DXUser::export() 5 0 * * * DXDebug::dbgclean() 0 3 * * * Spot::daily() diff --git a/cmd/export_users.pl b/cmd/export_users.pl index 753a48fa..5555512e 100644 --- a/cmd/export_users.pl +++ b/cmd/export_users.pl @@ -4,9 +4,14 @@ # # my $self = shift; -my $line = shift || "user_asc"; +my $line = shift;; return (1, $self->msg('e5')) unless $self->priv >= 9; my ($fn, $flag) = split /\s+/, $line; my $strip = $flag eq 'strip'; -return (1, DXUser::export($fn, $strip)); + +my @out = $self->spawn_cmd("export_users", \&DXUser::export, args => [$fn, $strip]); + +return (1, @out); + + diff --git a/cmd/show/cmd_cache.pl b/cmd/show/cmd_cache.pl index 25321e9a..5e7fd9ec 100644 --- a/cmd/show/cmd_cache.pl +++ b/cmd/show/cmd_cache.pl @@ -12,9 +12,9 @@ my $line = shift; return (1, $self->msg('e5')) if $self->priv < 9; my @out = sprintf "%-20s %s", "Command", "Path"; -for (sort keys %cmd_cache) { +for (sort keys %DXCommandmode::cmd_cache) { next if $line && $_ !~ m|\Q$line|i; - my $v = $cmd_cache{$_}; + my $v = $DXCommandmode::cmd_cache{$_}; $v =~ s|,|/|g; push @out, sprintf "%-20s %s", $_, "$v.pl"; } diff --git a/cmd/show/debug.pl b/cmd/show/debug.pl index 11c3a84d..957b9c4e 100644 --- a/cmd/show/debug.pl +++ b/cmd/show/debug.pl @@ -9,7 +9,7 @@ use DXDebug; my $self = shift; return (0) if ($self->priv < 9); # only console users allowed -my $set = join ' ', dbglist(); # generate space delimited list +my $set = join ' ', sort (dbglist()); # generate space delimited list return (1, "debug levels: $set"); diff --git a/cmd/show/debug_ring.pl b/cmd/show/debug_ring.pl new file mode 100644 index 00000000..9a2eb01a --- /dev/null +++ b/cmd/show/debug_ring.pl @@ -0,0 +1,13 @@ +# +# Log the current values of the DXDebug dbgring butter +# +# +# +my $self = shift; +my $line = shift;; +return (1, $self->msg('e5')) unless $self->priv >= 9; + +DXDebug::dbgprintring(); +DXDebug::dbgclearring() if $line =~ /^clear$/; + +return (1, 'Contents of debug ring buffer logged. View with watchdbg.'); diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 1207492d..08703d7c 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -2,9 +2,11 @@ # The system variables - those indicated will need to be changed to suit your # circumstances (and callsign) # -# Copyright (c) 1998 - Dirk Koopman G1TLH -# +# Copyright (c) 1998-2019 - Dirk Koopman G1TLH # +# Note: Everything is recorded into the ring buffer (in perl terms: a numerically max sized array). +# To allow debugging of a category (e.g. 'chan') but not onto disc (just into the ring buffer) +# do: set/debug chan nologchan # package DXDebug; @@ -14,7 +16,7 @@ require Exporter; @EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck); use strict; -use vars qw(%dbglevel $fp $callback $cleandays $keepdays); +use vars qw(%dbglevel $fp $callback $cleandays $keepdays $dbgringlth); use DXUtil; use DXLog (); @@ -26,8 +28,10 @@ $fp = undef; $callback = undef; $keepdays = 10; $cleandays = 100; +$dbgringlth = 500; our $no_stdout; # set if not running in a terminal +our @dbgring; # Avoid generating "subroutine redefined" warnings with the following # hack (from CGI::Carp): @@ -35,12 +39,16 @@ if (!defined $DB::VERSION) { local $^W=0; eval qq( sub confess { \$SIG{__DIE__} = 'DEFAULT'; + DXDebug::dbgprintring() unless DXDebug::isdbg('chan'); + DXDebug::dbgclearring(); DXDebug::dbg(\$@); DXDebug::dbg(Carp::shortmess(\@_)); exit(-1); } sub croak { \$SIG{__DIE__} = 'DEFAULT'; + DXDebug::dbgprintring() unless DXDebug::isdbg('chan'); + DXDebug::dbgclearring(); DXDebug::dbg(\$@); DXDebug::dbg(Carp::longmess(\@_)); exit(-1); @@ -50,7 +58,8 @@ if (!defined $DB::VERSION) { ); CORE::die(Carp::shortmess($@)) if $@; -} else { +} +else { eval qq( sub confess { die Carp::longmess(\@_); }; sub croak { die Carp::shortmess(\@_); }; sub cluck { warn Carp::longmess(\@_); }; @@ -59,6 +68,8 @@ if (!defined $DB::VERSION) { } +my $_isdbg; # current dbg level we are processing + sub dbg($) { return unless $fp; @@ -72,9 +83,14 @@ sub dbg($) print "$_\n" if defined \*STDOUT && !$no_stdout; my $str = "$t^$_"; &$callback($str) if $callback; - $fp->writeunix($t, $str); + if ($dbgringlth) { + shift @dbgring while (@dbgring > $dbgringlth); + push @dbgring, $str; + } + $fp->writeunix($t, $str) unless $dbglevel{"nolog$_isdbg"}; } } + $_isdbg = ''; } sub dbginit @@ -88,7 +104,8 @@ sub dbginit dbg($@); dbg(Carp::longmess(@_)); CORE::die; - } else { + } + else { dbg($@); dbg(Carp::shortmess(@_)); } @@ -105,12 +122,17 @@ sub dbginit } $fp = DXLog::new('debug', 'dat', 'd'); + dbgclearring(); } sub dbgclose { $SIG{__DIE__} = $SIG{__WARN__} = 'DEFAULT'; - $fp->close() if $fp; + if ($fp) { + dbgprintring() if grep /nolog/, keys %dbglevel; + $fp->close(); + } + dbgclearring(); undef $fp; } @@ -161,7 +183,10 @@ sub dbglist sub isdbg($) { return unless $fp; - return $dbglevel{$_[0]}; + if ($dbglevel{$_[0]}) { + $_isdbg = $_[0]; + return 1; + } } sub shortmess @@ -170,10 +195,38 @@ sub shortmess } sub longmess -{ +{ return Carp::longmess(@_); } +sub dbgprintring +{ + return unless $fp; + my $first; + while (my $l = shift @dbgring) { + my ($t, $str) = split /\^/, $l, 2; + next unless $t; + my $lt = time; + unless ($first) { + $fp->writeunix($lt, "$lt^###"); + $fp->writeunix($lt, "$lt^### RINGBUFFER START"); + $fp->writeunix($lt, "$lt^###"); + $first = $t; + } + my $buf = sprintf "%02d:%02d:%02d", (gmtime($t))[2,1,0]; + $fp->writeunix($lt, "$lt^RING: $buf^$str"); + } + my $et = time; + $fp->writeunix($et, "$et^###"); + $fp->writeunix($et, "$et^### RINGBUFFER END"); + $fp->writeunix($et, "$et^###"); +} + +sub dbgclearring +{ + @dbgring = (); +} + # clean out old debug files, stop when you get a gap of more than a month sub dbgclean { @@ -185,7 +238,8 @@ sub dbgclean if (-e $fn) { unlink $fn; $i = 0; - } else { + } + else { $i++; } $date = $date->sub(1); diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 9ec12fd3..287b766e 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -212,8 +212,9 @@ sub Log sub LogDbg { + my $cat = shift; DXDebug::dbg($_) for @_; - Log(@_); + Log($cat, @_); } sub Logclose diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 60d49eaf..6a06bb3c 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -412,10 +412,10 @@ sub fields sub export { - my $name = shift; + my $name = shift || 'user_asc'; my $basic_info_only = shift; - my $fn = "$main::local_data/$name"; + my $fn = $name ne 'user_asc' ? $name : "$main::local_data/$name"; # force use of local # save old ones move "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo"; @@ -466,8 +466,6 @@ BEGIN { } } -package DXUser; - use SysVar; use DXUser; @@ -476,8 +474,10 @@ if (@ARGV) { print "user filename now $userfn\n"; } -DXUser::del_file(); -DXUser::init(); +package DXUser; + +del_file(); +init(1); %u = (); my $count = 0; my $err = 0; @@ -533,8 +533,10 @@ print "There are $count user records and $err errors\n"; } } $fh->close; - } - return "$count Users $del Deleted $err Errors ('sh/log Export' for details)"; + } + my $s = qq{Exported users to $fn - $count Users $del Deleted $err Errors ('sh/log Export' for details)}; + LogDbg('command', $s); + return $s; } # diff --git a/perl/cluster.pl b/perl/cluster.pl index 1c7466a8..1e8200d2 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -91,6 +91,7 @@ use strict; use Mojo::IOLoop; +use DXDebug; use Msg; use IntMsg; use Internet; @@ -98,7 +99,6 @@ use Listeners; use ExtMsg; use AGWConnect; use AGWMsg; -use DXDebug; use DXLog; use DXLogPrint; use DXUtil; diff --git a/perl/watchdbg b/perl/watchdbg index 32979413..ff4d3438 100755 --- a/perl/watchdbg +++ b/perl/watchdbg @@ -79,10 +79,8 @@ sub printit chomp $line; $line =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg; my ($t, $l) = split /\^/, $line, 2; - my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time); - my $buf = sprintf "%02d:%02d:%02d", $hour, $min, $sec; - - print $buf, ' ', $l, "\n"; + $t = time unless defined $t; + printf "%02d:%02d:%02d %s\n", (gmtime($t))[2,1,0], $l; } } exit(0); -- 2.43.0