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("1.0.0");


# see https://perldoc.perl.org/Getopt/Long.html
use Getopt::Long;
# allow -vvn (ie, --verbose --verbose --dryrun)
Getopt::Long::Configure ("bundling");


# global variables
our $scriptDir = $FindBin::RealBin;
my $scriptName = $FindBin::Script;
my $dbDir = "$scriptDir/var";
our $confDir = "$scriptDir/conf";
our $statusDBName = "$dbDir/status.yaml";
our $lastScanFileName = "$scriptDir/lastscan";
our $minScanTimes = 5 * 60; # do not scan more than once every 5 minutes

# Big hash that contains all information about system
our $statusDB;

# options variables
our $reportFormat = 'screen';
our $force = 0;
our $quiet = 0;
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 [help] # work with a node\n";
   print "\tdomain [help] # work with individual domains\n";
   print "\tcluster [help] # report of memory and vcpu status on all nodes\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";
   print "\t--yes|y # force an action (like scan) even if it is not a good idea\n";
   print "\t--quiet|q # do not print anything except major errors\n";
}



# 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,
   'yes|y' => \$force,
   'version|v' => \$version,
   'quiet|q' => \$quiet
) 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
$action = 'help' unless $action;
                  
if ( $help || $command eq '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.
if (-f $scriptDir . "/$command.pm" ) {
   require "$command.pm";
   Module->import( $command ); # for require, you must manually import
} else {
   die "Error, I don't know the command [$command]\n";
}

if ( defined &{\&{$execute}} ) { # check if module::sub exists (ie, $command::action)
  my $message =  &{\&{$execute}}(@ARGV); # yes, it exists, so call it with any remaining arguments
  print $message unless $quiet;
} 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;