Rev 116 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
#! /usr/bin/perl -w
use YAML::XS qw(DumpFile LoadFile); # libyaml-libyaml-perl
use Getopt::Std;
$main::VERSION = '0.1';
my $dbFile = 'dom0_db.yaml';
my $lockFile = 'dom0_db.lock';
my $command = 'virsh'; $command = 'xl' unless `which $command`;
#
# 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 to read output of xl list, parse it and store results in database\n\n";
print "-s Show database\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,$dirtyCount, $verbose) = @_;
if ( $dirtyCount ) {
print "Updating database since $dirtyCount changes found\n" if $verbose;
DumpFile( $dbFile, $db );
}
`rm $lockFile` if -e $lockFile;
}
sub showDOMUs {
my $db = shift;
foreach my $domu ( sort keys %$db ) {
print "$domu\t$$db{$domu}->{'server'}\n";
}
}
sub trim {
my $string = shift;
$string =~ s/^\s+|\s+$//;
return $string;
}
sub getHeader {
my ($line) = @_;
my @return = split( '\s+', trim( $line ) );
return @return;
}
sub parseALine {
my ($line, @headers ) = @_;
my %return;
# next line see http://www.perlmonks.org/?node_id=4402
@return{@headers} = split( '\s+', trim( $line ) );
return %return;
}
sub updateDB {
my ( $db, $self, $verbose ) = @_;
my $new = 0;
my $moved = 0;
my $removed = 0;
use Data::Dumper;
my @domains = `$command list`;
chomp @domains;
my @fieldnames = &getHeader( $domains[0] );
my %found;
for ($i = 1; $i < @domains; $i++ ) {
next if $domains[$i] =~ m/^[=-]*$/;
my %thisLine = &parseALine( $domains[$i], @fieldnames );
next if $thisLine{'Name'} eq 'Domain-0';
$found{ $thisLine{'Name'} } = 1;
unless ( exists $$db{$thisLine{'Name'}} ) {
$$db{$thisLine{'Name'}} = \%thisLine;
print "adding $thisLine{'Name'}\n" if $verbose;
$new++;
}
unless ( exists $$db{$thisLine{'Name'}}->{'server'} && $$db{$thisLine{'Name'}}->{'server'} eq $self ) {
$$db{$thisLine{'Name'}}->{'server'} = $self;
print "$thisLine{'Name'} has moved to me ($self)\n" if $verbose;
$moved++;
}
}
# clean up any entries which were here, but are not any longer
foreach $entry ( keys %$db ) {
if ( $db->{$entry}->{'server'} eq $self && ! defined ( $found{$entry} ) ) {
# it used to be here, but now it is gone
$db->{$entry}->{'server'} = '';
$removed++;
} # if
} # foreach
print "$new new virtuals found, $removed removed and $moved virtuals moved\n" if ( $verbose );
return ($new+$moved+$removed,$db);
}
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'} );
unless ( $options{ 'n' } ) {
my $dirtyCount;
print STDERR "Updating the database\n" if $options{'v'};
my $self = `hostname`;
chomp $self;
($dirtyCount,$db) = &updateDB( $db,$self, $options{'v'} );
print "Virtuals changed on $self\n" if ($options{'r'} && $dirtyCount);
&saveDB( $db, $dirtyCount, $options{'v'} );
}
&showDOMUs( $db ) if $options{'s'};
1;