Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
#! /usr/bin/env perl
use strict;
use warnings;
use YAML::XS qw(DumpFile LoadFile); # libyaml-libyaml-perl
use Getopt::Std;
$main::VERSION = '0.1';
my $dbFile = 'virtinfo_db.yaml';
my $lockFile = 'virtinfo.lock';
use Data::Dumper;
#
# find where the script is actually located as cfg should be there
#
sub getScriptLocation {
use strict;
use File::Spec::Functions qw(rel2abs);
use File::Basename;
return dirname(rel2abs($0));
}
sub main::HELP_MESSAGE {
print "\nScript reads running virtuals and store results in database\n\n";
print "-s Show database and exit\n";
print "-c filename Use alternative database\n";
print "-n Don't update the database\n";
print "-v Be Verbose (show some stats)\n";
print "-r Report - only display if something changed\n";
}
sub main::VERSION {
&HELP_MESSAGE();
}
sub readDB {
my $lock = shift;
my $db;
sleep(5) if -e $lockFile;
die "Could not get lock on $dbFile: Aborting\n" if -e $lockFile;
`touch $lockFile` unless $lock;
$db = LoadFile( $dbFile ) if ( -e $dbFile );
return $db;
}
sub saveDB {
my ($db, $verbose) = @_;
print "Updating database\n" if $verbose;
DumpFile( $dbFile, $db );
}
# many of the outputs produce key:value pairs
# we will parse this into a hash
sub parseDelimited {
my $delimiter = shift;
my %return;
while ( my $line = shift ) {
chomp $line;
next unless $line;
my ( $key, $value ) = split( /$delimiter/, $line );
$return{lc &trim($key) } = &trim($value);
}
return \%return;
}
sub getNode {
my @info = `virsh nodeinfo`;
my $hypervisor = &parseDelimited( ':', @info );
return $hypervisor;
}
sub getRunningVirtuals {
my @domains = `virsh list`;
chomp @domains;
my %domains;
foreach my $domain ( @domains ) {
# skip the headers
next if $domain =~ m/^(Id)|(--)/;
if ( $domain =~ m/^\s*(\d+)\s+([^\s]+)\s/ ) {
$domains{$2}{'id'} = $1;
}
}
return \%domains;
}
sub updateDB {
my ( $node, $self, $verbose ) = @_;
# get a list of all running virtuals
my $virts = &getRunningVirtuals();
my @a = sort keys %$virts;
my @b = sort keys %{ $node->{$self}->{'virtuals'} };
return 0 # return if they are the same, no action needed
if &compareArray( \@a, \@b );
# something has changed, so load all information again
print "Something has changed, so loading everything again\n" if $verbose;
$node->{$self}->{'hypervisor'} = &getNode();
$node->{$self}->{'virtuals'} = $virts;;
foreach my $domain ( keys %{$node->{$self}->{'virtuals'}} ) {
next unless $domain;
my @info = `virsh dominfo $domain`;
my $vnc = `virsh vncdisplay $domain`;
chomp $vnc;
$vnc =~ m/^.*:(\d+)$/;
push @info, "vncport: $1";
$node->{$self}->{'virtuals'}->{$domain} = &parseDelimited( ':', @info );
}
return ( 1, $node );;
}
# remove leading and trailing whitespace from string
sub trim {
my $string = shift;
$string =~ s/^\s+|\s+$//;
return $string;
}
sub showDOMUs {
my $conf = shift;
foreach my $node ( keys %$conf ) {
print "$node\n";
foreach my $virt ( keys %{ $conf->{$node}->{'virtuals'} } ) {
print "\t$virt\n";
}
}
}
sub compareArray {
my ($arr1, $arr2 ) = @_;
# if they don't have the same number of elements, not equal
return 0 if @$arr1 != @$arr2;
for ( my $i = 0; $i < scalar( @$arr1 ); $i++ ) {
return 0 unless $$arr1[$i] eq $$arr2[$i];
}
return 1;
}
my $path = &getScriptLocation() . '/';
$dbFile = $path . $dbFile;
$lockFile = $path . $lockFile;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my %options = ();
getopts( 'vosrc:n', \%options );
if ( $options{'o'} ) {
print "Dumping cli parameters\n";
foreach my $option ( keys %options ) {
print "$option\t[$options{$option}]\n";
}
}
my $db = &readDB( $options{'n'} );
my $self = `hostname -f`;
chomp $self;
if ( $options{'s'} ) {
&showDOMUs( $db );
} elsif ( ! $options{ 'n' } ) {
print STDERR "Updating the database\n" if $options{'v'};
my $dirty = 0;
( $dirty, $db ) = &updateDB( $db,$self, $options{'v'} );
if ( $dirty ) {
print "Virtuals changed on $self\n" if ($options{'r'});
&saveDB( $db, $options{'v'} );
}
}
`rm $lockFile` if -e $lockFile;
1;