jmx4perl/lib/JMX/Jmx4Perl/Agent/Jolokia/ArtifactHandler.pm

323 lines
8.4 KiB
Perl

#!/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;