debmon/jmx4perl
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Imported Upstream version 1.12

Browse Source
This commit is contained in:
Mario Fetka
2017-10-31 14:38:28 +01:00
commit ae1fc8494f
157 changed files with 35016 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

322
lib/JMX/Jmx4Perl/Agent/Jolokia/ArtifactHandler.pm Normal file
View File

@@ -0,0 +1,322 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::ArtifactHandler;
=head1 NAME
JMX::Jmx4Perl::Agent::ArtifactHandler - Handler for extracting and manipulating
Jolokia artifacts
=head1 DESCRIPTION
This module is responsible for mangaging a singe JAR or WAR Archive. It
requires L<Archive::Zip> for proper operation.
I.e. this module can
=over
=item *
Extract jolokia-access.xml and web.xml from WAR/JAR archives
=item *
Check for the esistance of jolokia-access.xml
=item *
Update web.xml for WAR files
=back
=cut
use Data::Dumper;
use strict;
use vars qw($HAS_ARCHIVE_ZIP $GLOBAL_ERROR);
BEGIN {
$HAS_ARCHIVE_ZIP = eval "require Archive::Zip; Archive::Zip->import(qw(:ERROR_CODES)); 1";
if ($HAS_ARCHIVE_ZIP) {
Archive::Zip::setErrorHandler( sub {
$GLOBAL_ERROR = join " ",@_;
chomp $GLOBAL_ERROR;
} );
}
}
=head1 METHODS
=over 4
=item $handler = JMX::Jmx4Perl::Agent::Jolokia::ArtifactHandler->new(...)
Create a new handler with the following options:
file => $file : Path to archive to handle
logger => $logger : Logger to use
meta => $meta : Jolokia-Meta handler to extract the type of an archive
=cut
sub new {
my $class = shift;
my %args = @_;
my $file = $args{file};
my $self = { file => $file, logger => $args{logger}, meta => $args{meta}};
bless $self,(ref($class) || $class);
$self->_fatal("No Archive::Zip found. Please install it for handling Jolokia archives.") unless $HAS_ARCHIVE_ZIP;
$self->_fatal("No file given") unless $file;
$self->_fatal("No such file $file") unless -e $file;
return $self;
}
=item $info = $handler->info()
Extract information about an archive. Return value is a has with the following
keys:
"version" Agent's version
"type" Agent type (war, osgi, osgi-bundle, mule, jdk6)
"artifactId" Maven artifact id
"groupId" Maven group Id
=cut
sub info {
my $self = shift;
my $file = $self->{file};
my $jar = $self->_read_archive();
my @props = $jar->membersMatching('META-INF/maven/org.jolokia/.*?/pom.properties');
$self->_fatal("Cannot extract pom.properties from $file") unless @props;
for my $prop (@props) {
my ($content,$status) = $prop->contents;
$self->_fatal("Cannot extract pom.properties: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
my $ret = {};
for my $l (split /\n/,$content) {
next if $l =~ /^\s*#/;
my ($k,$v) = split /=/,$l,2;
$ret->{$k} = $v;
}
$self->_fatal("$file is not a Jolokia archive") unless $ret->{groupId} eq "org.jolokia" ;
my $type;
if ($self->{meta}->initialized()) {
$type = $self->{meta}->extract_type($ret->{artifactId});
} else {
$type = $self->_detect_type_by_heuristic($ret->{artifactId});
}
if ($type) {
$ret->{type} = $type;
return $ret;
}
}
return {};
}
=item $handler->add_policy($policy)
Add or update the policy given as string to this archive. Dependening on
whether it is a WAR or another agent, it is put into the proper place
For "war" agents, this is F<WEB-INF/classes/jolokia-access.xml>, for all others
it is F</jolokia-access.xml>
=cut
sub add_policy {
my $self = shift;
my $policy = shift;
my $file = $self->{file};
$self->_fatal("No such file $policy") unless -e $policy;
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
my $existing = $jar->removeMember($path);
my $res = $jar->addFile($policy,$path);
$self->_fatal("Cannot add $policy to $file as ",$path,": ",$GLOBAL_ERROR) unless $res;
my $status = $jar->overwrite();
$self->_fatal("Cannot write $file: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
$self->_info($existing ? "Replacing existing policy " : "Adding policy ","[em]",$path,"[/em]",$existing ? " in " : " to ","[em]",$file,"[/em]");
}
=item $handler->remove_policy()
Remove a policy file (no-op, when no policy is present)
=cut
sub remove_policy {
my $self = shift;
my $file = $self->{file};
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
my $existing = $jar->removeMember($path);
if ($existing) {
my $status = $jar->overwrite();
$self->_fatal("Cannot write $file: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
$self->_info("Removing policy","[em]",$path,"[/em]"," in ","[em]",$file,"[/em]");
} else {
$self->_info("No policy found, leaving ","[em]",$file,"[/em]"," untouched.");
}
}
=item $handler->has_policy()
Returns true (i.e. the path to the policy file) if a policy file is contained,
C<undef> otherwise.
=cut
sub has_policy {
my $self = shift;
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
return $jar->memberNamed($path) ? $path : undef;
}
=item $handler->get_policy()
Get the policy file as string or C<undef> if no policy is contained.
=cut
sub get_policy {
my $self = shift;
my $jar = $self->_read_archive();
my $path = $self->_policy_path;
return $jar->contents($path);
}
=item $handler->extract_webxml()
Extract F<web.xml> from WAR agents, for other types, a fatal error is
raised. Return value is a string containing the web.xml.
=cut
sub extract_webxml {
my $self = shift;
my $type = $self->type;
$self->_fatal("web.xml can only be read from 'war' archives (not '",$type,"')") unless $type eq "war";
my $jar = $self->_read_archive();
return $jar->contents("WEB-INF/web.xml");
}
=item $handler->update_webxml($webxml)
Update F<web.xml> in WAR agents, for other types, a fatal error is
raised. Return value is a string containing the web.xml. C<$webxml> is the
descriptor as a string.
=cut
sub update_webxml {
my $self = shift;
my $webxml = shift;
my $type = $self->type;
$self->_fatal("web.xml can only be updated in 'war' archives (not '",$type,"')") unless $type eq "war";
my $jar = $self->_read_archive();
$jar->removeMember("WEB-INF/web.xml");
my $res = $jar->addString($webxml,"WEB-INF/web.xml");
$self->_fatal("Cannot update WEB-INF/web.xml: ",$GLOBAL_ERROR) unless $res;
my $status = $jar->overwrite();
$self->_fatal("Cannot write ",$self->{file},": ",$GLOBAL_ERROR) unless $status eq AZ_OK();
$self->_info("Updated ","[em]","web.xml","[/em]"," for ",$self->{file});
}
=item $handler->type()
Return the agent's type, which is one of "war", "osgi", "osgi-bundle", "mule"
or "jdk6"
=cut
sub type {
my $self = shift;
my $info = $self->info;
return $info->{type};
}
=back
=cut
# ========================================================================
sub _detect_type_by_heuristic {
my $self = shift;
my $artifact_id = shift;
return {
"jolokia-osgi" => "osgi",
"jolokia-mule" => "mule",
"jolokia-osgi-bundle" => "osgi-bundle",
"jolokia-jvm-jdk6" => "jdk6",
"jolokia-jvm" => "jvm",
"jolokia-war" => "war"
}->{$artifact_id};
}
sub _read_archive {
my $self = shift;
my $file = $self->{file};
my $jar = new Archive::Zip();
my $status = $jar->read($file);
$self->_fatal("Cannot read content of $file: ",$GLOBAL_ERROR) unless $status eq AZ_OK();
return $jar;
}
sub _policy_path {
my $self = shift;
return ($self->type eq "war" ? "WEB-INF/classes/" : "") . "jolokia-access.xml";
}
sub _fatal {
my $self = shift;
$self->{logger}->error(@_);
die "\n";
}
sub _info {
my $self = shift;
$self->{logger}->info(@_);
}
=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 AUTHOR
roland@cpan.org
=cut
1;

150
lib/JMX/Jmx4Perl/Agent/Jolokia/DownloadAgent.pm Normal file
View File

@@ -0,0 +1,150 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent;
use base qw(LWP::UserAgent);
use Data::Dumper;
use vars qw($HAS_PROGRESS_BAR $HAS_TERM_READKEY);
use strict;
BEGIN {
$HAS_PROGRESS_BAR = eval "require Term::ProgressBar; 1";
$HAS_TERM_READKEY = eval "require Term::ReadKey; 1";
}
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent - Specialized L<LWP::UserAgent>
adding some bells and whistles for downloading agents and other stuff.
=head1 DESCRIPTION
User agent for Jolokia artifact downloading. It decorates a regular User Agent
with a download bar and allows for proxy handling and authentication. For a
progress bar, the optional module L<Term::ProgressBar> must be installed.
=head1 METHODS
=over 4
=item $ua = JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent->new(%args)
Create a new user agent, a subclass fro L<LWP::UserAgent>
Options:
"http_proxy" HTTP Proxy to use
"https_proxy" HTTPS Proxy to use
"quiet" If true, dont show progressbar
"proxy_user" Proxy user for proxy authentication
"proxy_password" Proxy password for proxy authentication
=back
=cut
sub new {
my $class = shift;
my %cfg = ref($_[0]) eq "HASH" ? %{$_[0]} : @_;
my $self = LWP::UserAgent::new($class,%cfg);
bless $self,(ref($class) || $class);
# Proxy setting
$self->env_proxy;
$self->proxy("http",$cfg{http_proxy}) if $cfg{http_proxy};
$self->proxy("https",$cfg{https_proxy}) if $cfg{https_proxy};
$self->agent("Jolokia Download Agent/" . $JMX::Jmx4Perl::VERSION);
$self->{show_progress} = !$cfg{quiet};
return $self;
}
# Overwriting progress in order to show a progressbar or not
sub progress {
my($self, $status, $m) = @_;
return unless $self->{show_progress};
# Use default progress bar if no progress is given
unless ($HAS_PROGRESS_BAR) {
$self->SUPER::progress($status,$m);
return;
}
if ($status eq "begin") {
$self->{progress_bar} = undef;
} elsif ($status eq "end") {
my $progress = delete $self->{progress_bar};
my $next = delete $self->{progress_next};
$progress->update(1) if defined($next) && 1 >= $next;
} elsif ($status eq "tick") {
# Unknown length (todo: probably better switch to the default behaviour
# in SUPER::progress())
my $progress = $self->_progress_bar($m->filename,undef);
$progress->update();
} else {
# Status contains percentage
my $progress = $self->_progress_bar($m->filename,1);
# print $status," ",$HAS_PROGRESS_BAR,"\n";
$self->{progress_next} = $progress->update($status)
if $status >= $self->{progress_next};
}
}
sub _progress_bar {
my $self = shift;
my $name = shift;
my $count = shift;
my $progress = $self->{progress_bar};
unless ($progress) {
no strict;
local (%SIG);
$progress = new Term::ProgressBar({
name => " " . $name,
count => $count,
remove => 1,
ETA => linear,
!$HAS_TERM_READKEY ? (term_width => 120) : ()
}
);
#$progress->minor(1);
$progress->max_update_rate(1);
$self->{progress_bar} = $progress;
}
return $progress;
}
# Get an optional proxy user
sub get_basic_credentials {
my ($self, $realm, $uri, $isproxy) = @_;
if ($isproxy && $self->{proxy_user}) {
return ($self->{proxy_user},$self->{proxy_password});
} else {
return (undef,undef);
}
}
=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 AUTHOR
roland@cpan.org
=cut
1;

167
lib/JMX/Jmx4Perl/Agent/Jolokia/Logger.pm Normal file
View File

@@ -0,0 +1,167 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Logger;
use vars qw($HAS_COLOR);
use strict;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Logger - Simple logging abstraction for the
Jolokia agent manager
=head1 DESCRIPTION
Simple Logger used throughout 'jolokia' and its associated modules for
output. It knows about coloring and a quiet mode, where no output is generated
at all.
=cut
BEGIN {
$HAS_COLOR = eval "require Term::ANSIColor; Term::ANSIColor->import(qw(:constants)); 1";
}
=head1 METHODS
=over 4
=item $logger = JMX::Jmx4Perl::Agent::Jolokia::Logger->new(quiet=>1,color=>1)
Creates a logger. Dependening on the options (C<quiet> and C<color>) output can
be supressed completely or coloring can be used. Coloring only works, if the
Module L<Term::ANSIColor> is available (which is checked during runtime).
=cut
sub new {
my $class = shift;
my $self = ref($_[0]) eq "HASH" ? $_[0] : { @_ };
my $quiet = delete $self->{quiet};
$HAS_COLOR &&= $self->{color};
# No-op logger
return new JMX::Jmx4Perl::Agent::Jolokia::Logger::None
if $quiet;
bless $self,(ref($class) || $class);
}
=item $log->debug("....");
Debug output
=cut
sub debug {
my $self = shift;
if ($self->{debug}) {
print "+ ",join("",@_),"\n";
}
}
=item $log->info("....","[em]","....","[/em]",...);
Info output. The tag "C<[em]>" can be used to higlight a portion of the
output. The tag must be provided in an extra element in the given list.
=cut
sub info {
my $self = shift;
my $text = $self->_resolve_color(@_);
my ($cs,$ce) = $HAS_COLOR ? (DARK . CYAN,RESET) : ("","");
print $cs . "*" . $ce . " " . $text . "\n";
}
=item $log->warn(...)
Warning output (printed in yellow)
=cut
sub warn {
my $self = shift;
my $text = join "",@_;
my ($cs,$ce) = $HAS_COLOR ? (YELLOW,RESET) : ("","");
print $cs. "! " . $text . $ce ."\n";
}
=item $log->warn(...)
Error output (printed in red)
=cut
sub error {
my $self = shift;
my $text = join "",@_;
my ($cs,$ce) = $HAS_COLOR ? (RED,RESET) : ("","");
print $cs . $text . $ce . "\n";
}
sub _resolve_color {
my $self = shift;
return join "",map {
if (lc($_) eq "[em]") {
$HAS_COLOR ? GREEN : ""
} elsif (lc($_) eq "[/em]") {
$HAS_COLOR ? RESET : ""
} else {
$_
}} @_;
}
=back
=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 AUTHOR
roland@cpan.org
=cut
package JMX::Jmx4Perl::Agent::Jolokia::Logger::None;
use base qw(JMX::Jmx4Perl::Agent::Jolokia::Logger);
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Logger::None - No-op logger
=head1 DESCRIPTION
No-op logger used when quiet mode is switched on. Doesn't print
out anything.
=cut
sub info { }
sub warn { }
sub error { }
sub debug { }
1;

379
lib/JMX/Jmx4Perl/Agent/Jolokia/Meta.pm Normal file
View File

@@ -0,0 +1,379 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Meta;
use JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent;
use JMX::Jmx4Perl::Agent::Jolokia::Logger;
use JMX::Jmx4Perl::Agent::Jolokia::Verifier;
use JSON;
use Data::Dumper;
use base qw(LWP::UserAgent);
use strict;
my $JOLOKIA_META_URL = "http://www.jolokia.org/jolokia.meta";
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Meta - Fetches, caches and parses Meta data from
www.jolokia.org
=head1 DESCRIPTION
This class is responsible for fetching meta data about available agents from
Jolokia. It knows how to parse those meta data and caches it for subsequent
usage in the local file system.
=head1 METHODS
=over 4
=item $meta = JMX::Jmx4Perl::Agent::Jolokia::Meta->new(....)
Create a new meta object which handles downloading of Jolokia meta information
and caching this data.
=cut
sub new {
my $class = shift;
my $self = ref($_[0]) eq "HASH" ? $_[0] : { @_ };
# Dummy logging if none is provided
$self->{logger} = new JMX::Jmx4Perl::Agent::Jolokia::Logger::None unless $self->{logger};
$self->{verifier} = new JMX::Jmx4Perl::Agent::Jolokia::Verifier(logger => $self->{logger},ua_config => $self->{ua_config});
return bless $self,(ref($class) || $class);
}
=item $meta->load($force)
Load the meta data from the server or retrieve it from the cache. The data is
taken from the cache, if it is no older than $self->{cache_interval} seconds.
If $force is given and true, the data is always fetched fresh from the server.
This method return $self so that it can be used for chaining. Any error or
progress infos are given through to the C<log_handler> provided during
construction time. This method will return C<undef> if the data can't be
loaded.
=cut
sub load {
my ($self,$force) = @_;
$force = $self->{force_load} unless defined($force);
my $meta_json;
my $cached = undef;
if (!$force) {
$meta_json = $self->_from_cache;
$cached = 1 if $meta_json;
}
$meta_json = $self->_load_from_server unless $meta_json; # Throws an error
# if it can't be
# loaded
return undef unless $meta_json;
$self->_to_cache($meta_json) unless $cached;
$self->{_meta} = $meta_json;
return $self;
}
=item $meta->initialized()
Returns C<true> if the meta data has been initialized, either by loading it or
by using a cached data. If false the data can be loaded via L<load>
=cut
sub initialized {
my $self = shift;
return defined($self->{_meta});
}
=item $value = $meta->get($key)
Get a value from the meta data.
=cut
sub get {
my $self = shift;
my $key = shift;
$self->_fatal("No yet loaded") unless $self->{_meta};
return $self->{_meta}->{$key};
}
=item $jolokia_version = $meta->latest_matching_version($jmx4perl_version)
Get the latest matching Jolokia version for a given Jmx4Perl version
=cut
sub latest_matching_version {
my $self = shift;
my $jmx4perl_version = shift;
# Iterate over all existing versions, starting from the newest one,
# and return the first matching
my $version_info = $self->get("versions");
for my $v (sort { $self->compare_versions($b,$a) } grep { $_ !~ /-SNAPSHOT$/ } keys %$version_info) {
my $range = $version_info->{$v}->{jmx4perl};
if ($range) {
my $match = $self->_check_version($jmx4perl_version,$range);
#print "Match: $match for $range (j4p: $jmx4perl_version)\n";
return $v if $match;
}
}
return undef;
}
# Compare two version which can contain one, two or more digits. Returns <0,0 or
# >0 if the first version is smaller, equal or larger than the second version.
# It doesn't take into account snapshot
sub compare_versions {
my $self = shift;
my @first = _split_version(shift);
my @second = _split_version(shift);
my $len = $#first < $#second ? $#first : $#second;
for my $i (0 ... $len) {
next if $first[$i] == $second[$i];
return $first[$i] - $second[$i];
}
return $#first - $#second;
}
sub _split_version {
my $v = shift;
$v =~ s/-.*$//;
return split /\./,$v;
}
sub _check_version {
my $self = shift;
my $jmx4perl_version = shift;
my $range = shift;
my ($l,$l_v,$u_v,$u) = ($1,$2,$3,$4) if $range =~ /^\s*([\[\(])\s*([\d\.]+)\s*,\s*([\d\.]+)\s*([\)\]])\s*$/;
if ($l_v) {
my $cond = "\$a " . ($l eq "[" ? ">=" : ">"). $l_v . " && \$a" . ($u eq "]" ? "<=" : "<") . $u_v;
my $a = $jmx4perl_version;
return eval $cond;
}
return undef;
}
=item $meta->versions_compatible($jmx4perl_version,$jolokia_version)
Check, whether the Jolokia and Jmx4Perl versions are compaptible, i.e.
whether Jmx4Perl with the given version can interoperate with the given
Jolokia version
=cut
sub versions_compatible {
my $self = shift;
my $jmx4perl_version = shift;
my $jolokia_version = shift;
my $version_info = $self->get("versions");
my $range = $version_info->{$jolokia_version}->{jmx4perl};
if ($range) {
return $self->_check_version($jmx4perl_version,$range);
} else {
return undef;
}
}
=item $type = $meta->extract_type($artifact_name)
Extract the type for a given artifactId
=cut
sub extract_type {
my $self = shift;
my $artifact = shift;
my $mapping = $self->get("mapping");
for my $k (keys %$mapping) {
return $k if $mapping->{$k}->[0] eq $artifact;
}
return undef;
}
=item $meta->template_url($template_name,$version)
Download a template with the given name. The download URL is looked up
in the meta data. If a version is given, the template for this specific
version is returned (if present, if not the default template is returned).
If no version is given, the default template is returned. The downloaded
template is verified as any other downloaded artifact.
The template is returned as a string.
=cut
sub template_url {
my $self = shift;
my $template = shift;
my $version = shift;
my $url;
if ($version) {
my $version_info = $self->get("versions");
my $v_data = $version_info->{$version};
$self->_fatal("Cannot load template $template for version $version since $version is unknown")
unless $v_data;
my $templs = $v_data->{templates};
if ($templs) {
$url = $templs->{$template};
}
}
unless ($url) {
my $templs = $self->get("templates");
$self->_fatal("No templates defined in jolokia.meta") unless $templs;
$url = $templs->{$template};
}
return $url;
}
=back
=cut
# ===================================================================================
# Fetch from cache, but only if the cache file is older than $cache_interval
# seconds back in time
sub _from_cache {
my $self = shift;
my $cache_interval = $self->{cache_interval} || 12 * 60 * 60; # 12h by default
my $cache_file = $self->{cache_file} || $ENV{HOME} . "/.jolokia_meta";
my $mtime = (stat($cache_file))[9];
if ($mtime && $mtime >= time - $cache_interval) {
if (!open(F,$cache_file)) {
$self->_error("Cannot open $cache_file: $!");
return undef;
}
my $ret = join "",<F>;
close F;
$self->_debug("Loaded Jolokia meta data from cache");
return from_json($ret,{utf8 => 1});
} else {
return undef;
}
}
# Store to cache
sub _to_cache {
my $self = shift;
my $meta = shift;
my $cache_file = $self->{cache_file} || $ENV{HOME} . "/.jolokia_meta";
if (!open(F,">$cache_file")) {
$self->_error("Cannot save $cache_file: $!");
return;
}
print F to_json($meta,{utf8 => 1,pretty => 1});
close F;
}
# Load from server
sub _load_from_server {
my $self = shift;
# Create sample meta-data
return $self->_example_meta if ($ENV{USE_SAMPLE_JOLOKIA_META});
# Load with HTTP-Client, hardcoded for now
$self->_info("Loading Jolokia meta data from $JOLOKIA_META_URL");
my $ua = new JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent($self->{ua_config});
my $response = $ua->get($JOLOKIA_META_URL);
if ($response->is_success) {
my $content = $response->decoded_content; # or whatever
$self->{verifier}->verify(ua_config => $self->{ua_config}, logger => $self->{logger},
url => $JOLOKIA_META_URL, data => $content);
return from_json($content, {utf8 => 1});
}
else {
# Log an error, but do not exit ...
$self->{logger}->error("Cannot load Jolokia Meta-Data from $JOLOKIA_META_URL: " . $response->status_line);
return undef;
}
}
# Do something with errors and info messages
sub _debug {
shift->{logger}->debug(@_);
}
sub _error {
my $self = shift;
$self->{logger}->error(@_);
}
sub _fatal {
my $self = shift;
$self->{logger}->error(@_);
die "\n";
}
sub _info {
my $self = shift;
$self->{logger}->info(@_);
}
# Sample meta data, also used for creating site meta data.
sub _example_meta {
return {
repositories => [
"http://labs.consol.de/maven/repository"
],
'snapshots-repositories' => [
"http://labs.consol.de/maven/snapshots-repository"
],
versions => {
"0.90-SNAPSHOT" => { jmx4perl => "[0.90,1.0)" },
"0.83" => { jmx4perl => "[0.73,1.0)" },
"0.82" => { jmx4perl => "[0.73,1.0)" } ,
"0.81" => { jmx4perl => "[0.73,1.0)" } ,
},
mapping => {
"war" => [ "jolokia-war", "jolokia-war-%v.war", "jolokia.war" ],
"osgi" => [ "jolokia-osgi", "jolokia-osgi-%v.jar", "jolokia.jar" ],
"osgi-bundle" => [ "jolokia-osgi-bundle", "jolokia-osgi-bundle-%v.jar", "jolokia-bundle.jar" ],
"mule" => [ "jolokia-mule", "jolokia-mule-%v.jar", "jolokia-mule.jar" ],
"jdk6" => [ "jolokia-jvm-jdk6", "jolokia-jvm-jdk6-%v-agent.jar", "jolokia.jar" ]
},
templates => {
"jolokia-access.xml" => "http://www.jolokia.org/templates/jolokia-access.xml"
}
};
}
1;
=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 AUTHOR
roland@cpan.org
=cut
1;

162
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier.pm Normal file
View File

@@ -0,0 +1,162 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier;
=head1 NAME
JMX::Jmx4Perl::Agent::Verifier - Handler for various verifiers which picks
the most secure one first.
=head1 DESCRIPTION
Entry module for verification of downloaded artifacts. Depending on modules
installed, various validation mechanisms are tried in decreasing order fo
vialibility:
=over
=item L<Crypt::OpenPGP>
The strongest validation is provided by PGP signatures with which Jolokia
artifact is signed. The verifier uses L<Crypt::OpenPGP> for verifying PGP
signatures.
=item L<Digest::SHA1>
If OpenPGP is not available or when no signature is provided from the Jolokia
site (unlikely), a simple SHA1 checksum is fetched and compared to the artifact
downloaded. This is not secure, but guarantees some degree of consistency.
=item L<Digest::MD5>
As last resort, when this module is availabl, a MD5 checksum is calculated and
compared to the checksum also downloaded from www.jolokia.org.
=back
=head1 METHODS
=over 4
=cut
use Data::Dumper;
use vars qw(@VERIFIERS @WARNINGS);
use strict;
# Pick the verifier, which is the most reliable
BEGIN {
@VERIFIERS = ();
@WARNINGS = ();
my $create = sub {
my $module = shift;
eval "require $module";
die $@ if $@;
my $verifier;
eval "\$verifier = new $module()";
die $@ if $@;
return $verifier;
};
my $prefix = "JMX::Jmx4Perl::Agent::Jolokia::Verifier::";
if (`gpg --version` =~ /GnuPG/m) {
push @VERIFIERS,$create->($prefix . "GnuPGVerifier");
} else {
push @WARNINGS,"No signature verification available. Please install GnupPG.";
}
# Disabled support for OpenPGP since it doesn't support the digest
# algorithm used for signging the jolokia artefacts
# } elsif (eval "requireCrypt::OpenPGP; 1") {
# push @VERIFIERS,$create->($prefix . "OpenPGPVerifier");
push @VERIFIERS,$create->($prefix . "SHA1Verifier") if eval "require Digest::SHA1; 1";
push @VERIFIERS,$create->($prefix . "MD5Verifier") if eval "require Digest::MD5; 1";
}
=item $verifier = JMX::Jmx4Perl::Agent::Jolokia::Verifier->new(%args)
Creates a new verifier. It takes an expanded hash als argument, where the
following keys are respected:
"ua_config" UserAgent configuration used for accessing
remote signatures/checksums
"logger" Logger
=cut
sub new {
my $class = shift;
my $self = {@_};
bless $self,(ref($class) || $class);
}
=item $verifier->verify(url => $url,path => $file)
=item $verifier->verify(url => $url,data => $data)
Verifies the given file (C<path>) or scalar data (C<data>) by trying various
validators in turn. Technically, each validator is asked for an extension
(e.g. ".asc" for a PGP signature), which is appended to URL and this URL is
tried for downloading the signature/checksum. If found, the content of the
signature/checksum is passed to specific verifier along with the data/file to
validate. A verifier will die, if validation fails, so one should put this in
an eval if required. If validation passes, the method returns silently.
=back
=cut
sub verify {
my $self = shift;
my %args = @_;
my $url = $args{url};
my $ua = new JMX::Jmx4Perl::Agent::Jolokia::DownloadAgent($self->{ua_config});
my $log = $self->{logger};
$log->warn($_) for @WARNINGS;
for my $verifier (@VERIFIERS) {
my $ext = $verifier->extension;
if ($ext) {
my $response = $ua->get($url . $ext);
if ($response->is_success) {
my $content = $response->decoded_content;
$verifier->verify(%args,signature => $content,logger => $log);
return;
} else {
$log->warn($verifier->name . ": Couldn't load $url$ext");
}
}
}
$log->warn("No suitable validation mechanism found with $url");
}
=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 AUTHOR
roland@cpan.org
=cut
1;

89
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/ChecksumVerifier.pm Normal file
View File

@@ -0,0 +1,89 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier - Verifies a
checksum for a downloaded artifact.
=head1 DESCRIPTION
This verifier provides the base for simple checksum checking. It needs to be
subclassed to provide the proper extension (e.g. ".sha1") and creating of a
digester.
=cut
use strict;
sub new {
my $class = shift;
my $self = {};
bless $self,(ref($class) || $class);
}
sub extension {
die "abstract";
}
sub name {
die "abstract";
}
sub create_digester {
die "abstract";
}
sub verify {
my $self = shift;
my %args = @_;
my $logger = $args{logger};
my $sig = $args{signature};
chomp $sig;
$sig =~ s/^([^\s]+).*$/$1/;
my $digester = $self->create_digester;
my $file = $args{path};
if ($file) {
open (my $fh, "<", $file) || ($logger->error("Cannot open $file for ",$self->name," check: $!") && die "\n");
$digester->addfile($fh);
close $fh;
} else {
my $data = $args{data};
$digester->add($data);
}
my $sig_calc = $digester->hexdigest;
if (lc($sig) eq lc($sig_calc)) {
$logger->info("Passed ",$self->name," check (" . $sig_calc . ")",($file ? " for file $file" : ""));
} else {
$logger->error("Failed ",$self->name," check. Got: " . $sig_calc . ", Expected: " . $sig);
die "\n";
}
}
=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 AUTHOR
roland@cpan.org
=cut
1;

170
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/GnuPGVerifier.pm Normal file
View File

@@ -0,0 +1,170 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::GnuPGVerifier;
use JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey;
use Module::Find;
use Data::Dumper;
use File::Temp qw/tempfile/;
use strict;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Verifier::GnuPGVerifier - Verifies PGP
signature with a natively installed GnuPG (with gpg found in the path)
=head1 DESCRIPTION
This verifier uses a natively installed GPG for validating a PGP signature
obtained from the download site. It's similar to
L<JMX::Jmx4Perl::Agent::Jolokia::Verifier::OpenPGPVerifier> except that it will
use a locally installed GnuPG installation. Please note, that it will import
the public key used for signature verification into the local keystore.
=cut
sub new {
my $class = shift;
my $self = {};
($self->{gpg},$self->{version}) = &_gpg_version();
bless $self,(ref($class) || $class);
}
sub extension {
return ".asc";
}
sub name {
return "GnuPG";
}
sub verify {
my $self = shift;
my %args = @_;
my $log = $args{logger};
my $gpg = $self->{gpg};
die "Neither 'path' nor 'data' given for specifying the file/data to verify"
unless $args{path} || $args{data};
my $signature_path = $self->_store_tempfile($args{signature});
my $path = $args{path} ? $args{path} : $self->_store_tempfile($args{data});
my @cmd = (
$gpg,
qw(--verify --batch --no-tty -q --logger-fd=1),
);
eval {
push @cmd, $signature_path,$path;
# Unset language for proper parsing of the output independent
# of the locale
local $ENV{LANG} = undef;
my $cmd = join ' ', @cmd;
my $output = `$cmd`;
if ($output =~ /public\s*key/i) {
# Import key and retry
$self->_import_key(\%args);
$output = `$cmd`;
}
$self->_verify_gpg_output($?,$output,\%args);
};
# Always cleanup
my $error = $@;
unlink $signature_path;
unlink $path unless $args{path};
die $error if $error;
}
sub _verify_gpg_output {
my $self = shift;
my $code = shift;
my $output = shift;
my $args = shift;
my $log = $args->{logger};
my $key = $1 if $output =~ /\s+([\dA-F]{8})/;
# print $output,"\n";
if ($code) {
$log->error("Invalid signature",$args->{path} ? " for " . $args->{path} : "",$key ? " (key: $key)" : "");
die "\n";
} else {
$log->info("Good PGP signature" . ($key ? " ($key)" : ""));
}
}
sub _import_key {
my $self = shift;
my $args = shift;
my $gpg = $self->{gpg};
my $log = $args->{logger};
my $key_path = $self->_store_tempfile($JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey::KEY);
my @cmd = ($gpg,qw(--import --verbose --batch --no-tty --logger-fd=1),$key_path);
my $cmd = join ' ', @cmd;
my $output = `$cmd 2>&1`;
if ($?) {
$log->error("Cannot add public PGP used for verification to local keystore: $output");
die "\n";
} else {
#$log->info($output);
my $info = $1 if $output =~ /([\dA-F]{8}.*import.*)$/mi;
$log->info($info ? $info : "Added jmx4perl key");
}
unlink $key_path;
}
sub _gpg_version {
my $gpg = "gpg2";
my $out = `gpg2 --version`;
if ($?) {
$out = `gpg --version`;
$gpg = "gpg";
if ($?) {
die "Cannot find gpg or gpg2: $out\n";
}
}
$out =~ /GnuPG.*?(\S+)\s*$/m;
return ($gpg,$1);
}
sub _store_tempfile {
my $self = shift;
my $sig = shift || die "No data given to store in temp file";
my ($fh,$path) = tempfile();
print $fh $sig;
close $fh;
return $path;
}
1;
=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 AUTHOR
roland@cpan.org
=cut

60
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/MD5Verifier.pm Normal file
View File

@@ -0,0 +1,60 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::MD5Verifier;
use Digest::MD5;
use JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier;
use base qw(JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier);
use strict;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Verifier::MD5Verifier - Verifies a
MD5 checksum
=head1 DESCRIPTION
Verifies against a MD5 checksum for an artifact. The MD5 sum needs to be
available parallel to the download artifact with a ".md5" extension.
=cut
sub extension {
return ".md5";
}
sub name {
return "MD5";
}
sub create_digester {
return new Digest::MD5();
}
=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 AUTHOR
roland@cpan.org
=cut
1;

114
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/OpenPGPVerifier.pm Normal file
View File

@@ -0,0 +1,114 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::OpenPGPVerifier;
use JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey;
use Crypt::OpenPGP::KeyRing;
use Crypt::OpenPGP;
use Module::Find;
use Data::Dumper;
use Cwd 'abs_path';
use strict;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Verifier::OpenPGPVerifier - Verifies PGP
signature with L<Crypt::OpenPGP>
=head1 DESCRIPTION
This verifier uses L<Crypt::OpenPGP> for validating a PGP signature obtained
from the download site. Ie. each URL used for download should have (and does
have) and associated signature ending with F<.asc>. This verifier typically
quite robust, however installing L<Crypt::OpenPGP> is a bit clumsy, so you
might omit this one.
=head1 IMPORTANT
It is not used currently since the new agents has been signed with 'digest
algortihm 10' which is not supported by OpenPGP. Use a native GnuPG instead
(i.e. a 'gpg' which is in the path)
=cut
sub new {
my $class = shift;
my $self = {};
$self->{keyring} = $JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey::KEY;
bless $self,(ref($class) || $class);
}
sub extension {
return ".asc";
}
sub name {
return "OpenPGP";
}
sub verify {
my $self = shift;
my %args = @_;
my $kr = new Crypt::OpenPGP::KeyRing(Data => $self->{keyring});
my $pgp = new Crypt::OpenPGP(PubRing => $kr);
my $path = $args{path};
my $log = $args{logger};
my $validate;
if ($path) {
$validate = $pgp->verify(Files => [abs_path($args{path})],Signature => $args{signature});
} else {
$validate = $pgp->verify(Data => $args{data},Signature => $args{signature});
}
if ($validate) {
my $key;
if ($validate != 1) {
my $kb = $kr->find_keyblock_by_uid($validate);
if ($kb) {
eval {
# Non-document method
$key = $kb->key->key_id_hex;
$key = substr $key,8,8 if length($key) > 8;
};
}
}
$log->info("Good PGP signature",
($validate != 1 ? (", signed by ",$validate) : ""),
($key ? " ($key)" :""));
return 1;
} elsif ($validate == 0) {
$log->error("Invalid signature",$path ? " for $path" : "",": " . $pgp->errstr);
die "\n";
} else {
$log->error("Error occured while verifying signature: ",$pgp->errstr);
die "\n";
}
}
1;
=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 AUTHOR
roland@cpan.org
=cut

35
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/PGPKey.pm Normal file
View File

@@ -0,0 +1,35 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::PGPKey;
use strict;
use vars qw($KEY);
# Public key for verifying downloaded artifacts
$KEY = <<EOT;
-----BEGIN PGP PUBLIC KEY BLOCK-----
Version: GnuPG v1.4.10 (GNU/Linux)
mQCNAzpoBEMAAAEEAMdDw9V+zMCjJI6Icjv+Z+s5mepNJ+tH848PVOfZohfDoEZx
pthbKW+U0EgFVtV8EE9iWDQOh68U3BvEaOvk+99YoahRRACuII1Y+Q445UaNV/Tn
hCGmofWITYY8Tbz6dcYnWsWMQ5XByM4aMwucM8pUARomkrrM9kKyJpPvEBFlAAUR
tCFSb2xhbmQgSHVzcyA8cm9sYW5kQGpteDRwZXJsLm9yZz6JAJUDBRNNcVaiQrIm
k+8QEWUBARSrA/9gp7YhV7kh47WWtzC25aaW/WS2FwiBqKsOIJ5z8kkrEDOqz3iU
TEzyHMgngwR7dNqZAM2xZlt6uTW1VuhraOFp27V0UVpQg/l1XaHF9JNVPvsbGmFG
MIu/2gQrkhI9/Amyy5Zi3w2mbwISQ897QVY0O98/BlcymFpl5hrx4qbSdbQdUm9s
YW5kIEh1c3MgPHJvbGFuZEBjcGFuLm9yZz6JAJUDBRA6aATCQrImk+8QEWUBAbKN
A/9IEGDcSG7bB7ZW2oDzny++6nhpsHzRlSIwcXJA20W73bu/So8+v6fl4CiBEtZW
KN6qCwqpreK6i8DHx+bGMkm8+uucO3G5vqi9FIF1yJt8ioLPyhPNktRGCCdSxbqG
uYlOaDFwa9J9ebcqPe3mS0/374ixaArqpQPB+S/OU3nuXbQeUm9sYW5kIEh1c3Mg
PHJvbGFuZEBjb25zb2wuZGU+iQCVAwUQOmgEQ0KyJpPvEBFlAQHI+AP9FbP3x5vs
moXO95yV3PHhw0FOo9Szpd4kgIoXGMRVGC5gFKyX7dSU8jwi5PnSQRmTg8jQUUBj
kVYi29nKHsOwp9J7oTbHlC02heaghjW5zTxxRv6lgmh3+cIsAimbi/fr3pRovRCT
MS75CQJTAQAXz4+ALBxU3sG71kEx1mVwEIS0IFJvbGFuZCBIdXNzIDxyb2xhbmRA
am9sb2tpYS5vcmc+iQCVAwUTTXFWgUKyJpPvEBFlAQHGcwP/UNWFVPiV+o3qWVfY
+g9EiJoN43YN6QI3VasZ6Gjda3ZCJ6aLQXL9UorcTQBSIpCOKvEElG5Sw+dH0IPW
jmrzWK1s9lnU2Qkx88QY5O489p+Z98SqbDGqW7DEIkYutYVou0nV7/SVyulMUNGe
vqmY3GlfyqrXMXL+lu6IRpCfHcw=
=HxAM
-----END PGP PUBLIC KEY BLOCK-----
EOT

58
lib/JMX/Jmx4Perl/Agent/Jolokia/Verifier/SHA1Verifier.pm Normal file
View File

@@ -0,0 +1,58 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::Verifier::SHA1Verifier;
use Digest::SHA1;
use JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier;
use base qw(JMX::Jmx4Perl::Agent::Jolokia::Verifier::ChecksumVerifier);
use strict;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::Verifier::SHA1Verifier - Verifies a
SHA1 checksum
=head1 DESCRIPTION
Verifies against a SHA1 checksum for an artifact. The SHA1 sum needs to be
available parallel to the download artifact with a ".sha1" extension.
=cut
sub extension {
return ".sha1";
}
sub name {
return "SHA1";
}
sub create_digester {
return new Digest::SHA1();
}
=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 AUTHOR
roland@cpan.org
=cut
1;

452
lib/JMX/Jmx4Perl/Agent/Jolokia/WebXmlHandler.pm Normal file
View File

@@ -0,0 +1,452 @@
#!/usr/bin/perl
package JMX::Jmx4Perl::Agent::Jolokia::WebXmlHandler;
=head1 NAME
JMX::Jmx4Perl::Agent::Jolokia::WebXmlHandler - Handler for web.xml
transformation
=head1 DESCRIPTION
This module is repsonsible for various manipulations on a F<web.xml> descriptor
as found in JEE WAR archives. It uses L<XML::LibXML> for the dirty work, and
L<XML::Tidy> to clean up after the manipulation. The later module is optional,
but recommended.
=head1 METHODS
=over 4
=cut
use Data::Dumper;
use vars qw($HAS_LIBXML $HAS_XML_TWIG);
use strict;
# Trigger for <login-config>
my $REALM = "Jolokia";
# Class used as proxy dispatcher
my $JSR_160_PROXY_CLASS = "org.jolokia.jsr160.Jsr160RequestDispatcher";
BEGIN {
$HAS_LIBXML = eval "require XML::LibXML; use XML::LibXML::XPathContext; 1";
$HAS_XML_TWIG = eval "require XML::Twig; 1";
}
=item $handler = JMX::Jmx4Perl::Agent::Jolokia::WebXmlHandler->new(%args)
Creates a new handler. The following arguments can be used:
"logger" Logger to use
=cut
sub new {
my $class = shift;
my %args = @_;
my $self = {logger => $args{logger}};
bless $self,(ref($class) || $class);
$self->_fatal("No XML::LibXML found. Please install it to allow changes and queries on web.xml") unless $HAS_LIBXML;
return $self;
}
=item $handler->add_security($webxml,{ role => $role })
Add a security constraint to the given web.xml. This triggers on the realm
"Jolokia" on the loging-config and the URL-Pattern "/*" for the security
mapping. Any previous sections are removed and replaced.
C<$role> is the role to insert.
This method returns the updated web.xml as a string.
=cut
sub add_security {
my $self = shift;
my $webxml = shift;
my $args = shift;
my $doc = XML::LibXML->load_xml(string => $webxml);
my $parent = $doc->getDocumentElement;
$self->_remove_security_elements($doc);
$self->_create_login_config($doc,$parent);
$self->_create_security_constraint($doc,$parent,$args->{role});
$self->_create_security_role($doc,$parent,$args->{role});
$self->_info("Added security mapping for role ","[em]",$args->{role},"[/em]");
return $self->_cleanup_doc($doc);
}
=item $handler->remove_security($webxml)
Remove login-config with Realm "Jolokia" and security constraint to
"/*" along with the associated role definit. Return the updated web.xml
as string.
=cut
sub remove_security {
my $self = shift;
my $webxml = shift;
my $doc = XML::LibXML->load_xml(string => $webxml);
$self->_remove_security_elements($doc);
$self->_info("Removed security mapping");
return $self->_cleanup_doc($doc);
}
=item $handler->add_jsr160_proxy($webxml)
Adds a JSR-160 proxy declaration which is contained as init-param of the
servlet definition ("dispatcherClasses"). If the init-param is missing, a new
is created otherwise an existing is updated. Does nothing, if the init-param
"dispatcherClasses" already contains the JSR 160 dispacher.
Returns the updated web.xml as string.
=cut
sub add_jsr160_proxy {
my $self = shift;
my $webxml = shift;
my $doc = XML::LibXML->load_xml(string => $webxml);
my @init_params = $self->_init_params($doc,"dispatcherClasses");
if (!@init_params) {
$self->_add_jsr160_proxy($doc);
$self->_info("Added JSR-160 proxy");
} elsif (@init_params == 1) {
my $param = $init_params[0];
my ($value,$classes) = $self->_extract_dispatcher_classes($init_params[0]);
unless (grep { $_ eq $JSR_160_PROXY_CLASS } @$classes) {
$self->_update_text($value,join(",",@$classes,$JSR_160_PROXY_CLASS));
$self->_info("Added JSR-160 proxy");
} else {
$self->_info("JSR-160 proxy already active");
return undef;
}
} else {
# Error
$self->_fatal("More than one init-param 'dispatcherClasses' found");
}
return $self->_cleanup_doc($doc);
}
=item $handler->remove_jsr160_proxy($webxml)
Removes a JSR-160 proxy declaration which is contained as init-param of the
servlet definition ("dispatcherClasses"). Does nothing, if the init-param
"dispatcherClasses" already doese not contain the JSR 160 dispacher.
Returns the updated web.xml as string.
=cut
sub remove_jsr160_proxy {
my $self = shift;
my $webxml = shift;
my $doc = XML::LibXML->load_xml(string => $webxml);
my @init_params = $self->_init_params($doc,"dispatcherClasses");
if (!@init_params) {
$self->info("No JSR-160 proxy active");
return undef;
} elsif (@init_params == 1) {
my ($value,$classes) = $self->_extract_dispatcher_classes($init_params[0]);
if (grep { $_ eq $JSR_160_PROXY_CLASS } @$classes) {
$self->_update_text($value,join(",",grep { $_ ne $JSR_160_PROXY_CLASS } @$classes));
$self->_info("Removed JSR-160 proxy");
} else {
$self->_info("No JSR-160 proxy active");
return undef;
}
} else {
$self->_fatal("More than one init-param 'dispatcherClasses' found");
}
return $self->_cleanup_doc($doc);
}
=item $handler->find($webxml,$xquery)
Find a single element with a given XQuery query. Croaks if more than one
element is found. Returns either C<undef> (nothing found) or the matched
node's text content.
=cut
sub find {
my $self = shift;
my $webxml = shift;
my $query = shift;
my $doc = XML::LibXML->load_xml(string => $webxml);
my @nodes = $self->_find_nodes($doc,$query);
$self->_fatal("More than one element found matching $query") if @nodes > 1;
return @nodes == 0 ? undef : $nodes[0]->textContent;
}
=item $handler->has_authentication($webxml)
Checks, whether authentication is switched on.
=cut
sub has_authentication {
my $self = shift;
my $webxml = shift;
$self->find
($webxml,
"//j2ee:security-constraint[j2ee:web-resource-collection/j2ee:url-pattern='/*']/j2ee:auth-constraint/j2ee:role-name");
}
=item $handler->has_jsr160_proxy($webxml)
Checks, whether a JSR-160 proxy is configured.
=cut
sub has_jsr160_proxy {
my $self = shift;
my $webxml = shift;
my $doc = XML::LibXML->load_xml(string => $webxml);
my @init_params = $self->_init_params($doc,"dispatcherClasses");
if (@init_params > 1) {
$self->_fatal("More than one dispatcherClasses init-param found");
} elsif (@init_params == 1) {
my $param = $init_params[0];
my ($value,$classes) = $self->_extract_dispatcher_classes($init_params[0]);
return grep { $_ eq $JSR_160_PROXY_CLASS } @$classes;
} else {
return 0;
}
}
# ===============================================================================
sub _remove_security_elements {
my $self = shift;
my $doc = shift;
my $role = shift;
$self->_remove_login_config($doc);
my $role = $self->_remove_security_constraint($doc);
$self->_remove_security_role($doc,$role);
}
sub _create_login_config {
my $self = shift;
my $doc = shift;
my $parent = shift;
my $l = _e($doc,$parent,"login-config");
_e($doc,$l,"auth-method","BASIC");
_e($doc,$l,"realm-name",$REALM);
}
sub _create_security_constraint {
my $self = shift;
my $doc = shift;
my $parent = shift;
my $role = shift;
my $s = _e($doc,$parent,"security-constraint");
my $w = _e($doc,$s,"web-resource-collection");
_e($doc,$w,"web-resource-name","Jolokia-Agent Access");
_e($doc,$w,"url-pattern","/*");
my $a = _e($doc,$s,"auth-constraint");
_e($doc,$a,"role-name",$role);
}
sub _create_security_role {
my $self = shift;
my $doc = shift;
my $parent = shift;
my $role = shift;
my $s = _e($doc,$parent,"security-role");
_e($doc,$s,"role-name",$role);
}
sub _remove_security_constraint {
my $self = shift;
my $doc = shift;
my @s = $doc->getElementsByTagName("security-constraint");
for my $s (@s) {
my @r = $s->getElementsByTagName("role-name");
my $role;
for my $r (@r) {
$role = $r->textContent;
}
my @u = $s->getElementsByTagName("url-pattern");
for my $u (@u) {
if ($u->textContent eq "/*") {
$s->parentNode->removeChild($s);
return $role;
}
}
}
}
sub _remove_login_config {
my $self = shift;
my $doc = shift;
my @l = $doc->getElementsByTagName("realm-name");
for my $l (@l) {
if ($l->textContent eq $REALM) {
my $toRemove = $l->parentNode;
$toRemove->parentNode->removeChild($toRemove);
return;
}
}
}
sub _remove_security_role {
my $self = shift;
my $doc = shift;
my $role = shift;
my @s = $doc->getElementsByTagName("security-role");
for my $s (@s) {
my @r = $s->getElementsByTagName("role-name");
for my $r (@r) {
if ($r->textContent eq $role) {
$s->parentNode->removeChild($s);
return;
}
}
}
}
sub _init_params {
my $self = shift;
my $doc = shift;
my $param_name = shift;
return $self->_find_nodes
($doc,
"/j2ee:web-app/j2ee:servlet[j2ee:servlet-name='jolokia-agent']/j2ee:init-param[j2ee:param-name='$param_name']");
}
sub _extract_dispatcher_classes {
my $self = shift;
my $param = shift;
my @values = $self->_find_nodes($param,"j2ee:param-value");
$self->_fatal("No or more than one param-value found") if (!@values || @values > 1);
my $value = $values[0];
my $content = $value->textContent();
my @classes = split /\s*,\s*/,$content;
return ($value,\@classes);
}
sub _update_text {
my $self = shift;
my $el = shift;
my $value = shift;
my $parent = $el->parentNode;
$parent->removeChild($el);
$parent->appendTextChild($el->nodeName,$value);
}
sub _add_jsr160_proxy {
my $self = shift;
my $doc = shift;
my @init_params = $self->_find_nodes
($doc,
"/j2ee:web-app/j2ee:servlet[j2ee:servlet-name='jolokia-agent']/j2ee:init-param");
my $first = $init_params[0] || $self->_fatal("No init-params found");
my $new_init = $doc->createElement("init-param");
_e($doc,$new_init,"param-name","dispatcherClasses");
_e($doc,$new_init,"param-value",$JSR_160_PROXY_CLASS);
$first->parentNode->insertBefore($new_init,$first);
}
sub _find_nodes {
my $self = shift;
my $doc = shift;
my $query = shift;
my $xpc = XML::LibXML::XPathContext->new;
$xpc->registerNs('j2ee', 'http://java.sun.com/xml/ns/j2ee');
return $xpc->findnodes($query,$doc);
}
sub _e {
my $doc = shift;
my $parent = shift;
my $e = $doc->createElement(shift);
my $c = shift;
if ($c) {
$e->appendChild($doc->createTextNode($c));
}
$parent->appendChild($e);
return $e;
}
sub _cleanup_doc {
my $self = shift;
my $doc = shift;
if ($HAS_XML_TWIG) {
my $ret = XML::Twig->nparse_pp($doc->toString)->toString(1);
#print $ret;
return $ret;
} else {
return $doc->toString(1);
}
}
sub _fatal {
my $self = shift;
$self->{logger}->error(@_);
die "\n";
}
sub _info {
my $self = shift;
$self->{logger}->info(@_);
}
=back
=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 AUTHOR
roland@cpan.org
=cut
1;

167
lib/JMX/Jmx4Perl/Agent/UserAgent.pm Normal file
View File

@@ -0,0 +1,167 @@
#!/usr/bin/perl
# Helper package in order to provide credentials
# in the request
package JMX::Jmx4Perl::Agent::UserAgent;
use base qw(LWP::UserAgent);
use Sys::SigAction;
use vars qw($HAS_BLOWFISH_PP $BF);
use strict;
BEGIN {
$HAS_BLOWFISH_PP = eval "require Crypt::Blowfish_PP; 1";
if ($HAS_BLOWFISH_PP) {
$BF = new Crypt::Blowfish_PP(pack("C10",0x16,0x51,0xAE,0x13,0xF2,0xFA,0x11,0x20,0x6E,0x6A));
}
}
=head1 NAME
JMX::Jmx4Perl::Agent::UserAgent - Specialized L<LWP::UserAgent> adding
authentication support
=head1 DESCRIPTION
Simple subclass implementing an own C<get_basic_credentials> method for support
of basic and proxy authentication. This is an internal class used by
L<JMX::Jmx4Perl::Agent>.
=cut
# Constructor setting the proper SSL options (if possible)
sub new {
my $class = shift;
my @opts = @_ || ();
if (LWP::UserAgent->VERSION >= 6.00) {
# We don't verify Hostnames by default, since the information we are
# sending is typically not critical. Also, we don't have yet a way to
# configure a keystore, so this is the only chance for now. Ask me to add
# host certificate verification if wanted. It disabled only for LWP >= 6.00
push @opts,(ssl_opts => { verify_hostname => 0 });
};
return $class->SUPER::new(@opts);
}
# Request using a more robust timeout See
# http://stackoverflow.com/questions/73308/true-timeout-on-lwpuseragent-request-method
# for details.
sub request {
my $self = shift;
my $req = shift;
# Get whatever timeout is set for LWP and use that to
# enforce a maximum timeout per request.
use Sys::SigAction qw(timeout_call);
our $res = undef;
if (timeout_call($self->timeout(), sub { $res = $self->SUPER::request($req); })) {
# 408 == HTTP timeout
my $ret = HTTP::Response->new(408,"Got timeout in " . $self->timeout() . "s ");
$ret->request($req);
return $ret;
} else {
return $res;
}
}
sub jjagent_config {
my $self = shift;
$self->{jjagent_config} = shift;
}
sub get_basic_credentials {
my ($self, $realm, $uri, $isproxy) = @_;
my $cfg = $self->{jjagent_config} || {};
my $user = $isproxy ? $self->proxy_cfg($cfg,"user") : $cfg->{user};
my $password = $isproxy ? $self->proxy_cfg($cfg,"password") : $cfg->{password};
if ($user && $password) {
return ($user,$self->conditionally_decrypt($password));
} else {
return (undef,undef);
}
}
sub proxy_cfg {
my ($self,$cfg,$what) = @_;
my $proxy = $cfg->{proxy};
if (ref($proxy) eq "HASH") {
return $proxy->{$what};
} else {
return $cfg->{"proxy_" . $what};
}
}
sub conditionally_decrypt {
my $self = shift;
my $password = shift;
if ($password =~ /^\[\[\s*(.*)\s*\]\]$/) {
# It's a encrypted password, lets decrypt it here
return decrypt($1);
} else {
return $password;
}
}
sub decrypt {
my $encrypted = shift;
die "No encryption available. Please install Crypt::Blowfish_PP" unless $HAS_BLOWFISH_PP;
my $rest = $encrypted;
my $ret = "";
while (length($rest) > 0) {
my $block = substr($rest,0,16);
$rest = substr($rest,16);
$ret .= $BF->decrypt(pack("H*",$block));
}
$ret =~ s/\s*$//;
return $ret;
}
sub encrypt {
my $plain = shift;
die "No encryption available. Please install Crypt::Blowfish_PP" unless $HAS_BLOWFISH_PP;
my $rest = $plain;
my $ret = "";
while (length($rest) > 0) {
my $block = substr($rest,0,8);
if (length($block) < 8) {
$block .= " " x (8 - length($block));
}
$rest = substr($rest,8);
$ret .= unpack("H*",$BF->encrypt($block));
}
return $ret;
}
=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 AUTHOR
roland@cpan.org
=cut
1;
__DATA__