anvil/Anvil/Tools/Server.pm

package Anvil::Tools::Server;
# 
# This module contains methods used to manager servers
# 

use strict;
use warnings;
use Scalar::Util qw(weaken isweak);
use Data::Dumper;

our $VERSION  = "3.0.0";
my $THIS_FILE = "Server.pm";

### Methods;
# active_migrations
# boot_virsh
# count_servers
# find
# find_processes
# get_definition
# get_runtime
# get_status
# map_network
# parse_definition
# migrate_virsh
# shutdown_virsh

=cut TODO

Move all virsh calls over to using Sys::Virt;

Example;

 #!/usr/bin/perl
 use strict;
 use warnings;
 use Sys::Virt;

 # https://metacpan.org/pod/Sys::Virt::Domain
 # https://libvirt.org/api.html

 my $uri        = "qemu:///system";
 my $connection = Sys::Virt->new(uri => $uri);
 my @domains    = $connection->list_domains();
 foreach my $domain (@domains)
 {
	print $log_fh "Domain: [".$domain->get_name."], UUID: [".$domain->get_uuid_string()."]\n";
 	print $log_fh "Definition: [".$domain->get_xml_description."]\n";
 }

=cut

=pod

=encoding utf8

=head1 NAME

Anvil::Tools::Server

Provides all methods related to (virtual) servers.

=head1 SYNOPSIS

 use Anvil::Tools;

 # Get a common object handle on all Anvil::Tools modules.
 my $anvil = Anvil::Tools->new();
 
 # Access to methods using '$anvil->Server->X'. 
 # 
 # 

=head1 METHODS

Methods in this module;

=cut
sub new
{
	my $class = shift;
	my $self  = {
	};
	
	bless $self, $class;
	
	return ($self);
}

# Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more 
# sense in this case to think of it as a parent.
sub parent
{
	my $self   = shift;
	my $parent = shift;
	
	$self->{HANDLE}{TOOLS} = $parent if $parent;
	
	# Defend against memory leads. See Scalar::Util'.
	if (not isweak($self->{HANDLE}{TOOLS}))
	{
		weaken($self->{HANDLE}{TOOLS});
	}
	
	return ($self->{HANDLE}{TOOLS});
}

#############################################################################################################
# Public methods                                                                                            #
#############################################################################################################

=head2 active_migrations

This method returns C<< 1 >> if any servers are migrating to or from the local system. It returns C<< 0 >> otherwise.

This method takes no parameters.

=cut
sub active_migrations
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->active_migrations()" }});
	
	# Are we in an Anvil! system?
	my $anvil_uuid = $anvil->Cluster->get_anvil_uuid({debug => $debug});
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { anvil_uuid => $anvil_uuid }});
	if (not $anvil_uuid)
	{
		# We're not in an Anvil.
		return(0);
	}
	
	$anvil->Database->get_servers({debug => $debug});
	foreach my $server_uuid (keys %{$anvil->data->{servers}{server_uuid}})
	{
		my $server_name  = $anvil->data->{servers}{server_uuid}{$server_uuid}{server_name};
		my $server_state = $anvil->data->{servers}{server_uuid}{$server_uuid}{server_state};
		if ($server_state eq "migrating")
		{
			return(1);
		}
	}
	
	return(0);
}


=head2 boot_virsh

This takes a server name and tries to boot it (using C<< virsh create /mnt/shared/definition/<server>.xml >>. It requires that any supporting systems already be started (ie: DRBD resource is up).

If booted, C<< 1 >> is returned. Otherwise, C<< 0 >> is returned.

#  my ($booted) = $anvil->Server->boot_virsh({server => "test_server"});

Parameters;

=head3 definition (optional, see below for default)

This is the full path to the XML definition file to use to boot the server.

By default, the definition file used will be named C<< <server>.xml >> in the C<< path::directories::shared::deinitions >> directory. 

=head3 server (required)

This is the name of the server, as it appears in C<< virsh >>.

=cut
sub boot_virsh
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->boot_virsh()" }});
	
	my $server     = defined $parameter->{server}     ? $parameter->{server}     : "";
	my $definition = defined $parameter->{definition} ? $parameter->{definition} : "";
	my $success    = 0;
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		server     => $server, 
		definition => $definition, 
	}});
	
	if (not $server)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Server->boot_virsh()", parameter => "server" }});
		return(1);
	}
	if (not $definition)
	{
		$definition = $anvil->data->{path}{directories}{shared}{definitions}."/".$server.".xml";
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { efinition => $definition }});
	}
	
	# Is this a local call or a remote call?
	my ($output, $return_code) = $anvil->System->call({
		debug      => $debug, 
		shell_call => $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." create ".$definition,
	});
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		output      => $output,
		return_code => $return_code,
	}});
	
	# Wait up to five seconds for the server to appear.
	my $wait = 5;
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'wait' => $wait }});
	while($wait)
	{
		$anvil->Server->find({debug => $debug});
		if ((exists $anvil->data->{server}{location}{$server}) && ($anvil->data->{server}{location}{$server}{host_name}))
		{
			# Success!
			$wait    = 0;
			$success = 1;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				'wait'  => $wait,
				success => $success, 
			}});
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0421", variables => { 
				server => $server, 
				host   => $anvil->data->{server}{location}{$server}{host_name},
			}});
			
			# Make sure the VNC port is open.
			$anvil->Network->manage_firewall({debug => $debug});
			
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "sys::database::connections" => $anvil->data->{sys}{database}{connections} }});
			if ($anvil->data->{sys}{database}{connections})
			{
				my $anvil_uuid = $anvil->Cluster->get_anvil_uuid({debug => $debug});
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { anvil_uuid => $anvil_uuid }});
				
				my $server_uuid = $anvil->Get->server_uuid_from_name({
					debug       => $debug, 
					server_name => $server, 
					anvil_uuid  => $anvil_uuid,
				});
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server_uuid => $server_uuid }});
				if (($server_uuid) && ($server_uuid ne "!!error!!"))
				{
					$anvil->Database->get_servers({debug => $debug});
					if (exists $anvil->data->{servers}{server_uuid}{$server_uuid})
					{
						my $old_state = $anvil->data->{servers}{server_uuid}{$server_uuid}{server_state};
						$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { old_state => $old_state }});
						
						if ($old_state ne "in shutdown")
						{
							# Update it.
							my $runtime = $anvil->Server->get_runtime({
								debug  => 2,
								server => $server,
							});
							my $query = "
UPDATE 
    servers 
SET 
    server_state     = 'running', 
    server_host_uuid = ".$anvil->Database->quote($anvil->Get->host_uuid).", ";
							if ($runtime =~ /^\d+$/)
							{
								my $boot_time =  time - $runtime;
								   $query     .= "
    server_boot_time = ".$anvil->Database->quote($boot_time).",  ";
							}
							$query .= "
    modified_date    = ".$anvil->Database->quote($anvil->Database->refresh_timestamp)." 
WHERE 
    server_uuid      = ".$anvil->Database->quote($server_uuid)."
;";
							$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
							$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
						}
					}
				}
			}
		}
		
		if ($wait)
		{
			$wait--;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'wait' => $wait }});
			sleep 1;
		}
	}
	
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { success => $success }});
	return($success);
}


=head2 count_servers

This method counts the number of hosted servers and returns that number. If C<< virsh >> is not available, C<< 0 >> is returned. Note that it's B< possible >>, though unlikely on an Anvil!, that a qemu server is running outside C<< libvirtd >>.

This method takes no parameters.

=cut
sub count_servers
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->count_servers()" }});
	
	my $count = 0;
	if (-e $anvil->data->{path}{exe}{virsh})
	{
		my $shell_call = $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." list";
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { shell_call => $shell_call }});
		my ($output, $return_code) = $anvil->System->call({shell_call => $shell_call, debug => $debug});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			output      => $output,
			return_code => $return_code,
		}});
		
		foreach my $line (split/\n/, $output)
		{
			$line = $anvil->Words->clean_spaces({string => $line});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { line => $line }});
			
			if ($line =~ /^\d+ (.*) (.*?)$/)
			{
=cut
* Server states;
running     - The domain is currently running on a CPU
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.
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.
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.
shut off    - The domain is not running.  Usually this indicates the domain has been shut down completely, or has not been started.
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.
pmsuspended - The domain has been suspended by guest power management, e.g. entered into s3 state.
=cut
				my $name   = $1;
				my $status = $2;
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
					status => $status, 
					name   => $name, 
				}});
				
				if ((lc($status) eq "running")     or 
				    (lc($status) eq "paused")      or 
				    (lc($status) eq "in shutdown") or 
				    (lc($status) eq "pmsuspended"))
				{
					$count++;
					$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { count => $count }});
				}
			}
		}
		
	}
	
	return($count);
}


=head2 find

This will look on the local or a remote machine for the list of servers that are running. 

The list is stored as; 

 server::location::<server_name>::status = <status>
 server::location::<server_name>::host   = <host_name>

Parameters;

=head3 password (optional)

This is the password to use when connecting to a remote machine. If not set, but C<< target >> is, an attempt to connect without a password will be made.

=head3 port (optional)

This is the TCP port to use when connecting to a remote machine. If not set, but C<< target >> is, C<< 22 >> will be used.

=head3 refresh (optional, default '1')

Is set to C<< 0 >>, any previously seen servers and their information is cleared.

=head3 remote_user (optional, default 'root')

If C<< target >> is set, this will be the user we connect to the remote machine as.

=head3 target (optional)

This is the IP or host name of the machine to read the version of. If this is not set, the local system's version is checked.

=cut
sub find
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->find()" }});
	
	my $password    = defined $parameter->{password}    ? $parameter->{password}    : "";
	my $port        = defined $parameter->{port}        ? $parameter->{port}        : "";
	my $refresh     = defined $parameter->{refresh}     ? $parameter->{refresh}     : 1;
	my $remote_user = defined $parameter->{remote_user} ? $parameter->{remote_user} : "root";
	my $target      = defined $parameter->{target}      ? $parameter->{target}      : "";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		password    => $anvil->Log->is_secure($password),
		port        => $port, 
		refresh     => $refresh, 
		remote_user => $remote_user, 
		target      => $target, 
	}});
	
	# Clear any old data
	if ((exists $anvil->data->{server}{location}) && ($refresh))
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0700", variables => { hash => "server::location" }});
		delete $anvil->data->{server}{location};
	}
	
	my $host_type    = $anvil->Get->host_type({debug => $debug});
	my $host_name    = $anvil->Get->host_name;
	my $virsh_call   = $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." list --all";
	my $virsh_output = "";
	my $return_code  = "";
	if ($anvil->Network->is_local({host => $target}))
	{
		# Local call
		($virsh_output, my $return_code) = $anvil->System->call({shell_call => $virsh_call});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			virsh_output => $virsh_output,
			return_code  => $return_code,
		}});
	}
	else
	{
		# Remote call.
		($host_name, my $error, my $host_return_code) = $anvil->Remote->call({
			debug       => 2, 
			password    => $password, 
			shell_call  => $anvil->data->{path}{exe}{hostnamectl}." --static", 
			target      => $target,
			remote_user => "root", 
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			host_name        => $host_name,
			error            => $error,
			host_return_code => $host_return_code, 
		}});
		($virsh_output, $error, $return_code) = $anvil->Remote->call({
			debug       => 2, 
			password    => $password, 
			shell_call  => $virsh_call,
			target      => $target,
			remote_user => "root", 
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			virsh_output => $virsh_output,
			error        => $error,
			return_code  => $return_code, 
		}});
	}
	
	foreach my $line (split/\n/, $virsh_output)
	{
		$line = $anvil->Words->clean_spaces({string => $line});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { line => $line }});
		
		if ($line =~ /^\d+ (.*) (.*?)$/)
		{
			my $server_name                                              = $1;
			   $anvil->data->{server}{location}{$server_name}{status}    = $2;
			   $anvil->data->{server}{location}{$server_name}{host_name} = $host_name;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::location::${server_name}::status"    => $anvil->data->{server}{location}{$server_name}{status}, 
				"server::location::${server_name}::host_name" => $anvil->data->{server}{location}{$server_name}{host_name}, 
			}});
		}
	}
	
	return(0);
}


=head2 find_processes

Find a list of qemu-kvm processes and extracts server information from the process arguments.

Parameters;

=head3 base_vnc_port (optional)

This value is added to the port offset extracted from -vnc optional to qemu-kvm. Defaults to 5900.

=cut
sub find_processes
{
	my $self          = shift;
	my $parameters    = shift;
	my $anvil         = $self->parent;
	my $base_vnc_port = $parameters->{base_vnc_port} // 5900;
	my $debug         = $parameters->{debug} // 3;

	$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => $parameters });

	$base_vnc_port = "$base_vnc_port";

	return (1) if (not $base_vnc_port =~ /^\d+$/);

	$base_vnc_port = int($base_vnc_port);

	# Servers only exist on non-striker
	return (1) if ($anvil->data->{sys}{host_type} eq "striker");

	my $grep = $anvil->data->{path}{exe}{'grep'};
	my $nc   = $anvil->data->{path}{exe}{'nc'};
	my $ps   = $anvil->data->{path}{exe}{'ps'};
	my $sed  = $anvil->data->{path}{exe}{'sed'};

	my $ps_call = "$ps -ef | $grep '[q]emu-kvm' | $sed -E 's/^.*guest=([^,]+).*-uuid[[:space:]]+([^[:space:]]+)(.*-vnc[[:space:]]+([[:digit:].:]+))?.*\$/\\2,\\1,\\4/'";

	$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => { ps_call => $ps_call }});

	my ($call_output, $call_rcode) = $anvil->System->call({ shell_call => $ps_call });

	return (1) if ($call_rcode != 0);

	my $result = { names => {}, uuids => {} };

	foreach my $line (split(/\n/, $call_output))
	{
		my ($uuid, $name, $vnc) = split(/,/, $line);

		$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => {
			server_name => $name,
			server_uuid => $uuid,
			server_vnc  => $vnc,
		}});

		$result->{uuids}{$uuid} = { name => $name };
		# Record name to UUID mapping
		$result->{names}{$name} = $uuid;

		next if (not $vnc);

		my ($hostname, $port_offset) = split(/:/, $vnc);

		my $vnc_port = $base_vnc_port + int($port_offset);

		$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => {
			server_vnc_hostname    => $hostname,
			server_vnc_port_offset => $port_offset,
			server_vnc_port        => $vnc_port,
		}});

		$result->{uuids}{$uuid}{vnc_port} = $vnc_port;

		my $nc_call = "$nc -z $hostname $vnc_port";

		$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => { nc_call => $nc_call }});

		my ($nc_output, $nc_rcode) = $anvil->System->call({ shell_call => $nc_call });

		$result->{uuids}{$uuid}{vnc_alive} = int($nc_rcode) > 0 ? 0 : 1;
	}

	return (0, $result);
}


=head2 get_definition

This returns the server definition XML for a server. 

Parameters;

=head3 server_uuid (optional, if 'server_name' used. required if not)

If provided, this is the specific server's definition we'll return. If it is not provided, C<< server_name >> is required.

=head3 server_name (optional)

If provided, and C<< server_uuid >> is not, the server will be searched for using this name. If C<< anvil_uuid >> is included, the name will be searched on the appropriate Anvil! system only. 

=head3 anvil_uuid (optional)

If set along with C<< server_name >>, the search for the server's XML will be restricted to the specified Anvil! system.

=cut
sub get_definition
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->get_definition()" }});
	
	my $definition_xml = "";
	my $anvil_uuid     = defined $parameter->{anvil_uuid}  ? $parameter->{anvil_uuid}  : "";
	my $server_name    = defined $parameter->{server_name} ? $parameter->{server_name} : "";
	my $server_uuid    = defined $parameter->{server_uuid} ? $parameter->{server_uuid} : "";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		anvil_uuid  => $anvil_uuid, 
		server_name => $server_name, 
		server_uuid => $server_uuid, 
	}});
	
	if (not $server_uuid)
	{
		$server_uuid = $anvil->Get->server_uuid_from_name({
			debug       => $debug, 
			server_name => $server_name, 
			anvil_uuid  => $anvil_uuid,
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server_uuid => $server_uuid }});
	}
	if (($server_uuid) && ($anvil->Validate->uuid({uuid => $server_uuid})))
	{
		my $query = "SELECT server_definition_xml FROM server_definitions WHERE server_definition_server_uuid = ".$anvil->Database->quote($server_uuid).";";
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
		my $results = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__});
		my $count   = @{$results};
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			results => $results, 
			count   => $count, 
		}});
		if ($count == 1)
		{
			# Found it
			$definition_xml = defined $results->[0]->[0] ? $results->[0]->[0] : "";
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { definition_xml => $definition_xml }});
		}
	}
	
	return($definition_xml);
}


=head2 get_runtime

This returns the number of seconds that a (virtual) server has been running on this host. 

If the server is not found to be running locally, C<< 0 >> is returned. Otherwise, the number of seconds is returned.

B<< Note >>: This is NOT the overall runtime! If the server migrated, it will return the number of seconds that the server has been on this host, which could vary dramatically from the guest's actual runtime!

Parameters;

=head3 server (required)

This is the name of the server whose runtime we are checking. 

=cut
sub get_runtime
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->get_runtime()" }});
	
	my $runtime = 0;
	my $server  = defined $parameter->{server} ? $parameter->{server} : "";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		server => $server, 
	}});
	
	# To find the runtime, we first need to find the PID.
	my $server_pid = 0;
	my $shell_call = $anvil->data->{path}{exe}{ps}." aux";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { shell_call => $shell_call }});
	my ($output, $return_code) = $anvil->System->call({debug => 3, shell_call => $shell_call});
	foreach my $line (split/\n/, $output)
	{
		$line = $anvil->Words->clean_spaces({ string => $line });
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { line => $line }});
		
		if ($line =~ /^qemu\s+(\d+)\s.*?guest=\Q$server\E,/)
		{
			$server_pid = $1;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server_pid => $server_pid }});
			last;
		}
	}
	
	if ($server_pid)
	{
		my $shell_call = $anvil->data->{path}{exe}{ps}." -p ".$server_pid." -o etimes=";
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { shell_call => $shell_call }});
		my ($output, $return_code) = $anvil->System->call({debug => 3, shell_call => $shell_call});
		foreach my $line (split/\n/, $output)
		{
			$runtime = $anvil->Words->clean_spaces({ string => $line });
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { runtime => $runtime }});
		}
	}
	
	return($runtime);
}


=head2 get_status

This reads in a server's XML definition file from disk, if available, and from memory, if the server is running. The XML is analyzed and data is stored under C<< server::<target>::<server_name>::from_disk::x >> for data from the on-disk XML and C<< server::<target>>::<server_name>::from_virsh::x >>. 

Any pre-existing data on the server is flushed before the new information is processed.

Parameters;

=head3 password (optional)

This is the password to use when connecting to a remote machine. If not set, but C<< target >> is, an attempt to connect without a password will be made.

=head3 port (optional)

This is the TCP port to use when connecting to a remote machine. If not set, but C<< target >> is, C<< 22 >> will be used.

=head3 remote_user (optional, default 'root')

If C<< target >> is set, this will be the user we connect to the remote machine as.

=head3 server (required)

This is the name of the server we're gathering data on.

=head3 target (optional)

This is the IP or host name of the machine to read the version of. If this is not set, the local system's version is checked.

=cut
sub get_status
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->get_status()" }});
	
	my $password    = defined $parameter->{password}    ? $parameter->{password}    : "";
	my $port        = defined $parameter->{port}        ? $parameter->{port}        : "";
	my $remote_user = defined $parameter->{remote_user} ? $parameter->{remote_user} : "root";
	my $server      = defined $parameter->{server}      ? $parameter->{server}      : "";
	my $target      = defined $parameter->{target}      ? $parameter->{target}      : "";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		password    => $anvil->Log->is_secure($password),
		port        => $port, 
		remote_user => $remote_user, 
		target      => $target, 
	}});
	
	# This is used in the hash reference when storing the data.
	my $host = $target ? $target : $anvil->Get->short_host_name();
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { host => $host }});
	
	if (not $server)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Server->get_status()", parameter => "server" }});
		return(1);
	}
	if (exists $anvil->data->{server}{$host}{$server})
	{
		delete $anvil->data->{server}{$host}{$server};
	}
	$anvil->data->{server}{$host}{$server}{from_virsh}{host} = "";
	
	# We're going to map DRBD devices to resources, so we need to collect that data now. 
	$anvil->DRBD->get_devices({
		debug       => $debug,
		password    => $password,
		port        => $port, 
		remote_user => $remote_user, 
		target      => $target, 
	});
	
	# Is this a local call or a remote call?
	my $shell_call = $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." dumpxml --inactive ".$server;
	my $this_host  = $anvil->Get->short_host_name;
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
		shell_call => $shell_call,
		this_host  => $this_host,
	}});
	if ($anvil->Network->is_local({host => $target}))
	{
		# Local.
		($anvil->data->{server}{$host}{$server}{from_virsh}{xml}, $anvil->data->{server}{$host}{$server}{from_virsh}{return_code}) = $anvil->System->call({
			debug      => $debug,
			shell_call => $shell_call,
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			"server::${host}::${server}::from_virsh::xml"         => $anvil->data->{server}{$host}{$server}{from_virsh}{xml},
			"server::${host}::${server}::from_virsh::return_code" => $anvil->data->{server}{$host}{$server}{from_virsh}{return_code},
		}});
	}
	else
	{
		# Remote call.
		$this_host = $target;
		($anvil->data->{server}{$host}{$server}{from_virsh}{xml}, my $error, $anvil->data->{server}{$host}{$server}{from_virsh}{return_code}) = $anvil->Remote->call({
			debug       => $debug, 
			shell_call  => $shell_call, 
			target      => $target,
			port        => $port, 
			password    => $password,
			remote_user => $remote_user, 
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			error                                                 => $error,
			"server::${host}::${server}::from_virsh::xml"         => $anvil->data->{server}{$host}{$server}{from_virsh}{xml},
			"server::${host}::${server}::from_virsh::return_code" => $anvil->data->{server}{$host}{$server}{from_virsh}{return_code},
		}});
	}
	
	# If the return code was non-zero, we can't parse the XML.
	if ($anvil->data->{server}{$host}{$server}{from_virsh}{return_code})
	{
		$anvil->data->{server}{$host}{$server}{from_virsh}{xml} = "";
	}
	else
	{
		$anvil->data->{server}{$host}{$server}{from_virsh}{host} = $this_host;
		$anvil->Server->parse_definition({
			debug      => $debug,
			host       => $this_host,
			server     => $server, 
			source     => "from_virsh",
			definition => $anvil->data->{server}{$host}{$server}{from_virsh}{xml}, 
		});
	}
	
	# Now get the on-disk XML.
	my $definition_file = $anvil->data->{path}{directories}{shared}{definitions}."/".$server.".xml";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { definition_file => $definition_file }});
	($anvil->data->{server}{$host}{$server}{from_disk}{xml}) = $anvil->Storage->read_file({
		debug       => $debug, 
		password    => $password,
		port        => $port, 
		remote_user => $remote_user, 
		target      => $target, 
		force_read  => 1,
		file        => $definition_file,
	});
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		"server::${host}::${server}::from_disk::xml" => $anvil->data->{server}{$host}{$server}{from_disk}{xml},
	}});
	if (($anvil->data->{server}{$host}{$server}{from_disk}{xml} eq "!!error!!") or (not $anvil->data->{server}{$host}{$server}{from_disk}{xml}))
	{
		# Failed to read it. Can we write it?
		my $definition_xml = "";
		if ($anvil->data->{server}{$host}{$server}{from_virsh}{xml})
		{
			$definition_xml = $anvil->data->{server}{$host}{$server}{from_virsh}{xml};
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { definition_xml => $definition_xml }});
		}
		else
		{
			# Read in from the database.
			$definition_xml = $anvil->Server->get_definition({
				debug       => $debug, 
				server_name => $server,
				anvil_uuid  => $anvil->Cluster->get_anvil_uuid({debug => $debug}),
			});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { definition_xml => $definition_xml }});
		}
		
		if ($definition_xml)
		{
			# Write it to disk
			my ($failed) = $anvil->Storage->write_file({
				secure      => 1, 
				file        => $definition_file, 
				body        => $definition_xml, 
				overwrite   => 1,
				password    => $password, 
				port        => $port, 
				remote_user => $remote_user, 
				target      => $target,
			});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { failed => $failed }});
			if ($failed)
			{
				# Simething went weong.
				$anvil->data->{server}{$host}{$server}{from_disk}{xml} = "";
				return(1);
			}
			
			# Now try to read it back.
			($anvil->data->{server}{$host}{$server}{from_disk}{xml}) = $anvil->Storage->read_file({
				debug       => $debug, 
				password    => $password,
				port        => $port, 
				remote_user => $remote_user, 
				target      => $target, 
				force_read  => 1,
				file        => $definition_file,
			});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${host}::${server}::from_disk::xml" => $anvil->data->{server}{$host}{$server}{from_disk}{xml},
			}});
			if (($anvil->data->{server}{$host}{$server}{from_disk}{xml} eq "!!error!!") or (not $anvil->data->{server}{$host}{$server}{from_disk}{xml}))
			{
				# Failed to read it.
				$anvil->data->{server}{$host}{$server}{from_disk}{xml} = "";
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
					"server::${host}::${server}::from_disk::xml" => $anvil->data->{server}{$host}{$server}{from_disk}{xml},
				}});
			}
			else
			{
				# Load
				$anvil->Server->parse_definition({
					debug      => $debug,
					host       => $this_host,
					server     => $server, 
					source     => "from_disk",
					definition => $anvil->data->{server}{$host}{$server}{from_disk}{xml}, 
				});
			}
		}
		else
		{
			$anvil->data->{server}{$host}{$server}{from_disk}{xml} = "";
		}
	}
	else
	{
		$anvil->Server->parse_definition({
			debug      => $debug,
			host       => $this_host,
			server     => $server, 
			source     => "from_disk",
			definition => $anvil->data->{server}{$host}{$server}{from_disk}{xml}, 
		});
	}
	
	return(0);
}

=head2 map_network

This method maps the network for any servers B<< running >> on the C<< target >>. 

Parameters;

=head3 password (optional)

This is the password to use when connecting to a remote machine. If not set, but C<< target >> is, an attempt to connect without a password will be made.

=head3 port (optional)

This is the TCP port to use when connecting to a remote machine. If not set, but C<< target >> is, C<< 22 >> will be used.

=head3 refresh (optional, default '1')

Is set to C<< 0 >>, any previously seen servers and their information is cleared.

=head3 remote_user (optional, default 'root')

If C<< target >> is set, this will be the user we connect to the remote machine as.

=head3 target (optional, default '')

This is the IP or host name of the host to map the network of hosted servers on.

=cut
sub map_network
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->map_network()" }});
	
	my $password    = defined $parameter->{password}    ? $parameter->{password}    : "";
	my $port        = defined $parameter->{port}        ? $parameter->{port}        : "";
	my $remote_user = defined $parameter->{remote_user} ? $parameter->{remote_user} : "root";
	my $server      = defined $parameter->{server}      ? $parameter->{server}      : "";
	my $target      = defined $parameter->{target}      ? $parameter->{target}      : "";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		password    => $anvil->Log->is_secure($password),
		port        => $port, 
		remote_user => $remote_user, 
		target      => $target, 
	}});
	
	# NOTE: We don't use 'Server->find' as the hassle of tracking hosts to target isn't worth it.
	# Get a list of servers. 
	my $shell_call = $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." list";
	my $output     = "";
	if ($anvil->Network->is_local({host => $target}))
	{
		# Local.
		($output, my $return_code) = $anvil->System->call({shell_call => $shell_call});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			output      => $output,
			return_code => $return_code,
		}});
	}
	else
	{
		# Remote call.
		($output, my $error, my $return_code) = $anvil->Remote->call({
			debug       => $debug, 
			shell_call  => $shell_call, 
			target      => $target,
			port        => $port, 
			password    => $password,
			remote_user => $remote_user, 
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			error       => $error,
			output      => $output,
			return_code => $return_code,
		}});
	}
	
	foreach my $line (split/\n/, $output)
	{
		$line = $anvil->Words->clean_spaces({string => $line});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { line => $line }});
		if ($line =~ /^\d+ (.*) (.*?)$/)
		{
			my $server = $1;
			my $state  = $2;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				server  => $server,
				'state' => $state, 
			}});
			
			# Parse the data on this server.
			$anvil->Server->get_status({
				debug       => $debug,
				server      => $server, 
				password    => $password,
				port        => $port, 
				remote_user => $remote_user, 
				target      => $target, 
			});
			
			# This is used in the hash reference when storing the data.
			my $host = $target ? $target : $anvil->Get->short_host_name();
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { host => $host }});
			foreach my $mac (sort {$a cmp $b} keys %{$anvil->data->{server}{$host}{$server}{from_virsh}{device}{interface}})
			{
				my $device = $anvil->data->{server}{$host}{$server}{from_virsh}{device}{interface}{$mac}{target};
				my $bridge = $anvil->data->{server}{$host}{$server}{from_virsh}{device}{interface}{$mac}{bridge};
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
					's1:device' => $device, 
					's2:mac'    => $mac,
					's3:bridge' => $bridge, 
				}});
			}
		}
	}
	
	return(0);
}


=head2 migrate_virsh

This will migrate (push or pull) a server from one node to another. If the migration was successful, C<< 1 >> is returned. Otherwise, C<< 0 >> is returned with a (hopefully) useful error being logged.

Generally speaking, this is B<< NOT >> the method you want to call. 

B<< Warning >>: This method is meant to do the raw C<< virsh >> call, it is NOT designed to be called by pacemaker. To migrate via pacemaker, use C<< Cluster->migrate >>.

B<< Note >>: It is assumed that sanity checks are completed before this method is called.

Parameters;

=head3 server (required)

This is the name of the server being migrated.

=head3 source (optional)

This is the host name (or IP) of the host that we're pulling the server from.

If set, the server will be pulled.

=head3 target (optional, default is the full local host name)

This is the host name (or IP) of the host that the server will be pushed to, if C<< source >> is not set. When this is not passed, the local full host name is used as default.

=cut
sub migrate_virsh
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->migrate_virsh()" }});
	
	my $server  = defined $parameter->{server} ? $parameter->{server} : "";
	my $source  = defined $parameter->{source} ? $parameter->{source} : "";
	my $target  = defined $parameter->{target} ? $parameter->{target} : $anvil->Get->host_name;
	my $success = 0;
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		server => $server, 
		source => $source, 
		target => $target, 
	}});
	
	if (not $server)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Server->migrate_virsh()", parameter => "server" }});
		return($success);
	}
	
	if (not $anvil->data->{server}{$source}{$server})
	{
		# The 'target' below is where I'm reading the server's definition from, which is the 
		# migration source.
		$anvil->Server->get_status({
			debug  => $debug,
			server => $server, 
			target => $source, 
		});
	}
	
	# This logs the path down to the resources under the servers, helps in the next step to enable dual 
	# primary fails.
	foreach my $source (sort {$a cmp $b} keys %{$anvil->data->{server}})
	{
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }});
		foreach my $server (sort {$a cmp $b} keys %{$anvil->data->{server}{$source}})
		{
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server => $server }});
			foreach my $resource (sort {$a cmp $b} keys %{$anvil->data->{server}{$source}{$server}{resource}})
			{
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { resource => $resource }});
			}
		}
	}
	
	# Enable dual-primary for any resources we know about for this server.
	my $resources_to_disable_dual_primary = [];
	foreach my $resource (sort {$a cmp $b} keys %{$anvil->data->{server}{$source}{$server}{resource}})
	{
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { resource => $resource }});
		my ($return_code) = $anvil->DRBD->allow_two_primaries({
			debug    => 2, 
			resource => $resource, 
			set_to   => "yes",
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { return_code => $return_code }});
		
		push @{$resources_to_disable_dual_primary}, $resource;
	}
	
	### NOTE: This method is called by ocf:alteeve:server, which operates without database access. As 
	###       such, queries need to be run only if we've got one or more DB connections.
	# Mark this server as being in a migration state.
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
		"sys::database::connections" => $anvil->data->{sys}{database}{connections},
	}});
	if ($anvil->data->{sys}{database}{connections})
	{
		$anvil->Database->get_servers({debug => 2});
	}
	my $migation_started = time;
	my $server_uuid      = "";
	my $old_server_state = "";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { migation_started => $migation_started }});
	foreach my $this_server_uuid (keys %{$anvil->data->{servers}{server_uuid}})
	{
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
			this_server_uuid                                         => $this_server_uuid,
			"servers::server_uuid::${this_server_uuid}::server_name" => $anvil->data->{servers}{server_uuid}{$this_server_uuid}{server_name},
		}});
		if ($server eq $anvil->data->{servers}{server_uuid}{$this_server_uuid}{server_name})
		{
			$server_uuid = $this_server_uuid;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server_uuid => $server_uuid }});
			last;
		}
	}
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
		server_uuid                  => $server_uuid,
		"sys::database::connections" => $anvil->data->{sys}{database}{connections},
	}});
	if (($server_uuid) && ($anvil->data->{sys}{database}{connections}))
	{
		if ($anvil->data->{servers}{server_uuid}{$server_uuid}{server_state} ne "migrating")
		{
			$old_server_state = $anvil->data->{servers}{server_uuid}{$server_uuid}{server_state};
			my $query = "
UPDATE 
    servers 
SET 
    server_state  = 'migrating',
    modified_date = ".$anvil->Database->quote($anvil->Database->refresh_timestamp)." 
WHERE 
    server_uuid   = ".$anvil->Database->quote($server_uuid)."
;";
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
			$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
		}
	}
	
	# We default to live migrations, but will remove that switch if it's been set to false.
	my $live_migrate = "--live";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
		server_uuid                                                   => $server_uuid,
		"servers::server_uuid::${server_uuid}::server_live_migration" => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_live_migration},
	}});
	if (($server_uuid) && (not $anvil->data->{servers}{server_uuid}{$server_uuid}{server_live_migration}))
	{
		$live_migrate = "";
	}
	my $target_ip = $anvil->Convert->host_name_to_ip({debug => $debug, host_name => $target});
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		target_ip    => $target_ip,
		live_migrate => $live_migrate,
	}});
	foreach my $host ($target, $target_ip)
	{
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { host => $host }});
		$anvil->Remote->add_target_to_known_hosts({
			debug  => $debug,
			target => $host,
		});
	}
	
	my $migration_command = $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." migrate --undefinesource --tunnelled --p2p ".$live_migrate." ".$server." qemu+ssh://".$target."/system";
	if ($source)
	{
		my $source_ip = $anvil->Convert->host_name_to_ip({debug => $debug, host_name => $source});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source_ip => $source_ip }});
		foreach my $host ($source, $source_ip)
		{
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { host => $host }});
			$anvil->Remote->add_target_to_known_hosts({
				debug  => $debug,
				target => $host,
			});
		}
		
		$migration_command = $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." -c qemu+ssh://root\@".$source."/system migrate --undefinesource --tunnelled --p2p ".$live_migrate." ".$server." qemu+ssh://".$target."/system";
	}
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { migration_command => $migration_command }});
	
	# Register a job for the peer so it can update its firewall once the target is created.
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		"sys::database::connections" => $anvil->data->{sys}{database}{connections}
	}});
	if ($anvil->data->{sys}{database}{connections})
	{
		my $target_host_uuid = $anvil->Get->host_uuid_from_name({
			debug     => $debug, 
			host_name => $target,
		});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { target_host_uuid => $target_host_uuid }});
		if ($target_host_uuid)
		{
			my ($job_uuid) = $anvil->Database->insert_or_update_jobs({
				file            => $THIS_FILE, 
				line            => __LINE__, 
				job_command     => $anvil->data->{path}{exe}{'anvil-manage-firewall'}.$anvil->Log->switches, 
				job_data        => "server=".$server, 
				job_name        => "manage::firewall", 
				job_title       => "job_0399", 
				job_description => "job_0400", 
				job_progress    => 0,
				job_host_uuid   => $target_host_uuid,
			});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { job_uuid => $job_uuid }});
		}
	}
	
	# Call the migration now
	my ($output, $return_code) = $anvil->System->call({shell_call => $migration_command});
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		output      => $output,
		return_code => $return_code, 
	}});
	
	# Before we update, re-scan servers as some time may have passed.
	if ($anvil->data->{sys}{database}{connections})
	{
		$anvil->Database->get_servers({debug => 2});
	}
	if ($return_code)
	{
		# Something went wrong.
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 0, priority => "err", key => "log_0353", variables => { 
			server      => $server, 
			target      => $target, 
			return_code => $return_code, 
			output      => $output, 
		}});
		
		# Revert the migrating state.
		if (($server_uuid) && ($anvil->data->{sys}{database}{connections}))
		{
			my $query = "
UPDATE 
    servers 
SET 
    server_state  = ".$anvil->Database->quote($old_server_state).", 
    modified_date = ".$anvil->Database->quote($anvil->Database->refresh_timestamp)." 
WHERE 
    server_uuid   = ".$anvil->Database->quote($server_uuid)."
;";
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
			$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
		}
	}
	else
	{
		my $migration_took     = time - $migation_started;
		my $say_migration_time = $anvil->Convert->time({'time' => $migration_took});
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			migration_took     => $migration_took, 
			say_migration_time => $say_migration_time,
		}});
		
		# Log the migration.
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0354", variables => { migration_time => $say_migration_time }});
		
		$success = 1;
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { success => $success }});
		
		# Update the server state, if we have a database connection.
		if ($anvil->data->{sys}{database}{connections})
		{
			# Revert the server state and update the server host.
			my $server_host_uuid = $anvil->Get->host_uuid_from_name({debug => $debug, host_name => $target});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server_host_uuid => $server_host_uuid }});
			if (not $server_host_uuid)
			{
				# We didn't find the target's host_uuid, so use the old one and let scan-server 
				# handle it.
				$server_host_uuid = $anvil->data->{servers}{server_uuid}{$server_uuid}{server_host_uuid};
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server_host_uuid => $server_host_uuid }});
			}
			if ($server_uuid)
			{
				my $query = "
UPDATE 
    servers 
SET 
    server_state     = ".$anvil->Database->quote($old_server_state).", 
    server_host_uuid = ".$anvil->Database->quote($server_host_uuid).", 
    modified_date    = ".$anvil->Database->quote($anvil->Database->refresh_timestamp)." 
WHERE 
    server_uuid      = ".$anvil->Database->quote($server_uuid)."
;";
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
				$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
				$anvil->Database->insert_or_update_servers({
					debug                           => $debug, 
					server_uuid                     => $server_uuid, 
					server_name                     => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_name}, 
					server_anvil_uuid               => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_anvil_uuid}, 
					server_user_stop                => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_user_stop}, 
					server_start_after_server_uuid  => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_start_after_server_uuid}, 
					server_start_delay              => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_start_delay}, 
					server_host_uuid                => $server_host_uuid, 
					server_state                    => $old_server_state, 
					server_live_migration           => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_live_migration}, 
					server_pre_migration_file_uuid  => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_pre_migration_file_uuid}, 
					server_pre_migration_arguments  => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_pre_migration_arguments}, 
					server_post_migration_file_uuid => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_post_migration_file_uuid}, 
					server_post_migration_arguments => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_post_migration_arguments}, 
					server_ram_in_use               => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_ram_in_use}, 
					server_configured_ram           => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_configured_ram}, 
					server_updated_by_user          => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_updated_by_user},
					server_boot_time                => $anvil->data->{servers}{server_uuid}{$server_uuid}{server_boot_time},
				});
				
				# Record the migration time.
				my ($variable_uuid) = $anvil->Database->insert_or_update_variables({
					file                  => $THIS_FILE, 
					line                  => __LINE__, 
					variable_name         => "server::migration_duration", 
					variable_value        => $migration_took, 
					variable_default      => "", 
					variable_description  => "message_0236", 
					variable_section      => "servers", 
					variable_source_uuid  => $server_uuid, 
					variable_source_table => "servers", 
				});
			}
		}
		else
		{
			# There's no database, so write the migration time to a temp file.
			my $body = "server_name=".$server.",migration_took=".$migration_took."\n";
			my $file = "/tmp/anvil/migration-duration.".$server.".".time;
			my ($failed) = $anvil->Storage->write_file({
				file => $file, 
				body => $body, 
				mode => "0666",
			});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { failed => $failed }});
		}
	}
	
	# Switch off dual-primary.
	foreach my $resource (sort {$a cmp $b} @{$resources_to_disable_dual_primary})
	{
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { resource => $resource }});
		my ($return_code) = $anvil->DRBD->allow_two_primaries({
			debug    => 2, 
			resource => $resource, 
			set_to   => "no", 
		});
		
# 		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { resource => $resource }});
# 		$anvil->DRBD->reload_defaults({
# 			debug    => 2, 
# 			resource => $resource, 
# 		});
	}
	
	return($success);
}

=head2 

This method parses a server's C<< virsh >> XML definition. On successful parse, C<< 0 >> is returned. If there is a problem, C<< !!error!! >> is returned.

B<< Note >>: This method currently parses out data needed for specific tasks, and not the entire data structure.

Parameters;

=head3 anvil_uuid (optional)

If passed, the C<< anvil_uuid >> will be passed on to C<< DRBD->get_devices >>.

=head3 server (required)

This is the name of the server whose XML is being parsed.

=head3 source (required)

This is the source of the XML. This is done to simplify looking for differences between definitions for the same server. It should be;

=head4 C<< from_disk >> 

The XML was read from a file on the host's storage.

=head4 C<< from_virsh >> 

The XML was dumped by C<< virsh >> from memory.

=head4 C<< from_db >> 

The XML was read from the C<< definitions >> database table.

=head3 definition (required)

This is the actual XML to be parsed.

=head3 host (optional, default 'Get->short_host_name')

This is the host name of the Anvil! node or DR host that the XML was generated on or read from.

=cut
sub parse_definition
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->parse_definition()" }});
	
	# Source is required.
	my $anvil_uuid = defined $parameter->{anvil_uuid} ? $parameter->{anvil_uuid} : "";
	my $server     = defined $parameter->{server}     ? $parameter->{server}     : "";
	my $source     = defined $parameter->{source}     ? $parameter->{source}     : "";
	my $definition = defined $parameter->{definition} ? $parameter->{definition} : "";
	my $host       = defined $parameter->{host}       ? $parameter->{host}       : "";
	my $target     = $anvil->Get->short_host_name();
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		anvil_uuid => $anvil_uuid, 
		server     => $server,
		source     => $source, 
		definition => $definition, 
		host       => $host, 
	}});
	
	if (not $target)
	{
		$target = $anvil->Get->short_host_name;
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { target => $target }});
	}
	
	if (not $server)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Server->parse_definition()", parameter => "server" }});
		return(1);
	}
	if (not $source)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Server->parse_definition()", parameter => "source" }});
		return(1);
	}
	if (not $definition)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Server->parse_definition()", parameter => "definition" }});
		return(1);
	}
	
	# If whoever called us did so after a 'virsh dumpxml <server>' while the server was off, the "definition" 
	# will contain the string 'error: failed to get domain'. In such a case, return.
	if ($definition =~ /error: failed to get domain/gs)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0367", variables => { definition => $definition }});
		return(1);
	}
	
	### TODO: Switch this away from XML::Simple
	local $@;
	my $xml        = XML::Simple->new();
	my $server_xml = "";
	my $test       = eval { $server_xml = $xml->XMLin($definition, KeyAttr => {}, ForceArray => 1) };
	if (not $test)
	{
		chomp $@;
		my $error =  "[ Error ] - The was a problem parsing: [".$definition."]. The error was:\n";
		   $error .= "===========================================================\n";
		   $error .= $@."\n";
		   $error .= "===========================================================\n";
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", list => { error => $error }});
		return(1);
	}
	
	$anvil->data->{server}{$target}{$server}{$source}{parsed} = $server_xml;
	
	# Get the DRBD data that this server will almost certainly be using.
	$anvil->DRBD->get_devices({
		debug      => $debug,
		anvil_uuid => $anvil_uuid, 
	});
	
	# Pull out some basic server info.
	$anvil->data->{server}{$target}{$server}{$source}{info}{uuid}         = $server_xml->{uuid}->[0];
	$anvil->data->{server}{$target}{$server}{$source}{info}{name}         = $server_xml->{name}->[0];
	$anvil->data->{server}{$target}{$server}{$source}{info}{on_poweroff}  = $server_xml->{on_poweroff}->[0];
	$anvil->data->{server}{$target}{$server}{$source}{info}{on_crash}     = $server_xml->{on_crash}->[0];
	$anvil->data->{server}{$target}{$server}{$source}{info}{on_reboot}    = $server_xml->{on_reboot}->[0];
	$anvil->data->{server}{$target}{$server}{$source}{info}{boot_menu}    = $server_xml->{os}->[0]->{bootmenu}->[0]->{enable};
	$anvil->data->{server}{$target}{$server}{$source}{info}{architecture} = $server_xml->{os}->[0]->{type}->[0]->{arch};
	$anvil->data->{server}{$target}{$server}{$source}{info}{machine}      = $server_xml->{os}->[0]->{type}->[0]->{machine};
	$anvil->data->{server}{$target}{$server}{$source}{info}{id}           = exists $server_xml->{id} ? $server_xml->{id} : 0;
	$anvil->data->{server}{$target}{$server}{$source}{info}{emulator}     = $server_xml->{devices}->[0]->{emulator}->[0];
	$anvil->data->{server}{$target}{$server}{$source}{info}{acpi}         = exists $server_xml->{features}->[0]->{acpi} ? 1 : 0;
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		"server::${target}::${server}::${source}::info::uuid"         => $anvil->data->{server}{$target}{$server}{$source}{info}{uuid},
		"server::${target}::${server}::${source}::info::name"         => $anvil->data->{server}{$target}{$server}{$source}{info}{name},
		"server::${target}::${server}::${source}::info::on_poweroff"  => $anvil->data->{server}{$target}{$server}{$source}{info}{on_poweroff},
		"server::${target}::${server}::${source}::info::on_crash"     => $anvil->data->{server}{$target}{$server}{$source}{info}{on_crash},
		"server::${target}::${server}::${source}::info::on_reboot"    => $anvil->data->{server}{$target}{$server}{$source}{info}{on_reboot},
		"server::${target}::${server}::${source}::info::architecture" => $anvil->data->{server}{$target}{$server}{$source}{info}{architecture},
		"server::${target}::${server}::${source}::info::machine"      => $anvil->data->{server}{$target}{$server}{$source}{info}{machine},
		"server::${target}::${server}::${source}::info::boot_menu"    => $anvil->data->{server}{$target}{$server}{$source}{info}{boot_menu},
		"server::${target}::${server}::${source}::info::id"           => $anvil->data->{server}{$target}{$server}{$source}{info}{id},
		"server::${target}::${server}::${source}::info::emulator"     => $anvil->data->{server}{$target}{$server}{$source}{info}{emulator},
		"server::${target}::${server}::${source}::info::acpi"         => $anvil->data->{server}{$target}{$server}{$source}{info}{acpi},
	}});
	
	# CPU
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{total_cores}    = $server_xml->{vcpu}->[0]->{content};
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{sockets}        = $server_xml->{cpu}->[0]->{topology}->[0]->{sockets};
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{cores}          = $server_xml->{cpu}->[0]->{topology}->[0]->{cores};
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{threads}        = $server_xml->{cpu}->[0]->{topology}->[0]->{threads};
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{model_name}     = $server_xml->{cpu}->[0]->{model}->[0]->{content};
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{model_fallback} = $server_xml->{cpu}->[0]->{model}->[0]->{fallback};
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{match}          = $server_xml->{cpu}->[0]->{match};
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{vendor}         = $server_xml->{cpu}->[0]->{vendor}->[0];
	$anvil->data->{server}{$target}{$server}{$source}{cpu}{mode}           = $server_xml->{cpu}->[0]->{mode};
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		"server::${target}::${server}::${source}::cpu::total_cores"    => $anvil->data->{server}{$target}{$server}{$source}{cpu}{total_cores},
		"server::${target}::${server}::${source}::cpu::sockets"        => $anvil->data->{server}{$target}{$server}{$source}{cpu}{sockets},
		"server::${target}::${server}::${source}::cpu::cores"          => $anvil->data->{server}{$target}{$server}{$source}{cpu}{cores},
		"server::${target}::${server}::${source}::cpu::threads"        => $anvil->data->{server}{$target}{$server}{$source}{cpu}{threads},
		"server::${target}::${server}::${source}::cpu::model_name"     => $anvil->data->{server}{$target}{$server}{$source}{cpu}{model_name},
		"server::${target}::${server}::${source}::cpu::model_fallback" => $anvil->data->{server}{$target}{$server}{$source}{cpu}{model_fallback},
		"server::${target}::${server}::${source}::cpu::match"          => $anvil->data->{server}{$target}{$server}{$source}{cpu}{match},
		"server::${target}::${server}::${source}::cpu::vendor"         => $anvil->data->{server}{$target}{$server}{$source}{cpu}{vendor},
		"server::${target}::${server}::${source}::cpu::mode"           => $anvil->data->{server}{$target}{$server}{$source}{cpu}{mode},
	}});
	foreach my $hash_ref (@{$server_xml->{cpu}->[0]->{feature}})
	{
		my $name                                                                  = $hash_ref->{name};
		   $anvil->data->{server}{$target}{$server}{$source}{cpu}{feature}{$name} = $hash_ref->{policy};
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			"server::${target}::${server}::${source}::cpu::feature::${name}" => $anvil->data->{server}{$target}{$server}{$source}{cpu}{feature}{$name},
		}});
		
	}
	
	# Power Management
	$anvil->data->{server}{$target}{$server}{$source}{pm}{'suspend-to-disk'} = $server_xml->{pm}->[0]->{'suspend-to-disk'}->[0]->{enabled};
	$anvil->data->{server}{$target}{$server}{$source}{pm}{'suspend-to-mem'}  = $server_xml->{pm}->[0]->{'suspend-to-mem'}->[0]->{enabled};
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		"server::${target}::${server}::${source}::pm::suspend-to-disk" => $anvil->data->{server}{$target}{$server}{$source}{pm}{'suspend-to-disk'},
		"server::${target}::${server}::${source}::pm::suspend-to-mem"  => $anvil->data->{server}{$target}{$server}{$source}{pm}{'suspend-to-mem'},
	}});
	
	# RAM - 'memory' is as set at boot, 'currentMemory' is the RAM used at polling (so only useful when 
	#       running). In the Anvil!, we don't support memory ballooning, so we're use whichever is 
	#       higher.
	my $current_ram_value = $server_xml->{currentMemory}->[0]->{content};
	my $current_ram_unit  = $server_xml->{currentMemory}->[0]->{unit};
	my $current_ram_bytes = $anvil->Convert->human_readable_to_bytes({size => $current_ram_value, type => $current_ram_unit});
	my $ram_value         = $server_xml->{memory}->[0]->{content};
	my $ram_unit          = $server_xml->{memory}->[0]->{unit};
	my $ram_bytes         = $anvil->Convert->human_readable_to_bytes({size => $ram_value, type => $ram_unit});
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		current_ram_value => $current_ram_value,
		current_ram_unit  => $current_ram_unit,
		current_ram_bytes => $anvil->Convert->add_commas({number => $current_ram_bytes})." (".$anvil->Convert->bytes_to_human_readable({'bytes' => $current_ram_bytes}).")",
		ram_value         => $ram_value,
		ram_unit          => $ram_unit,
		ram_bytes         => $anvil->Convert->add_commas({number => $ram_bytes})." (".$anvil->Convert->bytes_to_human_readable({'bytes' => $ram_bytes}).")",
	}});
	
	$anvil->data->{server}{$target}{$server}{$source}{memory} = $current_ram_bytes > $ram_bytes ? $current_ram_bytes : $ram_bytes;
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		"server::${target}::${server}::${source}::memory" => $anvil->Convert->add_commas({number => $anvil->data->{server}{$target}{$server}{$source}{memory}})." (".$anvil->Convert->bytes_to_human_readable({'bytes' => $anvil->data->{server}{$target}{$server}{$source}{memory}}).")",
	}});
	
	# Clock info
	$anvil->data->{server}{$target}{$server}{$source}{clock}{offset} = $server_xml->{clock}->[0]->{offset};
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		"server::${target}::${server}::${source}::clock::offset" => $anvil->data->{server}{$target}{$server}{$source}{clock}{offset},
	}});
	foreach my $hash_ref (@{$server_xml->{clock}->[0]->{timer}})
	{
		my $name = $hash_ref->{name};
		foreach my $variable (keys %{$hash_ref})
		{
			next if $variable eq "name";
			$anvil->data->{server}{$target}{$server}{$source}{clock}{$name}{$variable} = $hash_ref->{$variable};
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::clock::${name}::${variable}" => $anvil->data->{server}{$target}{$server}{$source}{clock}{$name}{$variable},
			}});
		}
	}
	
	# Pull out my channels
	foreach my $hash_ref (@{$server_xml->{devices}->[0]->{channel}})
	{
		my $type = $hash_ref->{type};
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { type => $type }});
		if ($type eq "unix")
		{
			# Bus stuff
			my $address_type       = $hash_ref->{address}->[0]->{type};
			my $address_controller = $hash_ref->{address}->[0]->{controller};
			my $address_bus        = $hash_ref->{address}->[0]->{bus};
			my $address_port       = $hash_ref->{address}->[0]->{port};
			
			# Store
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{source}{mode}        = defined $hash_ref->{source}->[0]->{mode} ? $hash_ref->{source}->[0]->{mode} : "";
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{source}{path}        = defined $hash_ref->{source}->[0]->{path} ? $hash_ref->{source}->[0]->{path} : "";
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{alias}               = defined $hash_ref->{alias}->[0]->{name}  ? $hash_ref->{alias}->[0]->{name}  : "";
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{type}       = $address_type;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{bus}        = $address_bus;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{controller} = $address_controller;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{port}       = $address_port;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{target}{type}        = $hash_ref->{target}->[0]->{type};
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{target}{'state'}     = defined $hash_ref->{target}->[0]->{'state'} ? $hash_ref->{target}->[0]->{'state'} : "";
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{target}{name}        = $hash_ref->{target}->[0]->{name};
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::channel::unix::source::mode"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{source}{mode},
				"server::${target}::${server}::${source}::device::channel::unix::source::path"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{source}{path},
				"server::${target}::${server}::${source}::device::channel::unix::alias"               => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{alias},
				"server::${target}::${server}::${source}::device::channel::unix::address::type"       => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{type},
				"server::${target}::${server}::${source}::device::channel::unix::address::bus"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{bus},
				"server::${target}::${server}::${source}::device::channel::unix::address::controller" => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{controller},
				"server::${target}::${server}::${source}::device::channel::unix::address::port"       => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{address}{port},
				"server::${target}::${server}::${source}::device::channel::unix::target::type"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{target}{type},
				"server::${target}::${server}::${source}::device::channel::unix::target::state"       => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{target}{'state'},
				"server::${target}::${server}::${source}::device::channel::unix::target::name"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{unix}{target}{name},
			}});
			
			### TODO: Store the parts in some format that allows representing it better to the user and easier to find "open slots".
			# Add to system bus list
# 			$anvil->data->{server}{$target}{$server}{$source}{address}{$address_type}{controller}{$address_controller}{bus}{$address_bus}{port}{$address_port} = "channel - ".$type;
# 			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
# 				"server::${target}::${server}::${source}::address::${address_type}::controller::${address_controller}::bus::${address_bus}::port::${address_port}" => $anvil->data->{server}{$target}{$server}{$source}{address}{$address_type}{controller}{$address_controller}{bus}{$address_bus}{port}{$address_port},
# 			}});
		}
		elsif ($type eq "spicevmc")
		{
			# Bus stuff
			my $address_type       = $hash_ref->{address}->[0]->{type};
			my $address_controller = $hash_ref->{address}->[0]->{controller};
			my $address_bus        = $hash_ref->{address}->[0]->{bus};
			my $address_port       = $hash_ref->{address}->[0]->{port};
			
			# Store
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{alias}               = defined $hash_ref->{alias}->[0]->{name} ? $hash_ref->{alias}->[0]->{name} : "";
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{type}       = $address_type;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{bus}        = $address_bus;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{controller} = $address_controller;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{port}       = $address_port;
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{target}{type}        = $hash_ref->{target}->[0]->{type};
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{target}{'state'}     = defined $hash_ref->{target}->[0]->{'state'} ? $hash_ref->{target}->[0]->{'state'} : "";
			$anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{target}{name}        = $hash_ref->{target}->[0]->{name};
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::channel::spicevmc::alias"               => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{alias},
				"server::${target}::${server}::${source}::device::channel::spicevmc::address::type"       => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{type},
				"server::${target}::${server}::${source}::device::channel::spicevmc::address::bus"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{bus},
				"server::${target}::${server}::${source}::device::channel::spicevmc::address::controller" => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{controller},
				"server::${target}::${server}::${source}::device::channel::spicevmc::address::port"       => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{address}{port},
				"server::${target}::${server}::${source}::device::channel::spicevmc::target::type"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{target}{type},
				"server::${target}::${server}::${source}::device::channel::spicevmc::target::state"       => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{target}{'state'},
				"server::${target}::${server}::${source}::device::channel::spicevmc::target::name"        => $anvil->data->{server}{$target}{$server}{$source}{device}{channel}{spicevmc}{target}{name},
			}});
			
			### TODO: Store the parts in some format that allows representing it better to the user and easier to find "open slots".
			# Add to system bus list
# 			$anvil->data->{server}{$target}{$server}{$source}{address}{$address_type}{controller}{$address_controller}{bus}{$address_bus}{port}{$address_port} = "channel - ".$type;
# 			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
# 				"server::${target}::${server}::${source}::address::${address_type}::controller::${address_controller}::bus::${address_bus}::port::${address_port}" => $anvil->data->{server}{$target}{$server}{$source}{address}{$address_type}{controller}{$address_controller}{bus}{$address_bus}{port}{$address_port},
# 			}});
		}
	}
	
	# Pull out console data
	foreach my $hash_ref (@{$server_xml->{devices}->[0]->{console}})
	{
		$anvil->data->{server}{$target}{$server}{$source}{device}{console}{type}        = $hash_ref->{type};
		$anvil->data->{server}{$target}{$server}{$source}{device}{console}{tty}         = defined $hash_ref->{tty}                 ? $hash_ref->{tty}                 : "";
		$anvil->data->{server}{$target}{$server}{$source}{device}{console}{alias}       = defined $hash_ref->{alias}->[0]->{name}  ? $hash_ref->{alias}->[0]->{name}  : "";
		$anvil->data->{server}{$target}{$server}{$source}{device}{console}{source}      = defined $hash_ref->{source}->[0]->{path} ? $hash_ref->{source}->[0]->{path} : "";
		$anvil->data->{server}{$target}{$server}{$source}{device}{console}{target_type} = $hash_ref->{target}->[0]->{type};
		$anvil->data->{server}{$target}{$server}{$source}{device}{console}{target_port} = $hash_ref->{target}->[0]->{port};
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			"server::${target}::${server}::${source}::device::console::type"        => $anvil->data->{server}{$target}{$server}{$source}{device}{console}{type},
			"server::${target}::${server}::${source}::device::console::tty"         => $anvil->data->{server}{$target}{$server}{$source}{device}{console}{tty},
			"server::${target}::${server}::${source}::device::console::alias"       => $anvil->data->{server}{$target}{$server}{$source}{device}{console}{alias},
			"server::${target}::${server}::${source}::device::console::source"      => $anvil->data->{server}{$target}{$server}{$source}{device}{console}{source},
			"server::${target}::${server}::${source}::device::console::target_type" => $anvil->data->{server}{$target}{$server}{$source}{device}{console}{target_type},
			"server::${target}::${server}::${source}::device::console::target_port" => $anvil->data->{server}{$target}{$server}{$source}{device}{console}{target_port},
		}});
	}
	
	# Controllers is a big chunk
	foreach my $hash_ref (@{$server_xml->{devices}->[0]->{controller}})
	{
		my $type             = $hash_ref->{type};
		my $index            = $hash_ref->{'index'};
		my $ports            = exists $hash_ref->{ports}                     ? $hash_ref->{ports}                    : "";
		my $target_chassis   = exists $hash_ref->{target}                    ? $hash_ref->{target}->[0]->{chassis}   : "";
		my $target_port      = exists $hash_ref->{target}                    ? $hash_ref->{target}->[0]->{port}      : "";
		my $address_type     = defined $hash_ref->{address}->[0]->{type}     ? $hash_ref->{address}->[0]->{type}     : "";
		my $address_domain   = defined $hash_ref->{address}->[0]->{domain}   ? $hash_ref->{address}->[0]->{domain}   : "";
		my $address_bus      = defined $hash_ref->{address}->[0]->{bus}      ? $hash_ref->{address}->[0]->{bus}      : "";
		my $address_slot     = defined $hash_ref->{address}->[0]->{slot}     ? $hash_ref->{address}->[0]->{slot}     : "";
		my $address_function = defined $hash_ref->{address}->[0]->{function} ? $hash_ref->{address}->[0]->{function} : "";
		
		# Model is weird, it can be at '$hash_ref->{model}->[X]' or '$hash_ref->{model}->[Y]->{name}'
		# as 'model' is both an attribute and a child element.
		$hash_ref->{model} = "" if not defined $hash_ref->{model};
		my $model = "";
		if (not ref($hash_ref->{model}))
		{
			$model = $hash_ref->{model};
		}
		else
		{
			foreach my $entry (@{$hash_ref->{model}})
			{
				if (ref($entry))
				{
					$model = $entry->{name} if $entry->{name};
				}
				else
				{
					$model = $entry if $entry;
				}
			}
		}
		
		# Store the data
		$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{alias} = defined $hash_ref->{alias}->[0]->{name} ? $hash_ref->{alias}->[0]->{name} : "";
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::alias" => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{alias},
		}});
		if ($model)
		{
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{model} = $model;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::model" => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{model},
			}});
		}
		if ($ports)
		{
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{ports} = $ports;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::ports" => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{ports},
			}});
		}
		if ($target_chassis)
		{
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{target}{chassis} = $target_chassis;
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{target}{port}    = $target_port;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::target::chassis" => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{target}{chassis},
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::target::port"    => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{target}{port},
			}});
		}
		if ($address_type)
		{
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{type}     = $address_type;
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{domain}   = $address_domain;
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{bus}      = $address_bus;
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{slot}     = $address_slot;
			$anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{function} = $address_function;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::address::type"     => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{type},
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::address::domain"   => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{domain},
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::address::bus"      => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{bus},
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::address::slot"     => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{slot},
				"server::${target}::${server}::${source}::device::controller::${type}::index::${index}::address::function" => $anvil->data->{server}{$target}{$server}{$source}{device}{controller}{$type}{'index'}{$index}{address}{function},
			}});
			
			### TODO: Store the parts in some format that allows representing it better to the user and easier to find "open slots".
			# Add to system bus list
			# Controller type: [pci], alias: (pci.2), index: [2]
			# - Model: [pcie-root-port]
			# - Target chassis: [2], port: [0x11]
			# - Bus type: [pci], domain: [0x0000], bus: [0x00], slot: [0x02], function: [0x1]
			#      server::test_server::from_virsh::address::virtio-serial::controller::0::bus::0::port::2: [channel - spicevmc]
# 			$anvil->data->{server}{$target}{$server}{$source}{address}{$address_type}{controller}{$type}{bus}{$address_bus}{bus}{$address_bus}{slot}{$address_slot}{function}{$address_function}{domain} = $address_domain;
# 			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
# 				"server::${target}::${server}::${source}::address::${address_type}::controller::${type}::bus::${address_bus}::slot::${address_slot}::function::${address_function}::domain" => $anvil->data->{server}{$target}{$server}{$source}{address}{$address_type}{controller}{$type}{bus}{$address_bus}{bus}{$address_bus}{slot}{$address_slot}{function}{$address_function}{domain},
# 			}});
		}
	}
	
	# Find what drives (disk and "optical") this server uses.
	foreach my $hash_ref (@{$server_xml->{devices}->[0]->{disk}})
	{
		#print Dumper $hash_ref;
		my $device        = $hash_ref->{device};
		my $device_target = $hash_ref->{target}->[0]->{dev};
		my $type          = defined $hash_ref->{type}                 ? $hash_ref->{type}                 : "";
		my $alias         = defined $hash_ref->{alias}->[0]->{name}   ? $hash_ref->{alias}->[0]->{name}   : "";
		my $device_bus    = defined $hash_ref->{target}->[0]->{bus}   ? $hash_ref->{target}->[0]->{bus}   : "";
		my $address_type  = defined $hash_ref->{address}->[0]->{type} ? $hash_ref->{address}->[0]->{type} : "";
		my $address_bus   = defined $hash_ref->{address}->[0]->{bus}  ? $hash_ref->{address}->[0]->{bus}  : "";
		my $boot_order    = defined $hash_ref->{boot}->[0]->{order}   ? $hash_ref->{boot}->[0]->{order}   : 99;
		my $driver_name   = defined $hash_ref->{driver}->[0]->{name}  ? $hash_ref->{driver}->[0]->{name}  : "";
		my $driver_type   = defined $hash_ref->{driver}->[0]->{type}  ? $hash_ref->{driver}->[0]->{type}  : "";
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			device        => $device,
			type          => $type,
			alias         => $alias, 
			device_target => $device_target, 
			device_bus    => $device_bus, 
			address_type  => $address_type, 
			address_bus   => $address_bus, 
			boot_order    => $boot_order, 
			driver_name   => $driver_name, 
			driver_type   => $driver_type,
		}});
		
		### NOTE: Live migration won't work unless the '/dev/drbdX' devices are block. If they come 
		###       up as 'file', virsh will refuse to migrate with a lack of shared storage error.
		# A device path can come from 'dev' or 'file'.
		my $device_path = "";
		if (defined $hash_ref->{source}->[0]->{dev})
		{
			$device_path = $hash_ref->{source}->[0]->{dev};
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { device_path => $device_path }});
		}
		else
		{
			$device_path = $hash_ref->{source}->[0]->{file};
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { device_path => $device_path }});
		}
		
		# Record common data
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{alias}         = $alias;
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{boot_order}    = $boot_order;
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{type}          = $type;
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{type} = $address_type;
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{bus}  = $address_bus;
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{name}  = $driver_name;
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{device_bus}    = $device_bus;
		$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{type}  = $driver_type;
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::type" => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{type},
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::bus"  => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{bus},
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::alias"         => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{alias},
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::boot_order"    => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{boot_order},
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::device_bus"    => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{device_bus},
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::driver::name"  => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{name},
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::driver::type"  => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{type},
			"server::${target}::${server}::${source}::device::${device}::target::${device_target}::type"          => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{type},
		}});
		
		if (($boot_order) && ($boot_order =~ /^\d+$/))
		{
			$anvil->data->{server}{$target}{$server}{$source}{boot_order}{$boot_order}{device_target} = $device_target;
			$anvil->data->{server}{$target}{$server}{$source}{boot_order}{$boot_order}{device_type}   = $device;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::boot_order::${boot_order}::device_target" => $anvil->data->{server}{$target}{$server}{$source}{boot_order}{$boot_order}{device_target},
				"server::${target}::${server}::${source}::boot_order::${boot_order}::device_type"   => $anvil->data->{server}{$target}{$server}{$source}{boot_order}{$boot_order}{device_type},
			}});
		}
		
		# Record type-specific data
		if ($device eq "disk")
		{
			my $address_slot     = defined $hash_ref->{address}->[0]->{slot}     ? $hash_ref->{address}->[0]->{slot}     : "";
			my $address_domain   = defined $hash_ref->{address}->[0]->{domain}   ? $hash_ref->{address}->[0]->{domain}   : "";
			my $address_function = defined $hash_ref->{address}->[0]->{function} ? $hash_ref->{address}->[0]->{function} : "";
			my $driver_io        = defined $hash_ref->{driver}->[0]->{io}        ? $hash_ref->{driver}->[0]->{io}        : "";
			my $driver_cache     = defined $hash_ref->{driver}->[0]->{cache}     ? $hash_ref->{driver}->[0]->{cache}     : "";
			
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{domain}   = $address_domain;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{slot}     = $address_slot;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{function} = $address_function;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{path}              = $device_path;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{io}        = $driver_io;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{cache}     = $driver_cache;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::domain"   => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{domain},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::slot"     => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{slot},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::function" => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{function},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::path"              => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{path},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::driver::io"        => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{io},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::driver::cache"     => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{driver}{cache},
			}});
			
			my $on_lv    = defined $anvil->data->{drbd}{config}{$host}{drbd_path}{$device_path}{on}       ? $anvil->data->{drbd}{config}{$host}{drbd_path}{$device_path}{on}       : "";
			my $resource = defined $anvil->data->{drbd}{config}{$host}{drbd_path}{$device_path}{resource} ? $anvil->data->{drbd}{config}{$host}{drbd_path}{$device_path}{resource} : "";
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				's1:host'        => $host, 
				's2:device_path' => $device_path, 
				's3:on_lv'       => $on_lv,
				's4:resource'    => $resource, 
			}});
			if ((not $resource) && ($anvil->data->{drbd}{config}{$host}{'by-res'}{$device_path}{resource}))
			{
				$resource = $anvil->data->{drbd}{config}{$host}{'by-res'}{$device_path}{resource};
				$on_lv    = $anvil->data->{drbd}{config}{$host}{'by-res'}{$device_path}{backing_lv};
				$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
					on_lv    => $on_lv,
					resource => $resource, 
				}});
			}
			
			$anvil->data->{server}{$target}{$server}{device}{$device_path}{on_lv}    = $on_lv;
			$anvil->data->{server}{$target}{$server}{device}{$device_path}{resource} = $resource;
			$anvil->data->{server}{$target}{$server}{device}{$device_path}{target}   = $device_target;
			$anvil->data->{server}{$target}{$server}{resource}{$resource}            = 1;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				host                                                             => $host,
				"server::${target}::${server}::device::${device_path}::on_lv"    => $anvil->data->{server}{$target}{$server}{device}{$device_path}{on_lv},
				"server::${target}::${server}::device::${device_path}::resource" => $anvil->data->{server}{$target}{$server}{device}{$device_path}{resource},
				"server::${target}::${server}::device::${device_path}::target"   => $anvil->data->{server}{$target}{$server}{device}{$device_path}{target},
				"server::${target}::${server}::resource::${resource}"            => $anvil->data->{server}{$target}{$server}{resource}{$resource}, 
			}});
			
			# Keep a list of DRBD resources used by this server.
			my $drbd_resource                                                           = $anvil->data->{server}{$target}{$server}{device}{$device_path}{resource};
			   $anvil->data->{server}{$target}{$server}{drbd}{resource}{$drbd_resource} = 1;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::drbd::resource::${drbd_resource}" => $anvil->data->{server}{$target}{$server}{drbd}{resource}{$drbd_resource},
			}});
			
			### TODO: Store the parts in some format that allows representing it better to the user and easier to find "open slots".
# 			$anvil->data->{server}{$target}{$server}{$source}{address}{$device_bus}{bus}{$address_bus}{bus}{$address_bus}{slot}{$address_slot}{function}{$address_function}{domain} = $address_domain;
# 			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
# 				"server::${target}::${server}::${source}::address::${address_type}::controller::${type}::bus::${address_bus}::slot::${address_slot}::function::${address_function}::domain" => $anvil->data->{server}{$target}{$server}{$source}{address}{$address_type}{controller}{$type}{bus}{$address_bus}{bus}{$address_bus}{slot}{$address_slot}{function}{$address_function}{domain},
# 			}});
		}
		else
		{
			# Looks like IDE is no longer supported on RHEL 8.
			my $address_controller = $hash_ref->{address}->[0]->{controller};
			my $address_unit       = $hash_ref->{address}->[0]->{unit};
			my $address_target     = $hash_ref->{address}->[0]->{target};
			
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{controller} = $address_controller;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{unit}       = $address_unit;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{target}     = $address_target;
			$anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{path}                = $device_path;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::controller" => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{controller},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::unit"       => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{unit},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::address::target"     => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{address}{target},
				"server::${target}::${server}::${source}::device::${device}::target::${device_target}::path"                => $anvil->data->{server}{$target}{$server}{$source}{device}{$device}{target}{$device_target}{path},
			}});
		
		}
	}
	
	# Pull out network data
	foreach my $hash_ref (@{$server_xml->{devices}->[0]->{interface}})
	{
		#print Dumper $hash_ref;
		my $mac = $hash_ref->{mac}->[0]->{address};
		
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{bridge}            = $hash_ref->{source}->[0]->{bridge};
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{alias}             = defined $hash_ref->{alias}->[0]->{name} ? $hash_ref->{alias}->[0]->{name} : "";
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{target}            = defined $hash_ref->{target}->[0]->{dev} ? $hash_ref->{target}->[0]->{dev} : "";
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{model}             = $hash_ref->{model}->[0]->{type};
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{bus}      = $hash_ref->{address}->[0]->{bus};
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{domain}   = $hash_ref->{address}->[0]->{domain};
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{type}     = $hash_ref->{address}->[0]->{type};
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{slot}     = $hash_ref->{address}->[0]->{slot};
		$anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{function} = $hash_ref->{address}->[0]->{function};
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
			"server::${target}::${server}::${source}::device::interface::${mac}::bridge"            => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{bridge},
			"server::${target}::${server}::${source}::device::interface::${mac}::alias"             => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{alias},
			"server::${target}::${server}::${source}::device::interface::${mac}::target"            => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{target},
			"server::${target}::${server}::${source}::device::interface::${mac}::model"             => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{model},
			"server::${target}::${server}::${source}::device::interface::${mac}::address::bus"      => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{bus},
			"server::${target}::${server}::${source}::device::interface::${mac}::address::domain"   => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{domain},
			"server::${target}::${server}::${source}::device::interface::${mac}::address::type"     => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{type},
			"server::${target}::${server}::${source}::device::interface::${mac}::address::slot"     => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{slot},
			"server::${target}::${server}::${source}::device::interface::${mac}::address::function" => $anvil->data->{server}{$target}{$server}{$source}{device}{interface}{$mac}{address}{function},
		}});
	}
	
	return(0);
}


=head2 shutdown_virsh

This takes a server name and tries to shut it down. If the server was found locally, the shut down is requested and this method will wait for the server to actually shut down before returning.

If shut down, C<< 1 >> is returned. If the server wasn't found or another problem occurs, C<< 0 >> is returned.

 my ($shutdown) = $anvil->Server->shutdown_virsh({server => "test_server"});

Parameters;

=head3 force (optional, default '0')

Normally, a graceful shutdown is requested. This requires that the guest respond to ACPI power button events. If the guest won't respond, or for some other reason you want to immediately force the server off, set this to C<< 1 >>.

B<WARNING>: Setting this to C<< 1 >> results in the immediate shutdown of the server! Same as if you pulled the power out of a traditional machine.

=head3 server (required)

This is the name of the server (as it appears in C<< virsh >>) to shut down.

=head3 wait_time (optional, default '0', wait indefinitely)

By default, this method will wait indefinetly for the server to shut down before returning. If this is set to a non-zero number, the method will wait that number of seconds for the server to shut dwwn. If the server is still not off by then, C<< 0 >> is returned.

Setting this to C<< 1 >> effectively disables waiting.

=cut
sub shutdown_virsh
{
	my $self      = shift;
	my $parameter = shift;
	my $anvil     = $self->parent;
	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0125", variables => { method => "Server->shutdown_virsh()" }});
	
	my $server      = defined $parameter->{server}    ? $parameter->{server}    : "";
	my $force       = defined $parameter->{force}     ? $parameter->{force}     : 0;
	my $wait_time   = defined $parameter->{wait_time} ? $parameter->{wait_time} : 0;
	my $success     = 0;
	my $server_uuid = "";
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
		force     => $force, 
		server    => $server, 
		wait_time => $wait_time, 
	}});
	
	if (not $server)
	{
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Server->shutdown_virsh()", parameter => "server" }});
		return($success);
	}
	if (($wait_time) && ($wait_time =~ /\D/))
	{
		# Bad value.
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0422", variables => { server => $server, wait_time => $wait_time }});
		return($success);
	}
	
	# Is the server running? 
	$anvil->Server->find({debug => $debug});
	
	# And?
	if (exists $anvil->data->{server}{location}{$server})
	{
		my $shutdown = 1;
		my $status   = $anvil->data->{server}{location}{$server}{status};
		my $task     = "shutdown";
		if ($force)
		{
			$task = "destroy";
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, key => "log_0424", variables => { server => $server }});
		}
		else
		{
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0425", variables => { server => $server }});
		}
		if ($status eq "shut off")
		{
			# Already off. 
			$success = 1;
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0423", variables => { server => $server }});
			return($success);
		}
		elsif ($status eq "paused")
		{
			### TODO: No, don't do this! The server might be migrating
			# The server is paused. Resume it, wait a few, then proceed with the shutdown.
# 			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0314", variables => { server => $server }});
# 			my ($output, $return_code) = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." resume $server"});
# 			if ($return_code)
# 			{
# 				# Looks like virsh isn't running.
# 				$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 0, priority => "err", key => "log_0315", variables => { 
# 					server      => $server,
# 					return_code => $return_code, 
# 					output      => $output, 
# 				}});
# 				$anvil->nice_exit({exit_code => 1});
# 			}
# 			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0316"});
# 			sleep 3;
		}
		elsif ($status eq "pmsuspended")
		{
			# The server is suspended. Resume it, wait a few, then proceed with the shutdown.
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0317", variables => { server => $server }});
			my ($output, $return_code) = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." dompmwakeup $server"});
			if ($return_code)
			{
				# Looks like virsh isn't running.
				$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 0, priority => "err", key => "log_0318", variables => { 
					server      => $server,
					return_code => $return_code, 
					output      => $output, 
				}});
				$anvil->nice_exit({exit_code => 1});
			}
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0319"});
			sleep 30;
		}
		elsif (($status eq "idle") or ($status eq "crashed"))
		{
			# The server needs to be destroyed.
			$task = "destroy";
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0322", variables => { 
				server => $server,
				status => $status, 
			}});
		}
		elsif ($status eq "in shutdown")
		{
			# The server is already shutting down
			$shutdown = 0;
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0320", variables => { server => $server }});
		}
		elsif ($status ne "running")
		{
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 0, priority => "err", key => "log_0325", variables => { 
				server => $server,
				status => $status, 
			}});
			return($success);
		}
		
		# Shut it down.
		if ($shutdown)
		{
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "sys::database::connections" => $anvil->data->{sys}{database}{connections} }});
			if ($anvil->data->{sys}{database}{connections})
			{
				if ($anvil->data->{sys}{database}{connections})
				{
					my $anvil_uuid = $anvil->Cluster->get_anvil_uuid({debug => $debug});
					$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { anvil_uuid => $anvil_uuid }});
					
					$server_uuid = $anvil->Get->server_uuid_from_name({
						debug       => $debug, 
						server_name => $server, 
						anvil_uuid  => $anvil_uuid,
					});
					$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { server_uuid => $server_uuid }});
					if (($server_uuid) && ($server_uuid ne "!!error!!"))
					{
						$anvil->Database->get_servers({debug => $debug});
						if (exists $anvil->data->{servers}{server_uuid}{$server_uuid})
						{
							my $old_state = $anvil->data->{servers}{server_uuid}{$server_uuid}{server_state};
							$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { old_state => $old_state }});
							
							if ($old_state ne "in shutdown")
							{
								# Update it.
								my $query = "
UPDATE 
    servers 
SET 
    server_state  = 'in shutdown',
    modified_date = ".$anvil->Database->quote($anvil->Database->refresh_timestamp)." 
WHERE 
    server_uuid   = ".$anvil->Database->quote($server_uuid)."
;";
								$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
								$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
							}
						}
					}
				}
			}
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, 'print' => 1, level => 1, key => "log_0520", variables => { server => $server }});
			my ($output, $return_code) = $anvil->System->call({
				debug      => $debug, 
				shell_call => $anvil->data->{path}{exe}{setsid}." --wait ".$anvil->data->{path}{exe}{virsh}." ".$task." ".$server,
			});
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
				output      => $output,
				return_code => $return_code,
			}});
		}
	}
	else
	{
		# Server wasn't found, assume it's off.
		$success = 1;
		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0423", variables => { server => $server }});
		return($success);
	}
	
	# Wait indefinetely for the server to exit.
	my $stop_waiting = 0;
	if ($wait_time)
	{
		$stop_waiting = time + $wait_time;
		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { stop_waiting => $stop_waiting }});
	};
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { wait_time => $wait_time }});
	my $waiting = 1;
	while ($waiting)
	{
		# Update
		$anvil->Server->find({debug => $debug});
		if ((exists $anvil->data->{server}{location}{$server}) && ($anvil->data->{server}{location}{$server}{status}))
		{
			my $status = $anvil->data->{server}{location}{$server}{status};
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { status => $status }});
			
			if ($status eq "shut off")
			{
				# Success! It should be undefined, but we're not the place to worry about 
				# that.
				$success = 1;
				$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0426", variables => { server => $server }});
			}
		}
		else
		{
			# Success!
			$success = 1;
			$waiting = 0;
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0426", variables => { 
				server  => $server,
				waiting => $waiting, 
			}});
			
			# Mark it as stopped now. (if we have a server_uuid, we have a database connection)
			if ($server_uuid)
			{
				if ($anvil->data->{sys}{database}{connections})
				{
					$anvil->Database->get_servers({debug => $debug});
					if (exists $anvil->data->{servers}{server_uuid}{$server_uuid})
					{
						my $old_state = $anvil->data->{servers}{server_uuid}{$server_uuid}{server_state};
						$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { old_state => $old_state }});
						
						if ($old_state ne "shut off")
						{
							# Update it.
							my $query = "
UPDATE 
    servers 
SET 
    server_state     = 'shut off', 
    server_boot_time = 0, 
    server_host_uuid = NULL, 
    modified_date    = ".$anvil->Database->quote($anvil->Database->refresh_timestamp)." 
WHERE 
    server_uuid      = ".$anvil->Database->quote($server_uuid)."
;";
							$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { query => $query }});
							$anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
						}
					}
				}
			}
		}
		
		if (($stop_waiting) && (time > $stop_waiting))
		{
			# Give up waiting.
			$waiting = 0;
			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { waiting => $waiting }});
			
			my $key = $wait_time == 1 ? "log_0727" : "log_0427";
			$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => $key, variables => { 
				server => $server,
				'wait' => $wait_time,
			}});
		}
		else
		{
			# Sleep a second and then try again.
			sleep 1;
		}
	}
	
	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { success => $success }});
	return($success);
}

# =head3
# 
# Private Functions;
# 
# =cut

#############################################################################################################
# Private functions                                                                                         #
#############################################################################################################