From 63f0fc26e717837bc7c6990f27d26de91d65eb7e Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 25 Apr 2020 23:33:09 +0100 Subject: [PATCH] sh/cl and dmesg changes Add max no of local users seen since node start Add ability to show last n lines of the debug ring buffer --- Changes | 3 +++ cmd/show/cluster.pl | 7 ++++++- cmd/show/debug_ring.pl | 12 ++++++++++-- perl/DXCommandmode.pm | 42 ++++++++++++++++++++++++++++++++---------- perl/DXDebug.pm | 14 ++++++++------ perl/DXProt.pm | 22 ++++++++++++++++------ perl/Messages | 1 + perl/Route.pm | 7 +++++-- 8 files changed, 81 insertions(+), 27 deletions(-) diff --git a/Changes b/Changes index 6f79cd19..12c44037 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +25Apr20======================================================================= +1. Add maximum no of users on node to show/cluster. +2. Add ability to show last n lines of debugging ring buffer. 24Apr20======================================================================= 1. Add 'progress' debugging for showing that stuff is happening in nologchan a.k.a ringbuffer only mode. diff --git a/cmd/show/cluster.pl b/cmd/show/cluster.pl index 066ef7bf..ea137856 100644 --- a/cmd/show/cluster.pl +++ b/cmd/show/cluster.pl @@ -1,4 +1,9 @@ # # show some statistics # -return (1, Route::cluster() ); + +my $self = shift; + +my ($nodes, $tot, $users, $maxlocalusers, $maxusers, $uptime, $localnodes) = Route::cluster(); + +return (1, $self->msg('cluster', $localnodes, $nodes, $users, $tot, $maxlocalusers, $maxusers, $uptime)); diff --git a/cmd/show/debug_ring.pl b/cmd/show/debug_ring.pl index 9a2eb01a..272da35c 100644 --- a/cmd/show/debug_ring.pl +++ b/cmd/show/debug_ring.pl @@ -7,7 +7,15 @@ my $self = shift; my $line = shift;; return (1, $self->msg('e5')) unless $self->priv >= 9; -DXDebug::dbgprintring(); -DXDebug::dbgclearring() if $line =~ /^clear$/; +my @args = split /\s+/, $line; +my $n; +my $doclear; + +for (@args) { + $n = 0+$_ if /^\d+$/; + $doclear++ if /^clear$/; +} +DXDebug::dbgprintring($n); +DXDebug::dbgclearring() if $doclear; return (1, 'Contents of debug ring buffer logged. View with watchdbg.'); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 74e53b10..6306b7fb 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -48,7 +48,7 @@ use Mojo::UserAgent; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug - $maxbadcount $msgpolltime $default_pagelth $cmdimportdir); + $maxbadcount $msgpolltime $default_pagelth $cmdimportdir $users $maxusers); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -59,7 +59,8 @@ $maxbadcount = 3; # no of bad words allowed before disconnection $msgpolltime = 3600; # the time between polls for new messages $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing command scripts # this does not exist as default, you need to create it manually -# +$users = 0; # no of users on this node currently +$maxusers = 0; # max no users on this node for this run # # obtain a new connection this is derived from dxchannel @@ -549,7 +550,10 @@ sub run_cmd } my $t0 = [gettimeofday]; eval { @ans = &{"${package}::handle"}($self, $args) }; - return (DXDebug::shortmess($@)) if $@; + if ($@) { + dbgprintring(25); + return (DXDebug::shortmess($@)); + } if (isdbg('progress')) { my $msecs = _diffms($t0); my $s = "CMD: '$cmd $args' by $call ip: $self->{hostname} ${msecs}mS"; @@ -587,7 +591,8 @@ sub process my $t = time; my @dxchan = DXChannel::get_all(); my $dxchan; - + + $users = 0; foreach $dxchan (@dxchan) { next unless $dxchan->is_user; @@ -602,6 +607,8 @@ sub process $dxchan->prompt() if $dxchan->{state} =~ /^prompt/o; $dxchan->t($t); } + ++$users; + $maxusers = $users if $users > $maxusers; } while (my ($k, $v) = each %nothereslug) { @@ -692,7 +699,7 @@ sub broadcast # gimme all the users sub get_all { - return grep {$_->is_user} DXChannel::get_all(); + goto &DXChannel::get_all_users; } # run a script for this user @@ -1304,7 +1311,14 @@ sub spawn_cmd no strict 'refs'; # just behave normally if something has set the "one-shot" _nospawn in the channel - return ($cmdref->(@$args)) if $self->{_nospawn}; + if ($self->{_nospawn}) { + eval { @out = $cmdref->(@$args); }; + if ($@) { + DXDebug::dbgprintring(25); + push @out, DXDebug::shortmess($@); + } + return @out; + } my $fc = Mojo::IOLoop::Subprocess->new; # $fc->serializer(\&encode_json); @@ -1312,13 +1326,17 @@ sub spawn_cmd $fc->run( sub { my $subpro = shift; - if (isdbg('spawn_cmd')) { + if (isdbg('progress')) { my $s = "line: $line"; $s .= ", args: " . join(', ', @$args) if $args && @$args; + dbg($s); + } + eval { @out = $cmdref->(@$args); }; + if ($@) { + DXDebug::dbgprintring(25); + push @out, DXDebug::shortmess($@); } - my @res = $cmdref->(@$args); -# diffms("rcmd from $call 1", $line, $t0, scalar @res) if isdbg('chan'); - return @res; + return @out; }, # $args, sub { @@ -1349,5 +1367,9 @@ sub spawn_cmd return @out; } +sub user_count +{ + return ($users, $maxusers); +} 1; __END__ diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 634bf972..947923f2 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -52,14 +52,14 @@ if (!defined $DB::VERSION) { local $^W=0; eval qq( sub confess { \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::dbgprintring() if DXDebug('nologchan'); + DXDebug::dbgprintring() if DXDebug::isdbg('nologchan'); DXDebug::dbg(\$@); DXDebug::dbg(Carp::shortmess(\@_)); exit(-1); } sub croak { \$SIG{__DIE__} = 'DEFAULT'; - DXDebug::dbgprintring() if DXDebug('nologchan'); + DXDebug::dbgprintring() if DXDebug::isdbg('nologchan'); DXDebug::dbg(\$@); DXDebug::dbg(Carp::longmess(\@_)); exit(-1); @@ -217,16 +217,18 @@ sub longmess sub dbgprintring { return unless $fp; - my $count = shift || $dbgringlth+1; + my $count = shift; my $first; my $l; - for ( ; $count > 0 && ($l = shift @dbgring); --$count) { - my ($t, $str) = split /\^/, $l, 2; + my $i = defined $count ? @dbgring-$count : 0; + $count = @dbgring; + for ( ; $i < $count; ++$i) { + my ($t, $str) = split /\^/, $dbgring[$i], 2; next unless $t; my $lt = time; unless ($first) { $fp->writeunix($lt, "$lt^###"); - $fp->writeunix($lt, "$lt^### RINGBUFFER START"); + $fp->writeunix($lt, "$lt^### RINGBUFFER START at line $i (zero base)"); $fp->writeunix($lt, "$lt^###"); $first = $t; } diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 6d20b887..1f631120 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -1218,21 +1218,31 @@ sub spawn_cmd my $fc = Mojo::IOLoop::Subprocess->new; # just behave normally if something has set the "one-shot" _nospawn in the channel - return ($cmdref->(@$args)) if $self->{_nospawn}; + if ($self->{_nospawn}) { + eval { @out = $cmdref->(@$args); }; + if ($@) { + DXDebug::dbgprintring(25); + push @out, DXDebug::shortmess($@); + } + return @out; + } # $fc->serializer(\&encode_json); # $fc->deserializer(\&decode_json); $fc->run( sub { my $subpro = shift; - if (isdbg('chan')) { + if (isdbg('progress')) { my $s = "line: $line"; $s .= ", args: " . join(', ', @$args) if $args && @$args; + dbg($s); } - - my @res = $cmdref->(@$args); -# diffms("by $call 1", $line, $t0, scalar @res) if isdbg('chan'); - return @res; + eval { @out = $cmdref->(@$args); }; + if ($@) { + DXDebug::dbgprintring(25); + push @out, DXDebug::shortmess($@); + } + return @out; }, # $args, sub { diff --git a/perl/Messages b/perl/Messages index 625fd5ee..6c5f529b 100644 --- a/perl/Messages +++ b/perl/Messages @@ -34,6 +34,7 @@ package DXM; chatinst => 'Entering Chatmode on $_[0], /EX to end, / to run a command', chatprompt => 'Chat ($_[0])>', chattoomany => 'Not allowed, already in $_[1], use /chat $_[0]', + cluster => ' Nodes: $_[0] / $_[1] total Users: $_[2] / $_[3] total Max Users: $_[4] / $_[5] total\nUptime: $_[6]', conother => 'Sorry $_[0] you are connected to me on another port', concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster (on $_[1])', contomany => 'Sorry $_[0] but you are already connected to $_[1] other nodes (on $_[2])', diff --git a/perl/Route.pm b/perl/Route.pm index c43fd34d..6c8c44a8 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -270,11 +270,14 @@ sub cluster { my $nodes = Route::Node::count(); my $tot = Route::User::count(); - my $users = scalar DXCommandmode::get_all(); + my ($users, $maxlocalusers) = DXCommandmode::user_count(); my $maxusers = Route::User::max(); my $uptime = main::uptime(); + my $localnodes = $DXChannel::count - $users; + + return ($nodes, $tot, $users, $maxlocalusers, $maxusers, $uptime, $localnodes); + - return " $nodes nodes, $users local / $tot total users Max users $maxusers Uptime $uptime"; } # -- 2.43.0