328 lines
8.0 KiB
Perl
328 lines
8.0 KiB
Perl
#!/usr/bin/perl
|
|
|
|
package JMX::Jmx4Perl::J4psh;
|
|
|
|
use JMX::Jmx4Perl::J4psh::CompletionHandler;
|
|
use JMX::Jmx4Perl::J4psh::ServerHandler;
|
|
use JMX::Jmx4Perl::J4psh::CommandHandler;
|
|
use JMX::Jmx4Perl::J4psh::Shell;
|
|
use JMX::Jmx4Perl::Request;
|
|
use JMX::Jmx4Perl;
|
|
use Data::Dumper;
|
|
use strict;
|
|
|
|
=head1 NAME
|
|
|
|
JMX::Jmx4Perl::J4psh - Central object for the JMX shell j4psh
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $self = ref($_[0]) eq "HASH" ? $_[0] : { @_ };
|
|
bless $self,(ref($class) || $class);
|
|
$self->init();
|
|
return $self;
|
|
}
|
|
|
|
sub init {
|
|
my $self = shift;
|
|
$self->{complete} = new JMX::Jmx4Perl::J4psh::CompletionHandler($self);
|
|
$self->{servers} = new JMX::Jmx4Perl::J4psh::ServerHandler($self);
|
|
$self->{shell} = new JMX::Jmx4Perl::J4psh::Shell(config => $self->config->{shell},args => $self->args);;
|
|
my $no_color_prompt = $self->{shell}->readline ne "Term::ReadLine::Gnu";
|
|
$self->{commands} = new JMX::Jmx4Perl::J4psh::CommandHandler($self,$self->{shell},
|
|
no_color_prompt => $no_color_prompt,
|
|
command_packages => $self->command_packages);
|
|
}
|
|
|
|
sub command_packages {
|
|
return [ "JMX::Jmx4Perl::J4psh::Command" ];
|
|
}
|
|
|
|
sub run {
|
|
my $self = shift;
|
|
$self->{shell}->run;
|
|
}
|
|
|
|
sub config {
|
|
return shift->{config};
|
|
}
|
|
|
|
sub args {
|
|
return shift->{args};
|
|
}
|
|
|
|
sub complete {
|
|
return shift->{complete};
|
|
}
|
|
|
|
sub commands {
|
|
return shift->{commands};
|
|
}
|
|
|
|
sub servers {
|
|
return shift->{servers};
|
|
}
|
|
|
|
sub server {
|
|
return shift->{servers}->{server};
|
|
}
|
|
|
|
sub color {
|
|
return shift->{shell}->color(@_);
|
|
}
|
|
|
|
sub term_height {
|
|
return shift->{shell}->term_height;
|
|
}
|
|
|
|
sub term_width {
|
|
return shift->{shell}->term_width;
|
|
}
|
|
|
|
sub agent {
|
|
my $self = shift;
|
|
my $agent = shift;
|
|
if (defined($agent)) {
|
|
$self->{agent} = $agent;
|
|
}
|
|
return $self->{agent};
|
|
}
|
|
|
|
sub last_error {
|
|
my $self = shift;
|
|
my $error = shift;
|
|
if (defined($error)) {
|
|
if (length($error)) {
|
|
$self->{last_error} = $error;
|
|
} else {
|
|
delete $self->{last_error};
|
|
}
|
|
}
|
|
return $self->{last_error};
|
|
}
|
|
|
|
sub create_agent {
|
|
my $self = shift;
|
|
my $args = shift;
|
|
my $j4p = new JMX::Jmx4Perl($args);
|
|
$self->load_list($j4p);
|
|
$self->_legacy_check($j4p);
|
|
$self->agent($j4p);
|
|
return $j4p;
|
|
}
|
|
|
|
sub load_list {
|
|
my $self = shift;
|
|
my $j4p = shift;
|
|
|
|
my $old_list = $self->{list};
|
|
eval {
|
|
my $req = new JMX::Jmx4Perl::Request(LIST);
|
|
$self->{list} = $self->request($req,$j4p);
|
|
($self->{mbeans_by_domain},$self->{mbeans_by_name}) = $self->_prepare_mbean_names($j4p,$self->{list});
|
|
};
|
|
if ($@) {
|
|
$self->{list} = $old_list;
|
|
die $@;
|
|
}
|
|
};
|
|
|
|
sub _legacy_check {
|
|
my $self = shift;
|
|
my $j4p = shift;
|
|
my $resp = $j4p->version;
|
|
my $version = $resp->{agent};
|
|
$version =~ s/^(\d+(\.\d+)).*$/$1/;
|
|
if ($version < 1.0) {
|
|
$j4p->cfg('legacy-escape',1);
|
|
}
|
|
}
|
|
|
|
sub list {
|
|
|
|
return shift->{list};
|
|
}
|
|
|
|
sub mbeans_by_domain {
|
|
return shift->{mbeans_by_domain};
|
|
}
|
|
|
|
sub mbeans_by_name {
|
|
return shift->{mbeans_by_name};
|
|
}
|
|
|
|
sub search_mbeans {
|
|
my $self = shift;
|
|
my $pattern = shift;
|
|
$pattern = quotemeta($pattern);
|
|
$pattern =~ s/\\?\*/.*/g;
|
|
my @ret = ();
|
|
my $mbeans_by_name = $self->mbeans_by_name();
|
|
for my $name (sort keys %$mbeans_by_name) {
|
|
push @ret,$mbeans_by_name->{$name} if $name =~ /$pattern/
|
|
}
|
|
return \@ret;
|
|
}
|
|
|
|
sub request {
|
|
my $self = shift;
|
|
my $request = shift;
|
|
my $j4p = shift || $self->agent;
|
|
|
|
my $response = $j4p->request($request);
|
|
if ($response->is_error) {
|
|
#print Dumper($response);
|
|
if ($response->status == 404) {
|
|
die "No agent running [Not found: ",$request->{mbean},",",$request->{operation},"].\n"
|
|
} else {
|
|
$self->{last_error} = $response->{error} .
|
|
($response->stacktrace ? "\nStacktrace:\n" . $response->stacktrace : "");
|
|
die $self->_prepare_error_message($response) . ".\n";
|
|
}
|
|
}
|
|
return $response->value;
|
|
}
|
|
|
|
sub _prepare_error_message {
|
|
my $self = shift;
|
|
my $resp = shift;
|
|
my $st = $resp->stacktrace;
|
|
return "Connection refused" if $resp->{error} =~ /Connection\s+refused/i;
|
|
|
|
if ($resp->{error} =~ /^(\d{3} [^\n]+)\n/m) {
|
|
return $1;
|
|
}
|
|
return "Server Error: " . $resp->{error};
|
|
}
|
|
|
|
|
|
sub name {
|
|
return "j4psh";
|
|
}
|
|
|
|
|
|
# =========================================
|
|
|
|
|
|
sub _prepare_mbean_names {
|
|
my $self = shift;
|
|
my $j4p = shift;
|
|
my $list = shift;
|
|
my $mbeans_by_name = {};
|
|
my $mbeans_by_domain = {};
|
|
for my $domain (keys %$list) {
|
|
for my $name (keys %{$list->{$domain}}) {
|
|
my $full_name = $domain . ":" . $name;
|
|
|
|
my $e = {};
|
|
my ($domain_p,$props) = $j4p->parse_name($full_name,1);
|
|
$e->{domain} = $domain;
|
|
$e->{props} = $props;
|
|
$e->{info} = $list->{$domain}->{$name};
|
|
my $keys = $self->_canonical_ordered_keys($props);
|
|
$e->{string} = join ",", map { $_ . "=" . $props->{$_ } } @$keys;
|
|
$e->{prompt} = length($e->{string}) > 25 ? $self->_prepare_prompt($props,25,$keys) : $e->{string};
|
|
$e->{full} = $full_name;
|
|
|
|
$mbeans_by_name->{$full_name} = $e;
|
|
my $k_v = $mbeans_by_domain->{$domain} || [];
|
|
push @$k_v,$e;
|
|
$mbeans_by_domain->{$domain} = $k_v;
|
|
}
|
|
}
|
|
return ($mbeans_by_domain,$mbeans_by_name);
|
|
}
|
|
|
|
# Order keys according to importance first and the alphabetically
|
|
my @PREFERED_PROPS = qw(name type service);
|
|
sub _order_keys {
|
|
my $self = shift;
|
|
my $props = shift;
|
|
|
|
# Get additional properties, not known to the prefered ones
|
|
my $extra = { map { $_ => 1 } keys %$props };
|
|
my @ret = ();
|
|
for my $p (@PREFERED_PROPS) {
|
|
if (exists($props->{$p})) {
|
|
push @ret,$p;
|
|
delete $extra->{$p};
|
|
}
|
|
}
|
|
push @ret,sort keys %{$extra};
|
|
return \@ret;
|
|
}
|
|
|
|
# Canonical ordered means lexically sorted
|
|
sub _canonical_ordered_keys {
|
|
my $self = shift;
|
|
my $props = shift;
|
|
return [ sort keys %{$props} ];
|
|
}
|
|
|
|
# Prepare property part of a mbean suitable for using in
|
|
# a shell prompt
|
|
sub _prepare_prompt {
|
|
my $self = shift;
|
|
my $props = shift;
|
|
my $max = shift;
|
|
my $keys = shift;
|
|
my $len = $max - 3;
|
|
my $ret = "";
|
|
|
|
for my $k (@$keys) {
|
|
if (exists($props->{$k})) {
|
|
my $p = $k . "=" . $props->{$k};
|
|
if (!length($ret)) {
|
|
$ret = $p;
|
|
if (length($ret) > $max) {
|
|
return substr($ret,0,$len) . "...";
|
|
}
|
|
} else {
|
|
if (length($ret) + length($p) > $len) {
|
|
return $ret . ", ...";
|
|
} else {
|
|
$ret .= "," . $p;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
=head1 LICENSE
|
|
|
|
This file is part of jmx4perl.
|
|
|
|
Jmx4perl is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
jmx4perl is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with jmx4perl. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
A commercial license is available as well. Please contact roland@cpan.org for
|
|
further details.
|
|
|
|
=head1 PROFESSIONAL SERVICES
|
|
|
|
Just in case you need professional support for this module (or Nagios or JMX in
|
|
general), you might want to have a look at
|
|
http://www.consol.com/opensource/nagios/. Contact roland.huss@consol.de for
|
|
further information (or use the contact form at http://www.consol.com/contact/)
|
|
|
|
=head1 AUTHOR
|
|
|
|
roland@cpan.org
|
|
|
|
=cut
|
|
|
|
1;
|