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.

diff --git a/cmd/crontab b/cmd/crontab
index 4343d76b39e0a5872affca8ccd8b71a899163342..ebc0d24c5c078f59c5d005012563473f58a96dab 100644 (file)
--- 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 753a48facafa5b2cc74dd79b71e4cae8f13413fd..5555512e88c59ef13ba496ee35695ba49ff897f6 100644 (file)
--- 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 25321e9a66f502640ebd835c7b3524b5b409b7ab..5e7fd9ec8f11d1d9566fc6a8b15e1953a6f2e327 100644 (file)
--- 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 11c3a84dc25f46adc644296fe58d2e6609a1e795..957b9c4edede7e29af454f725dd3b0a5b1f733d1 100644 (file)
--- 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 (file)
index 0000000..9a2eb01
--- /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 1207492dbb0ec77209edb8816b4d574b95f8177a..08703d7c8230e49b780d71821d60cbd65719a1d4 100644 (file)
--- 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 9ec12fd3916f6eb044d3b5949eedba4c36223197..287b766e8bdf95ad72614e49b6d997939eebb8ff 100644 (file)
--- 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 60d49eafe72e3d7b7f613f068f75cc132f273324..6a06bb3c32baa4278543b32c2764cc8305e264f6 100644 (file)
--- 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 1c7466a8a2a59f18581a1501b0d1304210abd2d4..1e8200d2e0d03949a4d46dd1b209ab5d9c54e0a9 100755 (executable)
--- 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 3297941388ba5efecedad920b7f8bfcee3f6285b..ff4d3438baa6edf16c852140218aa00982ce2215 100755 (executable)
--- 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);