File check_vm_constraints.pl of Package monitoring-plugins-vm-constraints

#!/usr/bin/perl
# nagios: -epn
#
# check_vm_constraints.pl - monitoring plugin
#
# Author: Rüdiger Örtel
#
#
use warnings;
use strict;
use Getopt::Long;
my $VERSION = '0.002';

sub version {
	print "$VERSION\n";
}
sub help {
	my $name = $1 if $0 =~ /\/([^\/]+)$/;
	print <<FOO;
$name [ --help ] [ --version ] [ --constraints filename ]

  --help		- help (this screen)
  --version		- get version information
  --constraints file	- set constraints which vms should not be together
  --connect URI - hypervisor connection URI

This script looks at the list of running VMs and at the constraints file and
verifies that not more than one VM of each group is running on the same
virtualisation server.
This script is suitable for feeding to NRPE for Nagios (or similar) to check.

This script is distributed under the Artistic and Gnu Public Licences.
 
Version: $VERSION.
(c) 2015-2017 SUSE Linux GmbH https://www.suse.com
FOO
}

my $options = {
	'constraints' => '',
};
my $retcode = 0;
my $message = "";
my $constraints;
my $vlist;

GetOptions($options, "constraints=s", "connect=s","help", "version");
if(defined $options->{'help'}) {
	help();
	exit;
	}
elsif (defined $options->{'version'}) {
	version();
	exit;
}

my $constraints_file = $options->{'constraints'};
my $connect = "";
if (defined($options->{'connect'}) && "$options->{'connect'}" ne ""){
  $connect = "-c $options->{'connect'}";
}
unless ($constraints_file) {
	$retcode = 2;
	$message = "ERROR: constraints file not specified";
}
unless ($retcode) {
	unless (-f $constraints_file) {
		$retcode = 3;
		$message = "constraints file $constraints_file does not exist";
	}
}
unless ($retcode) {
	if(!open(CONS,"<$constraints_file")) {
		$retcode = 3;
		$message = "constraints file not readable";
	} else {
		while (<CONS>) {
			chomp();
			my @line = split('\s+',$_);
			push @{$constraints}, \@line;
		}
		close (CONS);
	}
	if(!open(VLIST,"virsh $connect list --name |")) {
		$retcode = 3;
		$message = "could not call 'virsh list'";
	} else {
		while (<VLIST>) {
			chomp();
			$vlist->{$_} = 1 if $_;
		}
		close (VLIST);
	}
		
	for (keys (%{$vlist})) {
		my $cur_vm = $_;
		for (@{$constraints}) {
			if (grep { $_ eq $cur_vm } @{$_}) {
				my $other = 0;
				for (@{$_}) {
					next if $_ eq $cur_vm;
					unless ($vlist->{$_}) {
						$other = 1;
						next;
					}
					$message .= "constraint validation $cur_vm $_ on same host; ";
					delete $vlist->{$cur_vm};
					$retcode = 1;
				}
				# set to ERROR if all in same group on same host
				$retcode = 2 if ($other == 0 && $retcode == 1);
			}
		}
	}
}

my $retcodes = [ 'OK', 'WARNING', 'ERROR', 'UNKNOWN' ];
printf "$retcodes->[$retcode]: $message\n";
exit $retcode;