Subversion Repositories havirt

#! /usr/bin/env perl

use strict;

use warnings;

# havirt

# Basically an extension of virsh which will perform actions on virtuals 

# running on multiple, connected hypervisors (virsh calls them nodes)

# existing as a cluster of hypervisors where virtuals can be shut down,

# started and migrated at need.

#

# Progam consists of one executable (havirt) and multiple Perl Modules

# (*.pm), each of which encompasses a function. However, this is NOT

# written as an Object Oriented system.

#

# havirt --help gives a brief help screen.

# Copyright 2024 Daily Data, Inc.

# 

# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following 

# conditions are met:

#

#   Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

#   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer 

#   in the documentation and/or other materials provided with the distribution.

#   Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived

#   from this software without specific prior written permission.

# 

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT

# NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL

# THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS

# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE

# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#use experimental "switch";

# requires File::Slurp. 

# In Debian derivatives

# apt install libfile-slurp-perl

# apt install libxml-libxml-perl libyaml-tiny-perl

BEGIN {

   use FindBin;

   use File::Spec;

   # use libraries from the directory this script is in

   use Cwd 'abs_path';

   use File::Basename;

   use lib dirname( abs_path( __FILE__ ) );

}

use havirt; # Load all our shared stuff

use Data::Dumper;

use YAML::Tiny;

# define the version number

# see https://metacpan.org/pod/release/JPEACOCK/version-0.97/lib/version.pod

use version;

our $VERSION = version->declare("0.0.1");

# see https://perldoc.perl.org/Getopt/Long.html

use Getopt::Long;

# allow -vvn (ie, --verbose --verbose --dryrun)

Getopt::Long::Configure ("bundling");

# global variables

my $scriptDir = $FindBin::RealBin;

my $scriptName = $FindBin::Script;

my $dbDir = "$scriptDir/var";

our $confDir = "$scriptDir/conf";

our $nodeDBName = "$dbDir/node.yaml";

our $domainDBName = "$dbDir/domains.yaml";

our $nodePopulationDBName = "$dbDir/node_population.yaml";

# these contain the values from the databases

# loaded on demand

our $nodeDB;

our $virtDB;

our $nodePopulations;

# options variables

our $reportFormat = 'screen';

our $targetNode = '';

our $dryRun = 1;

our $DEBUG = 0;

my $help = 0;

my $version = 0;

sub help {

   print "$0 command [argument]\n";

   print "where command is one of\n";

   print "\tnode update|list|scan # work with a node\n";

   print "\tdomain update|list # work with individual domains\n";

   print "\tcluster status # report of memory and vcpu status on all nodes\n";

   print "For additional help, run command help\n";

   print "\tnode help # or domain, or cluster\n";

   print "Some flags can be used where appropriate\n";

   print "\t--help|-h # show this screen\n";

   print "\t--version|-v # show version of program\n";

   print "\t--format|-f screen|tsv # output of list commands is either padded for screen or Tab Delim\n";

   print "\t--target|-t NODE # the action use NODE for the target of actions\n";

   print "\t--dryrun|-n # does not perform the actions, simply shows what commands would be executed\n";

   print "\t--debug|d # increases verbosity, with -ddd, totally outragious\n";

}

sub loadVirtDB {

   return if $virtDB;

   $virtDB = &readDB( $domainDBName );

}

sub domain {

   my $action = lc shift;

   my $return = '';

   &loadVirtDB();

   &loadNodePopulations();

   @_ = keys( %$virtDB ) if ( $_[0] && $_[0] eq 'ALL' );

   if ( $_[0] && $_[0] eq 'RUNNING' ) {

      my @running;

      foreach my $node ( keys %$nodePopulations ) {

         push @running, keys %{ $nodePopulations->{$node}->{'running'} };

      }

      @_ = @running;

   }

   if ( $action eq 'update' ) { # download xml to var and update database

      while ( my $virt = shift ) {

         &parseDomain( $virt );

      } # while

      &writeDB( $domainDBName, $virtDB );

   } elsif ( $action eq 'list' ) { # dump domain as a tab separated data file

      my @return;

      foreach my $node ( keys %$nodePopulations ) {

         foreach my $virt (keys %{$nodePopulations->{$node}->{'running'}} ) {

            push @return, &listDomain( $virt, $node );

         }

      }

      $return = join( "\n", sort @return ) . "\n";;

   }

   return $return;;

} # sub domain

sub listDomain {

   my ($virt,$node) = @_;

   my @return;

   push @return, $virt;

   push @return, $node;

   foreach my $column ( sort keys %{ $virtDB->{$virt} } ) {

      push @return, $virtDB->{$virt}->{$column};

   }

   return join( "\t", @return);

}

# get the XML definition file of a running domain off of whatever

# node it is running on, and save it to disk

sub getVirtConfig {

   my ($virt,$filename) = @_;

   my $return;

   print "In getVirtConfig looking for $virt with file $filename\n" if $DEBUG;

   if ( -f $filename ) {

      open XML, "<$filename" or die "Could not read from $filename: $!\n";

      $return = join( '', <XML> );

      close XML;

   } else {

      &loadNodePopulations();

      #die Dumper( $nodePopulations );

      foreach my $node ( keys %$nodePopulations ) {

         print "getVirtConfig Looking on $node for $virt\n";

         if ( exists( $nodePopulations->{$node}->{'running'}->{$virt} ) ) { # we found it

            print "Found $virt on node $node\n";

            $return = `ssh $node 'virsh dumpxml $virt'`;

            open XML,">$filename" or die "Could not write to $filename: $!\n";

            print XML $return;

            close XML;

         } # if

      } # foreach

   } # if..else

   return $return;

} # sub getVirtConfig

sub getXMLValue {

   my ( $key, $string ) = @_;

   my $start = "<$key";

   my $end = "</$key>";

   $string =~ m/$start([^>]*)>([^<]+)$end/;

   return ($1,$2);

}

sub parseDomain {

   my ($virt, $nodePopulations ) = @_;

   my @keysToSave = ( 'uuid', 'memory', 'vcpu' );

   my $filename = "$confDir/$virt.xml";

   my $xml = &getVirtConfig( $virt, $filename );

   my ($param,$value) = &getXMLValue( 'uuid', $xml );

   $virtDB->{$virt}->{'uuid'} = $value;

   ($param,$value) = &getXMLValue( 'memory', $xml );

   $virtDB->{$virt}->{'memory'} = $value;

   ($param,$value) = &getXMLValue( 'vcpu', $xml );

   $virtDB->{$virt}->{'vcpu'} = $value;

   $xml =~ m/type='vnc' port='(\d+)'/;

   $virtDB->{$virt}->{'vnc'} = $1;

}

sub cluster {

   my $action = lc shift;

   my $return = '';

   if ( $action eq 'status' ) {

      &loadVirtDB();

      &loadNodePopulations();

      &loadNodeDB();

      print "Node\tThreads\tMemory\tDomains\tvcpu\tmem_used\n";

      my $usedmem = 0;

      my $usedcpu = 0;

      my $availmem = 0;

      my $availcpu = 0;

      my $totalDomains = 0;

      foreach my $node (sort keys %$nodeDB ) {

         my $memory = 0;

         my $vcpus = 0;

         my $count = 0;

         foreach my $domain ( keys %{ $nodePopulations->{$node}->{'running'} } ) {

            $memory += $virtDB->{$domain}->{'memory'};

            $vcpus += $virtDB->{$domain}->{'vcpu'};

            $count++;

         }

         $return .= "$node\t$nodeDB->{$node}->{cpu_count}\t$nodeDB->{$node}->{memory}\t$count\t$vcpus\t$memory\n";

         $usedmem += $memory;

         $usedcpu += $vcpus;

         $totalDomains += $count;

         $availmem += $nodeDB->{$node}->{memory};

         $availcpu += $nodeDB->{$node}->{cpu_count};

      } # outer for

      $return .= "Total\t$availcpu\t$availmem\t$totalDomains\t$usedcpu\t$usedmem\n";

   }

   return $return;

}

# handle any command line parameters that may have been passed in

GetOptions (

   'format|f=s' => \$reportFormat,

   'target|t=s' => \$targetNode,

   'dryrun|n!' => \$dryRun,

   'debug|d+' => \$DEBUG,

   'help|h' => \$help,

   'version|v' => \$version

) or die "Error parsing command line\n";

my $command = shift; # the first one is the actual subsection

my $action = shift; # second is action to run

if ( $help || ! $command ) { &help() ; exit; }

if ( $version ) { use File::Basename; print basename($0) . " v$VERSION\n"; exit; }

print "Parameters are\nreportFormat\t$reportFormat\ntargetNode\t$targetNode\ndryRun\t$dryRun\nDEBUG\t$DEBUG\n" if $DEBUG;

print "Command = $command\nAction = $action\n" if $DEBUG;

# we allow a three part command for some actions on a domain, ie start, shutdown, migrate and destroy

# for simplicity, if the command is one of the above, allow the user to enter like that, but we will

# restructure the command as if they had used the full, three part (ie, with domain as the command)

# so, the following are equivilent

# havirt domain start nameofdomain

# havirt start nameofdomain

if ( $command eq 'start' || $command eq 'shutdown' || $command eq 'migrate' || $command eq 'destroy' ) { # shortcut for working with domains

   push @ARGV, $action; # this is the domain we are working with

   $action = $command; # this is what we want to do (start, shutdown, etc...)

   $command = 'domain'; # keywork domain, for correct module

}

# ok, this is some serious weirdness. $command is actually the name of a module, and $action is a method

# defined in the module.

# I use 'require' which loads at runtime, not compile time, so it will only load a module if needed.

# then, I check to see if a method named in $action is defined within that module and, if so

# execute it and return the result. If not, gives an error message.

# This means to add functionality, we simply add a method (sub) in a given module, or create a whole

# new module.

# we have to concat here since the double colon causes some interpretation problems

my $execute = $command . '::' . $action;

# load the module, die if it doesn't exist. Might make this an eval later

require "$command.pm";

Module->import( $command ); # for require, you must manually import

if ( defined &{\&{$execute}} ) { # check if module::sub exists (ie, $command::action)

  print &{\&{$execute}}(@ARGV); # yes, it exists, so call it with any remaining arguments

} else { # method $action does not exist in module $command, so just a brief error message

  die "Error, could not find action $action for module $command\n";

} 

1;