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.

#

# v1.2.0 20240826 RWR

# Modified the flag structure to conform to standard (ie, dryrun instead of yes)

# Added a lot of 'verbose' print lines, and modified for new flag structure

# Added a config file, which is auto-generated if it doesn't exist

#

# v1.2.1 20250511 RWR

# changed so even if quiet set, if dryrun is set, will print what is returned from the called script

# Also, incorporates v1.3.0 on cluster.pm and v1.2.1 on havirt.pm

#

# v1.2.2 20250511 RWR

# Added variance flag (--variance), and fixed the version flag (--version or -V)

#

# v1.2.3 20260102 RWR

# Fixed module loading to use absolute paths from $FindBin::RealBin so havirt can be run from any directory

# Override config paths after reading YAML to ensure correct script directory regardless of working directory

#use experimental "switch";

# requires File::Slurp, File::LibXML, YAML::Tiny, Data::Dumper

# In Debian derivatives

# apt install libfile-slurp-perl libxml-libxml-perl libyaml-tiny-perl libdata-dumper-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.2.3");

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

use Getopt::Long;

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

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

our $config;

my $configFileName = $FindBin::RealBin . '/config.yaml';

# Big hash that contains all information about system

our $statusDB;

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 screen|tsv # output of list commands is either padded for screen or Tab Delim\n";

   print "\t--force|f force an action, even if not normally done\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--quiet|q # do not print anything except major errors\n";

   print "\t--verbose|v # increase verbosity of program. May be used multiple times\n";

   print "\t--variance int # Real time adjust variance for cluster balance\n";

}

&makeConfig( $config,$configFileName ) unless -f $configFileName;

$config = readConfig( $configFileName );

# Override script dir to always use the actual script location

$config->{'script dir'} = $FindBin::RealBin;

$config->{'db dir'} = $config->{'script dir'} . '/var';

$config->{'conf dir'} = $config->{'script dir'} . '/conf';

$config->{'status db filename'} = $config->{'script dir'} . '/var/status.yaml';

$config->{'last scan filename'} = $config->{'script dir'} . '/var/lastscan';

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

GetOptions (

   $config->{'flags'}, 

      'debug|d+',  # integer, can be incremented like -ddd

      'dryrun|n!', # negatable with --nodryrun

      'force|f',

      'format=s',  # must be --format (no short form)

      'help|h', 

      'quiet|q',

      'target|t=s',

      'testing',

      'verbose|v+',# integer, can be incremented like -vv

      'version|V',  # note, the short form is a capital 'V'

      'variance=f' # adjust variance for cluster balance

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

# if they pass the testing flag, turn verbose on, dry run on, and append

# .testing to the status db filename

if ( $config->{'flags'}->{'testing'} ) { 

   $config->{'flags'}->{'verbose'} = 1;

   $config->{'flags'}->{'dryrun'} = 1; 

   $config->{'status db filename'} .= '.testing';

}

print "Parameters are " . Dumper( $config ) . "\n" if $config->{'flags'}->{'debug'};

die if $config->{'flags'}->{'debug'} > 3;

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

# adjust variance if they passed in the flag

$config->{'balance_max_variance'} = $config->{'flags'}->{'variance'} if $config->{'flags'}->{'variance'};

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

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

$action = 'help' unless $action;

if ( $config->{'flags'}->{'help'} || $command eq 'help' || ! $command ) { &help() ; exit; }

print "Command = $command\nAction = $action\n" if $config->{'flags'}->{'debug'};

# Allow shortcut commands for domains (start, shutdown, migrate, destroy)

if ( $command =~ /^(start|shutdown|migrate|destroy)$/ ) {

    push @ARGV, $action;      # domain name becomes argument

    $action  = $command;      # action is the command

    $command = 'domain';      # use the domain 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 dynamically, die if it doesn't exist

my $module_path = $config->{'script dir'} . "/$command.pm";

if ( -f $module_path ) {

    require $module_path;

    Module->import($command); # For require, 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)

  print "running [$action] in $command.pm:$action\n with parameters " . join(", ", @ARGV) . "\n" if $main::config->{'flags'}->{'debug'};

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

  print $message unless !$message || $main::config->{'flags'}->{'quiet'} && !$main::config->{'flags'}->{'dryrun'};

} 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;