#!/usr/bin/perl
# 
#   This is the resource agent used to manage servers on the Anvil! Intelligent Availability platform.
#
#   License: GNU General Public License (GPL) v2+
#            (c) 1997-2018 - Alteeve's Niche! Inc.
# 
# WARNING: This is a pretty purpose-specific resource agent. No effort was made to test this on an rgmanager
#          cluster or on any configuration outside how the Anvil! m3 uses it. If you plan to adapt it to 
#          another purpose, let us know and we'll try to help.
# 
# Based on: https://github.com/ClusterLabs/resource-agents/blob/master/doc/dev-guides/ra-dev-guide.asc
# 
# Error types from pacemaker's perspective;
# 
# - Soft Error -  Unless specifically configured otherwise, pacemaker will attempt to recover a resource 
#                 in-place - usually by restarting the resource on the same node.
# - Hard Error -  Unless specifically configured otherwise, pacemaker will attempt to recover a resource 
#                 which failed with this error by restarting the resource on a different node.
# - Fatal Error - This is a cluster-wide error, it would make no sense to recover such a resource on a 
#                 different node, let alone in-place. When a resource fails with this error, Pacemaker will 
#                 attempt to shut down the resource, and wait for administrator intervention.
# 
# Exit codes;
# 0 - OCF_SUCCESS 
#   - The action completed successfully. This is the expected return code for any successful start, stop, 
#     migrate_to, meta_data, help, and usage action.
#   - For monitor, however, a modified convention applies:
#     - If the server is running we return, OCF_SUCCESS.  If not running and gracefully stopped or migrated 
#       off, return OCF_NOT_RUNNING.
#       
# 1 - OCF_ERR_GENERIC
#   - The action returned a generic error. This is used only when none of the more specific error codes, 
#     defined below, accurately describes the problem.
#   - Pacemaker interprets this exit code as a soft error. 
#     
# 2 - OCF_ERR_ARGS
#   - The resource’s configuration is not valid on this machine. This can happen if the serve fails to boot
#     because of a missing bridge, for example.
#    
# 3 - OCF_ERR_UNIMPLEMENTED
#   - The resource agent was instructed to execute an action that we do not implement.
#   - Not all resource agent actions are mandatory. We don't implement 'promote' or 'demote'. We do implement
#     'migrate_to', 'migrate_from', and 'notify'. If we're misconfigured as a master/slave resource, for 
#     example, then will alert the user about this misconfiguration by returning OCF_ERR_UNIMPLEMENTED.
#     
# 4 - OCF_ERR_PERM 
#   - The action failed due to insufficient permissions. This may be due to a node not being able to open a
#     definition file or resource config. 
#   - Pacemaker interprets this exit code as a hard error. 
#     
# 5 - OCF_ERR_INSTALLED
#   - The action failed because a required component is missing on the node where the action was executed. 
#     This may be due to a required binary not being executable, or a the DRBD resource config file not 
#     existing.
#   - Pacemaker interprets this exit code as a hard error.
#     
# 6 - OCF_ERR_CONFIGURED
#   - The action failed because the user misconfigured the resource in pacemaker. For example, the user may 
#     have configured an alphanumeric string for a parameter that really should be an integer.
#   - Pacemaker interprets this exit code as a fatal error.
#     
# 7 - OCF_NOT_RUNNING
#   - The resource was found not to be running. This is an exit code that may be returned by the monitor 
#     action exclusively. Note that this implies that the resource has either gracefully shut down, or has 
#     never been started.
#     
# 8 - OCF_RUNNING_MASTER
# 9 - OCF_FAILED_MASTER
#   - These OCF exit codes are not used here.
#     

# NOTE: We don't use Anvil::Tools to keep overhead low and to keep this agent independent as possible.
use strict;
use warnings;
use XML::Simple;
use Math::BigInt;
use Data::Dumper;

# Turn off buffering so that the pinwheel will display while waiting for the SSH call(s) to complete.
$| = 1;

my $THIS_FILE           =  ($0 =~ /^.*\/(.*)$/)[0];
my $running_directory   =  ($0 =~ /^(.*?)\/$THIS_FILE$/)[0];
if (($running_directory =~ /^\./) && ($ENV{PWD}))
{
	$running_directory =~ s/^\./$ENV{PWD}/;
}

my $conf = {
	'log'		=>	{
		facility	=>	"local0",
		level		=>	2,
		line_numbers	=>	1,
		tag		=>	"ocf:alteeve:".$THIS_FILE,
	},
	# If a program isn't at the defined path, $ENV{PATH} will be searched.
	path		=>	{
		config		=>	{
			definition	=>	"/mnt/anvil/definitions/#!NAME!#.xml",
		},
		exe		=>	{
			brctl		=>	"/usr/sbin/brctl",
			cibadmin	=>	"/usr/sbin/cibadmin",
			crm_error	=>	"/usr/sbin/crm_error",
			drbdadm		=>	"/usr/sbin/drbdadm",
			echo		=>	"/usr/bin/echo",
			free		=>	"/usr/bin/free",
			getent		=>	"/usr/bin/getent",
			logger		=>	"/usr/bin/logger",
			stonith_admin	=>	"/usr/sbin/stonith_admin",
			virsh		=>	"/usr/bin/virsh",
		},
	},
	environment	=>	{
		# This is the name of the server we're managing.										      # Example values:
		OCF_RESKEY_name			=>	defined $ENV{OCF_RESKEY_name}                  ? $ENV{OCF_RESKEY_name}                  : "", # srv01-c7	
		# This is our node name
		OCF_RESKEY_CRM_meta_on_node	=>	defined $ENV{OCF_RESKEY_CRM_meta_on_node}      ? $ENV{OCF_RESKEY_CRM_meta_on_node}      : "", # m3-a02n01.alteeve.com
		# This says "UUID", but it's the node ID.
		OCF_RESKEY_CRM_meta_on_node_uuid =>	defined $ENV{OCF_RESKEY_CRM_meta_on_node_uuid} ? $ENV{OCF_RESKEY_CRM_meta_on_node_uuid} : "", # 1
		# This is the timeout for the called action in millisecond.
		OCF_RESKEY_CRM_meta_timeout	=>	defined $ENV{OCF_RESKEY_CRM_meta_timeout}      ? $ENV{OCF_RESKEY_CRM_meta_timeout}      : "", # 20000
		# If this is set, we'll bump our log level as well.
		PCMK_debug			=>	defined $ENV{PCMK_debug}                       ? $ENV{PCMK_debug}                       : "", # 0
		# These are other variables that are set, but we don't currently care about them
		OCF_EXIT_REASON_PREFIX		=>	defined $ENV{OCF_EXIT_REASON_PREFIX}           ? $ENV{OCF_EXIT_REASON_PREFIX}           : "", # ocf-exit-reason:
		OCF_RA_VERSION_MAJOR		=>	defined $ENV{OCF_RA_VERSION_MAJOR}             ? $ENV{OCF_RA_VERSION_MAJOR}             : "", # 1
		OCF_RA_VERSION_MINOR		=>	defined $ENV{OCF_RA_VERSION_MINOR}             ? $ENV{OCF_RA_VERSION_MINOR}             : "", # 0
		OCF_RESKEY_crm_feature_set	=>	defined $ENV{OCF_RESKEY_crm_feature_set}       ? $ENV{OCF_RESKEY_crm_feature_set}       : "", # 3.0.12
		OCF_RESOURCE_INSTANCE		=>	defined $ENV{OCF_RESOURCE_INSTANCE}            ? $ENV{OCF_RESOURCE_INSTANCE}            : "", # srv01-c7
		OCF_RESOURCE_PROVIDER		=>	defined $ENV{OCF_RESOURCE_PROVIDER}            ? $ENV{OCF_RESOURCE_PROVIDER}            : "", # alteeve
		OCF_RESOURCE_TYPE		=>	defined $ENV{OCF_RESOURCE_TYPE}                ? $ENV{OCF_RESOURCE_TYPE}                : "", # server
		OCF_ROOT			=>	defined $ENV{OCF_ROOT}                         ? $ENV{OCF_ROOT}                         : "", # /usr/lib/ocf
	},
};

# If pacemaker is in debug, so are we,
if ($conf->{environment}{PCMK_debug})
{
	$conf->{'log'}{level} = 3;
}

# Find executables.
find_executables($conf);

# Get any command line switches.
get_switches($conf);

### TEST: to be removed later
if ($conf->{switches}{test})
{
	$conf->{environment}{OCF_RESKEY_name} = "srv01-c7";
}

# Something for the logs
to_log($conf, {message => "ocf:alteeve:server invoked.", 'line' => __LINE__, level => 2});

# This is for debugging.
show_environment($conf, 2);

### What are we being asked to do?
# start        - Starts the resource.
# stop         - Shuts down the resource.
# monitor      - (status aliases here) Queries the resource for its state.
# meta-data    - Dumps the resource agent metadata.
# promote      - Turns a resource into the Master role (Master/Slave resources only).
# demote       - Turns a resource into the Slave role (Master/Slave resources only).
# migrate_to   - migration target
# migrate_from - Implement live migration of resources.
# validate-all - Validates a resource’s configuration.
# help         - (usage maps here) Displays a usage message when the resource agent is invoked from the command line, rather than by the cluster manager.
# notify       - Inform resource about changes in state of other clones.

if ($conf->{switches}{start})
{
	# Start the server
	start_server($conf);
}
elsif ($conf->{switches}{stop})
{
	# Stop the server
	stop_server($conf);
}
elsif (($conf->{switches}{monitor}) or ($conf->{switches}{status}))
{
	# Report the status of the server.
	server_status($conf);
}
elsif (($conf->{switches}{metadaata}) or ($conf->{switches}{'meta-data'}))
{
	show_metadata($conf);
}
elsif ($conf->{switches}{promote})
{
	# We don't support this, so we return OCF_ERR_UNIMPLEMENTED (3)
	to_log($conf, {message => "We were asked to promote: [".$conf->{environment}{OCF_RESKEY_name}."], which makes no sense and is not supported. Ignoreing.", 'line' => __LINE__, level => 0, priority => "err"});
	exit(3);
}
elsif ($conf->{switches}{demote})
{
	# We don't support this, so we return OCF_ERR_UNIMPLEMENTED (3)
	to_log($conf, {message => "We were asked to demote: [".$conf->{environment}{OCF_RESKEY_name}."], which makes no sense and is not supported. Ignoreing.", 'line' => __LINE__, level => 0, priority => "err"});
	exit(3);
}
elsif (($conf->{switches}{migrate_to}) && ($conf->{switches}{migrate_from}))
{
	# We don't support this, so we return OCF_ERR_UNIMPLEMENTED (3)
	migrate_server($conf);
}
elsif ($conf->{switches}{'validate-all'})
{
	# Validate our local config and setup.
	validate($conf);
	exit(0);
}
elsif (($conf->{switches}{help}) && ($conf->{switches}{usage}))
{
	# Show the usage information
	show_usage($conf);
	exit(0);
}
elsif ($conf->{switches}{notify})
{
	# We don't implement this
	to_log($conf, {message => "We were asked to notify, but this is not a promotable (we're stateless) agent. Ignoring.", 'line' => __LINE__, level => 0, priority => "warn"});
	exit(3);
}
else
{
	# We were called in some unexpected way. Log an error, show usage and exit.
	to_log($conf, {message => "We were invoked with an unexpected (or no) command. Environment variables and arguments below.", 'line' => __LINE__, level => 0, priority => "warn"});
	show_environment($conf, 0);
	exit(1);
}

# If we hit here, something very wrong happened.
exit(255);


#############################################################################################################
# Functions                                                                                                 #
#############################################################################################################

# This boots the server if possible.
sub start_server
{
	my ($conf) = @_;
	
	# Start procedure;
	# 1. Read the XML definition file and find the backing storage and bridges. Soft error if read fails.
	# 2. Make sure the name matches.
	# 3. Make sure we have enough free RAM.
	# 4. Make sure the emulator exists (can be an issue after migrating from an different gen Anvil!).
	# 5.1. Make sure optical drives with mounted data have the disk present. Soft error if not.
	# 5.2. Find any backing DRBD devices
	# 6. For each DRBD device;
	# 6.1. Make sure the backing LV is ACTIVE. Soft error if not.
	# 6.2. Check if the drbd resource is up. If not, up it.
	# 6.3. Make sure the backing disk is UpToDate. Soft error if not.
	# 6.4. Make sure the backing device is 'Connected' or 'Connecting'. Call a connect if not.
	# 7. Make sure all bridges exist and soft error if not.
	# 8. Start the server.
	
	to_log($conf, {message => "We've been asked to start the server: [".$conf->{environment}{OCF_RESKEY_name}."]..", 'line' => __LINE__, level => 2});
	validate_all($conf);
	
	exit(0);
}

# This shuts down the server if possible.
sub stop_server
{
	my ($conf) = @_;
	
	exit(0);
}

# This checks the status of the server.
sub server_status
{
	my ($conf) = @_;
	
	# If the named server is running, return OCF_SUCCESS (0), otherwise OCF_NOT_RUNNING (7). If the 
	# server is failed, return OCF_ERR_GENERIC (1).
	my $state  = "";
	my $server = $conf->{environment}{OCF_RESKEY_name};
	
	### NOTE: When pacemaker is first starting, virsh won't be up right away. So if we get a return code 
	###       of '1', we'll try again up to 50% of 'environment::OCF_RESKEY_CRM_meta_timeout'.
	if (not $conf->{environment}{OCF_RESKEY_CRM_meta_timeout})
	{
		# Set a sane default of 20 seconds.
		$conf->{environment}{OCF_RESKEY_CRM_meta_timeout} = 20000;
		to_log($conf, {message => "The environment variable 'OCF_RESKEY_CRM_meta_timeout' was not set, so setting it to: [".$conf->{environment}{OCF_RESKEY_CRM_meta_timeout}."].", 'line' => __LINE__, level => 1, priority => "warn"});
	}
	my $return_code  = undef;
	my $output       = "";
	my $current_time = time;
	my $timeout      = $current_time + int(($conf->{environment}{OCF_RESKEY_CRM_meta_timeout} /= 1000) / 2);
	my $waiting      = 1;
	to_log($conf, {message => "current_time: [$current_time], timeout: [$timeout].", 'line' => __LINE__, level => 2});
	
	while($waiting)
	{
		# Make the call
		($return_code, $output) = shell_call($conf, $conf->{path}{exe}{virsh}." list");
		to_log($conf, {message => "return_code: [$return_code].", 'line' => __LINE__, level => 2});
		if (not $return_code)
		{
			$waiting = 0;
			to_log($conf, {message => "waiting: [$waiting].", 'line' => __LINE__, level => 2});
		}
		elsif (time > $timeout)
		{
			# We've waited long enough.
			$waiting = 0;
			to_log($conf, {message => "The 'virsh' call exited with the return code: [$return_code]. The 'libvirtd' may have failed to start. We won't wait any longer.", 'line' => __LINE__, level => 1, priority => "warn"});
		}
		else
		{
			to_log($conf, {message => "The 'virsh' call exited with the return code: [$return_code]. The 'libvirtd' service might be starting, so we will check again shortly.", 'line' => __LINE__, level => 2});
			sleep 2;
		}
	}
	
	# If I got a non-zero return code, something went wrong with the virsh call.
	if ($return_code)
	{
		to_log($conf, {message => "It would appear that libvirtd is not operating (or not operating correctly). Expected the return code '0' but got: [$return_code].", 'line' => __LINE__, level => 0, priority => "err"});
		if ($output)
		{
			to_log($conf, {message => "Output of: [".$conf->{path}{exe}{virsh}." list] follows;", 'line' => __LINE__, level => 0, priority => "err"});
			to_log($conf, {message => "Output: [$output]", 'line' => __LINE__, level => 0, priority => "err"});
		}
		exit(1);
	}
	
	# If we're still alive, process the output
	foreach my $line (split/\n/, $output)
	{
		$line =~ s/^\s+//;
		$line =~ s/\s+$//;
		$line =~ s/\s+/ /g;
		
		if ($line =~ /^(\d+) $server (.*)$/)
		{
			$state = $2;
			to_log($conf, {message => "server: [$server], state: [$state]", 'line' => __LINE__, level => 2});
			
			last;
		}
	}
	
	# If there is a state, see what the state is.
	if ($state)
	{
		### What is the state?
		## States we return OCF_SUCCESS (0).
		# running     - The domain is currently running on a CPU
		# paused      - The domain has been paused, usually occurring through the administrator 
		#               running virsh suspend. When in a paused state the domain will still consume 
		#               allocated resources like memory, but will not be eligible for scheduling by 
		#               the hypervisor.
		# pmsuspended - The domain has been suspended by guest power management, e.g. entered into s3
		#               state.
		# in shutdown - The domain is in the process of shutting down, i.e. the guest operating 
		#               system has been notified and should be in the process of stopping its 
		#               operations gracefully.
		## States we'll return OCF_NOT_RUNNING (7).
		# shut off    - The domain is not running. Usually this indicates the domain has been shut 
		#               down completely, or has not been started.
		## States we'll return OCF_ERR_GENERIC (1).
		# idle        - The domain is idle, and not running or runnable. This can be caused because 
		#               the domain is waiting on IO (a traditional wait state) or has gone to sleep 
		#               because there was nothing else for it to do.
		# crashed     - The domain has crashed, which is always a violent ending. Usually this state
		#               can only occur if the domain has been configured not to restart on crash.
		if (($state eq "running") or ($state eq "paused") or ($state eq "pmsuspended") or ($state eq "in shutdown"))
		{
			to_log($conf, {message => "The server: [$server] is: [$state], which is OK.", 'line' => __LINE__, level => 1});
			exit(0);
		}
		elsif ($state eq "shut off")
		{
			to_log($conf, {message => "The server: [$server] is: [$state].", 'line' => __LINE__, level => 1});
			exit(7);
		}
		elsif (($state eq "idle") or ($state eq "crashed"))
		{
			to_log($conf, {message => "The server: [$server] is in a bad state: [$state]!", 'line' => __LINE__, level => 0, priority => "err"});
			exit(1);
		}
		else
		{
			# WTF?
			to_log($conf, {message => "The server: [$server] is in an unexpected state: [$state]!", 'line' => __LINE__, level => 0, priority => "err"});
			exit(1);
		}
	}
	else
	{
		# Not running. Exit with OCF_NOT_RUNNING
		to_log($conf, {message => "The server: [$server] is not running on this node.", 'line' => __LINE__, level => 1});
		exit(7);
	}
	
	exit(0);
}

# Migrate the server
sub migrate_server
{
	my ($conf) = @_;
	
	# If we were given 'migrate_to', then just verify that the node name makes sense. If we were given 
	# 'migrate_from', we need to find the peer.
	
	# Return failed until this is actually implemented.
	exit(1);
}

# Validation checks that we have the definition XML, resource config and that needed apps are installed.
sub validate_all
{
	my ($conf) = @_;
	to_log($conf, {message => "Running validation tests...", 'line' => __LINE__, level => 2});
	
	# Read in the server's definition file (if found and readable).
	read_server_definition($conf);
	to_log($conf, {message => "- Server definition was read.", 'line' => __LINE__, level => 2});
	
	# Does the internal server name match?
	validate_name($conf);
	to_log($conf, {message => "- Server name is valid.", 'line' => __LINE__, level => 2});
	
	# Make sure the emulator it wants is the one we have.
	validate_emulator($conf);
	to_log($conf, {message => "- Eumlator is valid.", 'line' => __LINE__, level => 2});
	
	# These tests are only needed if we're about to boot the server
	if ($conf->{switches}{start})
	{
		# Check that we have enough RAM.
		validate_ram($conf);
		to_log($conf, {message => "- Sufficient RAM is available.", 'line' => __LINE__, level => 2});
	}
	
	# Validate storage (Disks and optical media)
	validate_storage($conf);
	to_log($conf, {message => "- Storage is valid and ready.", 'line' => __LINE__, level => 2});
	
	# Validate bridges
	validate_bridges($conf);
	to_log($conf, {message => "- Network bridge(s) are available.", 'line' => __LINE__, level => 2});
	
	exit(0);
}

# This ensures that the bridges the server connects to exist on this node.
sub validate_bridges
{
	my ($conf) = @_;
	
	# Find the Optical drives and DRBD devices.
	foreach my $device_ref (@{$conf->{server}{definition_xml}->{devices}})
	{
		foreach my $interface_ref (@{$device_ref->{interface}})
		{
			foreach my $source_ref (@{$interface_ref->{source}})
			{
				my $bridge                           = $source_ref->{bridge};
				   $conf->{server}{bridges}{$bridge} = 1;
				to_log($conf, {message => "server::bridges::${bridge}: [".$conf->{server}{bridges}{$bridge}."].", 'line' => __LINE__, level => 3});
			}
		}
	}
	
	# Get a list of available bridges.
	my ($return_code, $output) = shell_call($conf, $conf->{path}{exe}{brctl}." show");
	my $first_line             = 1;
	foreach my $line (split/\n/, $output)
	{
		to_log($conf, {message => "line: [$line].", 'line' => __LINE__, level => 3});
		if ($first_line)
		{
			# We skip the first line instead of parse the string to avoid getting caught by 
			# translations.
			$first_line = 0;
		}
		elsif ($line =~ /^(\S+)\s/)
		{
			my $bridge = $1;
			   $conf->{'local'}{bridge}{$bridge} = 1;
			to_log($conf, {message => "local::bridge::${bridge}: [$bridge].", 'line' => __LINE__, level => 3});
		}
	}
	
	# Verify bridges now
	foreach my $bridge (sort {$a cmp $b} keys %{$conf->{server}{bridges}})
	{
		if ($conf->{'local'}{bridge}{$bridge})
		{
			to_log($conf, {message => "The bridge: [$bridge] is available for this server.", 'line' => __LINE__, level => 2});
		}
		else
		{
			# Missing bridge.
			to_log($conf, {message => "The server wants to connect to the bridge: [$bridge] which we do not have on this node.", 'line' => __LINE__, level => 0, priority => "err"});
			exit(5);
		}
	}
	
	return(0);
}

# This looks up the disks and optical media connected to this server.
sub validate_storage
{
	my ($conf) = @_;

	# Find the bridge(s) this server uses.
	foreach my $device_ref (@{$conf->{server}{definition_xml}->{devices}})
	{
		foreach my $disk_ref (@{$device_ref->{disk}})
		{
			my $type = $disk_ref->{device};
			to_log($conf, {message => "type: [$type].", 'line' => __LINE__, level => 2});
			if ($type eq "disk")
			{
				foreach my $source_ref (@{$disk_ref->{source}})
				{
					my $disk                         = $source_ref->{dev};
					   $conf->{server}{disks}{$disk} = 1;
					to_log($conf, {message => "server::disks::${disk}: [".$conf->{server}{disks}{$disk}."].", 'line' => __LINE__, level => 2});
				}
			}
			elsif ($type eq "cdrom")
			{
				foreach my $source_ref (@{$disk_ref->{source}})
				{
					my $file                           = $source_ref->{file};
					   $conf->{server}{optical}{$file} = 1;
					to_log($conf, {message => "server::optical::${file}: [".$conf->{server}{optical}{$file}."].", 'line' => __LINE__, level => 2});
				}
			}
		}
	}
	
	# Verify DRBD devices now
	foreach my $disk (sort {$a cmp $b} keys %{$conf->{server}{disks}})
	{
		to_log($conf, {message => "Checking that the DRBD device: [$disk] is ready.", 'line' => __LINE__, level => 2});
	}
	
	# Verify optical disks now
	foreach my $file (sort {$a cmp $b} keys %{$conf->{server}{optical}})
	{
		to_log($conf, {message => "Checking that the optical disc image: [$file] exists.", 'line' => __LINE__, level => 2});
		
		# If the file doesn't exist, exit with OCF_ERR_INSTALLED (5). If we can't read it, exit with 
		# OCF_ERR_PERM (4).
		if (not -e $file)
		{
		}
		elsif (not -r $file)
		{
		}
		else
		{
			# We're OK.
		}
	}
	
	return(0);
}

# This verifies that the requested emulator exists and can be used.
sub validate_emulator
{
	my ($conf) = @_;
	
	# What emulator is this using?
	my $emulator = $conf->{server}{definition_xml}->{devices}->[0]->{emulator}->[0];
	to_log($conf, {message => "emulator: [$emulator]", 'line' => __LINE__, level => 2});
	if (not -e $emulator)
	{
		# It doesn't exist. Exit with OCF_ERR_INSTALLED (5).
		to_log($conf, {message => "The server wants to use the emulator: [$emulator] which doesn't exist on this node. Was this server migrated from a different generation Anvil! system? Please update '<emulator>...</emulator>' in the server's definition file: [".$conf->{server}{definition_file}."].", 'line' => __LINE__, level => 0, priority => "err"});
		exit(5);
	}
	if (not -x $emulator)
	{
		# We can't execute it. Exit with OCF_ERR_PERM (4).
		to_log($conf, {message => "The server wants to use the emulator: [$emulator] which exists, but we can't run. Please check permissions and for SELinux denials.", 'line' => __LINE__, level => 0, priority => "err"});
		exit(4);
	}
	
	return(0);
}

# This makes sure the name we see in the definition file matches what we expect.
sub validate_name
{
	my ($conf) = @_;
	
	my $server = $conf->{environment}{OCF_RESKEY_name};
	if ($server ne $conf->{server}{definition_xml}->{name}->[0])
	{
		to_log($conf, {message => "The configured server name: [$server] does not match the name of the server in the definition file: [".$conf->{server}{definition_xml}->{name}."]!", 'line' => __LINE__, level => 0, priority => "err"});
		exit(1);
	}
	
	return(0);
}

# This checks that there is enough RAM to run this server.
sub validate_ram
{
	my ($conf) = @_;
	
	# How mcuh RAM does the server need?
	my $server_ram_value = $conf->{server}{definition_xml}->{memory}->[0]->{content};
	my $server_ram_units = $conf->{server}{definition_xml}->{memory}->[0]->{unit};
	to_log($conf, {message => "server_ram_value: [$server_ram_value], server_ram_units: [$server_ram_units].", 'line' => __LINE__, level => 2});
	
	# Convert to bytes
	my $server_ram_bytes = $server_ram_value;
	if    ($server_ram_units =~ /^k/i) { $server_ram_bytes = ($server_ram_value * (2 ** 10));                             }
	elsif ($server_ram_units =~ /^m/i) { $server_ram_bytes = ($server_ram_value * (2 ** 20));                             }
	elsif ($server_ram_units =~ /^g/i) { $server_ram_bytes = ($server_ram_value * (2 ** 30));                             }
	elsif ($server_ram_units =~ /^t/i) { $server_ram_bytes = ($server_ram_value * (2 ** 40));                             }
	elsif ($server_ram_units =~ /^p/i) { $server_ram_bytes = Math::BigInt->new('2')->bpow('50')->bmul($server_ram_value); }
	elsif ($server_ram_units =~ /^e/i) { $server_ram_bytes = Math::BigInt->new('2')->bpow('60')->bmul($server_ram_value); }
	elsif ($server_ram_units =~ /^z/i) { $server_ram_bytes = Math::BigInt->new('2')->bpow('70')->bmul($server_ram_value); }
	elsif ($server_ram_units =~ /^y/i) { $server_ram_bytes = Math::BigInt->new('2')->bpow('80')->bmul($server_ram_value); }
	to_log($conf, {message => "server_ram_bytes: [$server_ram_bytes].", 'line' => __LINE__, level => 3});
	
	# How much RAM do we have available?
	my $available               = 0;
	my ($free_rc, $free_output) = shell_call($conf, $conf->{path}{exe}{free}." --bytes");
	foreach my $line (split/\n/, $free_output)
	{
		to_log($conf, {message => "line: [$line].", 'line' => __LINE__, level => 3});
		if ($line =~ /Mem:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/)
		{
			my $total     = $1;
			my $used      = $2;
			my $free      = $3;
			my $shared    = $4;
			my $cache     = $5;
			   $available = $6;
			to_log($conf, {message => "total: [$total], used: [$used], free: [$free], shared: [$shared], cache: [$cache], available: [$available]", 'line' => __LINE__, level => 3});
		}
	}
	
	to_log($conf, {message => "server_ram_bytes: [".comma($conf, $server_ram_bytes)." bytes].", 'line' => __LINE__, level => 2});
	to_log($conf, {message => "available: ...... [".comma($conf, $available)." bytes].", 'line' => __LINE__, level => 2});
	if ($server_ram_bytes > $available)
	{
		# Not enough free memory.
		to_log($conf, {message => "The configured server name: [".$conf->{environment}{OCF_RESKEY_name}."] needs: [".comma($conf, $server_ram_bytes)." bytes] of RAM, but only: [".comma($conf, $available)." bytes] are available!", 'line' => __LINE__, level => 0, priority => "err"});
		exit(1);
	}
	
	return(0);
}

# This reads the XML definition data into an XML data hash.
sub read_server_definition
{
	my ($conf) = @_;
	
	my $server          =  $conf->{environment}{OCF_RESKEY_name};
	my $definition_file =  $conf->{path}{config}{definition};
	   $definition_file =~ s/#!NAME!#/$server/;
	my $server_xml      =  "";
	to_log($conf, {message => "server: [$server], definition_file: [$definition_file]", 'line' => __LINE__, level => 3});
	
	# If the file doesn't exist, return OCF_ERR_INSTALLED (5). If the file exists but we can't read it, 
	# return OCF_ERR_PERM (4).
	if (not -e $definition_file)
	{
		to_log($conf, {message => "The definition file: [$definition_file] for the server: [$server] does not exist here!", 'line' => __LINE__, level => 0, priority => "err"});
		exit(5);
	}
	elsif (not -r $definition_file)
	{
		to_log($conf, {message => "The definition file: [$definition_file] for the server: [$server] can not be read!", 'line' => __LINE__, level => 0, priority => "err"});
		exit(4);
	}
	
	# Still alive? Read it in.
	my ($definition_xml) = read_file($conf, $definition_file);
	to_log($conf, {message => "definition_xml: [$definition_xml]", 'line' => __LINE__, level => 3});
	
	my $xml = XML::Simple->new();
	eval { $server_xml = $xml->XMLin($definition_xml, KeyAttr => {}, ForceArray => 1) };
	if ($@)
	{
		chomp $@;
		my $error =  "[ Error ] - The was a problem parsing: [$definition_file]. The error was:\n";
		   $error .= "===========================================================\n";
		   $error .= $@."\n";
		   $error .= "===========================================================\n";
		to_log($conf, {message => $error, 'line' => __LINE__, level => 0, priority => "err"});
		exit(1);
	}
	
	$conf->{server}{definition_xml}  = $server_xml;
	$conf->{server}{definition_file} = $definition_file;
	
	return(0);
}

# This reads in a file and returns the contents as a single string variable.
sub read_file
{
	my ($conf, $file) = @_;
	
	my $body = "";
	open (my $file_handle, "<".$file) or to_log($conf, {message => "Failed to read: [$file]. The error was: $!", 'line' => __LINE__, level => 0, priority => "err", exit_code => 1});
	while(<$file_handle>)
	{
		# This should not generate output.
		chomp;
		my $line =  $_;
		to_log($conf, {message => "Output: [$line]", 'line' => __LINE__, level => 3});
		
		$body .= $line."\n";
	}
	close $file_handle;
	
	to_log($conf, {message => "body: [$body]", 'line' => __LINE__, level => 3});
	return($body);
}

# This makes a system call and returns the return code and the output as string variable.
sub shell_call
{
	my ($conf, $shell_call) = @_;
	
	   $shell_call  .= " 2>&1; ".$conf->{path}{exe}{echo}." return_code:\$?";
	my $return_code =  9999;
	my $output      =  "";
	to_log($conf, {message => "Calling: [$shell_call]", 'line' => __LINE__, level => 2});
	open (my $file_handle, $shell_call." 2>&1 |") or to_log($conf, {message => "Failed to call: [".$shell_call."]. The error was: $!", 'line' => __LINE__, level => 0, priority => "err", exit_code => 1});
	while(<$file_handle>)
	{
		# This should not generate output.
		chomp;
		my $line =  $_;
		to_log($conf, {message => "line: [$line]", 'line' => __LINE__, level => 3});
		if ($line =~ /^return_code:(\d+)$/)
		{
			$return_code = $1;
			to_log($conf, {message => "return_code: [$return_code]", 'line' => __LINE__, level => 3});
			next;
		}
		$output .= $line."\n";
		to_log($conf, {message => "Output: [$line]", 'line' => __LINE__, level => 3});
	}
	close $file_handle;
	
	to_log($conf, {message => "return_code: [$return_code], output: [$output]", 'line' => __LINE__, level => 3});
	return($return_code, $output);
}

# This logs the details of this call.
sub show_environment
{
	my ($conf, $level) = @_;
	
	foreach my $key (sort {$a cmp $b} keys %{$conf->{switches}})
	{
		next if $key eq "raw";
		next if $conf->{switches}{$key} eq "";
		to_log($conf, {message => "Command line switch: [$key] -> [".$conf->{switches}{$key}."]", 'line' => __LINE__, level => $level});
	}
	foreach my $key (sort {$a cmp $b} keys %{$conf->{environment}})
	{
		next if $conf->{environment}{$key} eq "";
		to_log($conf, {message => "OCF Environment variable: [$key] -> [".$conf->{environment}{$key}."]", 'line' => __LINE__, level => $level});
	}
	foreach my $key (sort {$a cmp $b} keys %ENV)
	{
		next if exists $conf->{environment}{$key};
		to_log($conf, {message => "System Environment variable: [$key] -> [".$ENV{$key}."]", 'line' => __LINE__, level => ($level + 1)});
	}
	
	return(0);
}

# This just prints a quick usage message for now.
sub show_usage
{
	my ($conf) = @_;
	
	print "TODO: How to use this...\n";
	
	exit(0);
}

# This prints out the metadata and exits.
sub show_metadata
{
	my ($conf) = @_;
	
	# This is a pretty simple agent, by design. We only take a server name for now.
	print '<?xml version="1.0"?>
<!DOCTYPE resource-agent SYSTEM "ra-api-1.dtd">
<resource-agent name="ocs:alteeve:server">
  <version>0.1</version>
  <longdesc lang="en">
This resource agent manages KVM+qemu virtual servers on an Anvil! m3 Intelligent Availability(tm) system. 
It manages underlying components like DRBD 9 storage resources, brodge connections and so forth.
  </longdesc>
  <shortdesc lang="en">Anvil! m3 server resource agent</shortdesc>
  <parameters>
    <parameter name="name" unique="1" required="1">
      <longdesc lang="en">
        This is the name of the server as reported by virsh.
      </longdesc>
      <shortdesc lang="en">Server name</shortdesc>
      <content type="string"/>
    </parameter>
  </parameters>
  <actions>
    <action name="start"        timeout="30" />
    <action name="stop"         timeout="600" />
    <action name="monitor"      timeout="10" interval="10" depth="0" />
    <action name="notify"       timeout="20" />
    <action name="migrate_to"   timeout="600" />
    <action name="migrate_from" timeout="600" />
    <action name="meta-data"    timeout="5" />
    <action name="validate-all" timeout="20" />
  </actions>
</resource-agent>
';
	
	exit(0);
}

# This gathers command line switches and stores them in 'swithes::<foo>'.
sub get_switches
{
	my ($conf) = @_;
	
	my $last_argument         = "";
	   $conf->{switches}{raw} = "";
	foreach my $argument (@ARGV)
	{
		to_log($conf, {message => "argument: [$argument]", 'line' => __LINE__, level => 3});
		if ($last_argument eq "raw")
		{
			# Don't process anything.
			$conf->{switches}{raw} .= " ".$argument;
			to_log($conf, {message => "switches::raw: [".$conf->{switches}{raw}."]", 'line' => __LINE__, level => 3});
		}
		elsif ($argument =~ /^-/)
		{
			# If the argument is just '--', appeand everything after it to 'raw'.
			if ($argument eq "--")
			{
				$last_argument         = "raw";
				$conf->{switches}{raw} = "";
				to_log($conf, {message => "switches::raw: [".$conf->{switches}{raw}."]", 'line' => __LINE__, level => 3});
			}
			else
			{
				($last_argument) = ($argument =~ /^-{1,2}(.*)/)[0];
				to_log($conf, {message => "last_argument: [$last_argument]", 'line' => __LINE__, level => 3});
				if ($last_argument =~ /=/)
				{
					# Break up the variable/value.
					($last_argument, my $value)       = (split /=/, $last_argument, 2);
					$conf->{switches}{$last_argument} = $value;
					to_log($conf, {message => "switches::${last_argument}: [".$conf->{switches}{$last_argument}."]", 'line' => __LINE__, level => 3});
				}
				else
				{
					$conf->{switches}{$last_argument} = "#!SET!#";
					to_log($conf, {message => "switches::${last_argument}: [".$conf->{switches}{$last_argument}."]", 'line' => __LINE__, level => 3});
				}
			}
		}
		else
		{
			if ($last_argument)
			{
				$conf->{switches}{$last_argument} = $argument;
				to_log($conf, {message => "switches::${last_argument}: [".$conf->{switches}{$last_argument}."]", 'line' => __LINE__, level => 3});
				
				$last_argument = "";
				to_log($conf, {message => "last_argument: [$last_argument]", 'line' => __LINE__, level => 3});
			}
			else
			{
				# Got a value without an argument. That's OK.
				$conf->{switches}{$argument} = "#!SET!#";
				to_log($conf, {message => "switches::${argument}: [".$conf->{switches}{$argument}."]", 'line' => __LINE__, level => 3});
			}
		}
	}
	
	# Clean up the initial space added to 'raw'.
	to_log($conf, {message => "switches::raw: [".$conf->{switches}{raw}."]", 'line' => __LINE__, level => 3});
	if ($conf->{switches}{raw})
	{
		$conf->{switches}{raw} =~ s/^ //;
		to_log($conf, {message => "switches::raw: [".$conf->{switches}{raw}."]", 'line' => __LINE__, level => 3});
	}
	
	return(0);
}

# This adds commas to long numbers.
sub comma
{
	my ($conf, $number) = @_;

	return undef if not defined $number;
	
	# Strip out any existing commas.
	$number =~ s/,//g;
	
	# Record and remove the sign, if present.
	my $sign = "";
	if ($number =~ /^\+/)
	{
		$number =~ s/^\+//g;
		$sign   =  "+";
	}
	elsif ($number =~ /^\-/)
	{
		$number =~ s/^\-//g;
		$sign   =  "-";
	}
	
	# Split on the left-most period.
	my ($whole, $decimal) = split/\./, $number, 2;
	   $whole             = "" if not defined $whole;
	   $decimal           = "" if not defined $decimal;
	
	# Now die if either number has a non-digit character in it.
	if (($whole =~ /\D/) or ($decimal =~ /\D/))
	{
		to_log($conf, {message => "We were asked to insert commas into a dumber that is not actually a number: [$number]. This is likely a symptom of a larger problem.", 'line' => __LINE__, level => 0, priority => "err"});
		exit(1);
	}
	
	local($_) = $whole ? $whole : "";
	
	1 while s/^(-?\d+)(\d{3})/$1,$2/;
	$whole = $_;
	
	my $return = $decimal ? $whole.".".$decimal : $whole;
	if ($sign)
	{
		$return = $sign.$return;
	}
	
	return ($return);
}

# Log file entries
sub to_log
{
	my ($conf, $parameters) = @_;
	
	my $facility  = defined $parameters->{facility}  ? $parameters->{facility}  : $conf->{'log'}{facility};
	my $level     = defined $parameters->{level}     ? $parameters->{level}     : 1;
	my $line      = defined $parameters->{'line'}    ? $parameters->{'line'}    : 0;
	my $message   = defined $parameters->{message}   ? $parameters->{message}   : "";
	my $priority  = defined $parameters->{priority}  ? $parameters->{priority}  : "";
	my $exit_code = defined $parameters->{exit_code} ? $parameters->{exit_code} : "";
	
	# Leave if we don't care about this message
	return if $level > $conf->{'log'}{level};
	return if not $message;
	
	# Build the message. We log the line
	if (($conf->{'log'}{line_numbers}) && ($line))
	{
		$message = $line."; ".$message;
	}
	
	my $priority_string = $facility;
	if ($priority)
	{
		$priority_string .= ".".$priority;
	}
	elsif ($level eq "0")
	{
		$priority_string .= ".notice";
	}
	elsif (($level eq "1") or ($level eq "2"))
	{
		$priority_string .= ".info";
	}
	else
	{
		$priority_string .= ".debug";
	}
	
	# Clean up the string for bash
	$message =~ s/"/\\\"/gs;
	#$message =~ s/\(/\\\(/gs;
	
	my $shell_call = $conf->{path}{exe}{logger}." --priority ".$priority_string." --tag ".$conf->{'log'}{tag}." -- \"".$message."\"";
	open (my $file_handle, $shell_call." 2>&1 |") or die "Failed to call: [".$shell_call."]. The error was: $!\n";
	while(<$file_handle>)
	{
		# This should not generate output.
		chomp;
		my $line = $_;
		print "Unexpected logging output: [".$line."]\n";
	}
	close $file_handle;
	
	if ($exit_code =~ /^\d+$/)
	{
		exit($exit_code);
	}
	
	return(0);
}

# This checks the given paths and, if something isn't found, it searches PATH trying to find it.
sub find_executables
{
	my ($conf) = @_;

	# Variables.
	my $check = "";
	my $bad   = 0;

	# Log entries can only happen if I've found 'logger', so an extra check will be made on 'to_log' 
	# calls.
	my @dirs = split/:/, $ENV{PATH};
	foreach my $exe (sort {$b cmp $a} keys %{$conf->{path}{exe}})
	{
		if ( not -e $conf->{path}{exe}{$exe} )
		{
			to_log($conf, {message => "The program: [$exe] is not at: [".$conf->{path}{exe}{$exe}."]. Looking for it now...", 'line' => __LINE__, level => 1});
			foreach my $path (@dirs)
			{
				$check =  "$path/$exe";
				$check =~ s/\/\//\//g;
				to_log($conf, {message => "Checking: [$check]", 'line' => __LINE__, level => 2});
				if ( -e $check )
				{
					if (-e $conf->{path}{exe}{logger})
					{
						to_log($conf, {message => "Found it! Changed path for: [$exe] from: [".$conf->{path}{exe}{$exe}."] to: [$check]", 'line' => __LINE__, level => 1});
					}
					else
					{
						warn "DEBUG: Found it! Changed path for: [$exe] from: [".$conf->{path}{exe}{$exe}."] to: [$check]\n";
					}
					$conf->{path}{exe}{$exe} = $check;
				}
				else
				{
					to_log($conf, {message => "Not found.", 'line' => __LINE__, level => 2});
				}
			}
		}
		else
		{
			to_log($conf, {message => "Found!", 'line' => __LINE__, level => 3});
			next;
		}

		# Make sure it exists now.
		to_log($conf, {message => "Checking again if: [$exe] is at: [".$conf->{path}{exe}{$exe}."].", 'line' => __LINE__, level => 3});
		if (not -e $conf->{path}{exe}{$exe})
		{
			$bad = 1;
			if (-e $conf->{path}{exe}{logger})
			{
				to_log($conf, {message => "Failed to find executable: [$exe]. Unable to proceed.", 'line' => __LINE__, level => 0});
			}
			else
			{
				warn "Failed to find executable: [$exe]. Unable to proceed.\n";
			}
		}
	}
	if ($bad)
	{
		exit(1);
	}

	return(0);
}