anvil/cgi-bin/get_networks

#!/usr/bin/perl
# 
# This prints JSON formatted data about all networks within a specified anvil.
# 

use strict;
use warnings;
use Anvil::Tools;
use Data::Dumper;
use JSON;

$| = 1;

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

my $anvil = Anvil::Tools->new();

sub handle_invalid_uuid
{
	my $parameters = shift;
	my $name       = $parameters->{name};
	my $uuid       = $parameters->{uuid};

	$anvil->Log->entry({
		source    => $THIS_FILE,
		line      => __LINE__,
		level     => 0,
		'print'   => 1,
		priority  => "err",
		key       => "error_0160",
		variables => { name => $name, uuid => $uuid }
	});
	$anvil->nice_exit({ exit_code => 1 });
}

sub get_anvil_networks
{
	my $parameters = shift;
	my $anvil_uuid = $parameters->{anvil_uuid};

	my @host_uuids         = (
		$anvil->data->{anvils}{anvil_uuid}{$anvil_uuid}{anvil_node1_host_uuid},
		$anvil->data->{anvils}{anvil_uuid}{$anvil_uuid}{anvil_node2_host_uuid}
	);
	my $anvil_networks     = [];

	foreach (@host_uuids)
	{
		my $host_networks = get_host_networks({ host_uuid => $_ });

		push(@$anvil_networks, $host_networks);
	}

	return $anvil_networks;
}

sub get_host_networks
{
	my $parameters          = shift;
	my $host_uuid           = $parameters->{host_uuid};
	my $host_name           = $anvil->data->{hosts}{host_uuid}{$host_uuid}{short_host_name};

	# Note: the subprocess name matches its definition; there is a typo though.
	$anvil->Network->load_interfces({ host_uuid => $host_uuid, host => $host_name });

	my $host_networks_data  = $anvil->data->{network}{$host_name};
	my $interfaces          = $host_networks_data->{interface};
	my $bond_uuids          = $host_networks_data->{bond_uuid};
	my $bond_uuid_index_map = {};
	my $host_networks       = {
		host_uuid => $host_uuid,
		host_name => $host_name,
		bonds     => []
	};

	my $build_bond_link_hash = sub {
		my $parameters  = shift;
		my $bond_data   = $parameters->{bond_data};
		my $link_name   = $parameters->{link_name};
		my $link_data   = $parameters->{link_data};
		my $known_links = $parameters->{known_links};

		my $link_speed = $link_data->{speed};
		my $link_state = $link_data->{operational} eq "up" ? "optimal" : "down";

		my $degrade_link_state = sub {
			my $current_link_state = shift;

			return $current_link_state eq "optimal" ? "degraded" : $current_link_state;
		};

		# When at lease 1 link has already been processed, check this link against them.
		if ($known_links)
		{
			my $known_links_index   = 0;
			my $known_links_length  = scalar(@$known_links);

			foreach (@$known_links)
			{
				# Degrade the link with lower speed.
				if ($_->{link_speed} < $link_speed)
				{
					$_->{link_state} = &$degrade_link_state($_->{link_state});
				}
				elsif ($_->{link_state} > $link_speed)
				{
					$link_state = &$degrade_link_state($link_state);
				}

				$anvil->Log->variables({
					source => $THIS_FILE,
					line   => __LINE__,
					level  => 2,
					list   => {
						known_link_name  => $_->{link_name},
						known_link_speed => $_->{link_speed},
						known_link_state => $_->{link_state},
						link_speed       => $link_speed,
						link_name        => $link_name,
						link_state       => $link_state
					}
				});
			}
		}

		return {
			link_name  => $link_name,
			link_uuid  => $link_data->{uuid},
			link_speed => $link_speed,
			link_state => $link_state,
			is_active  => $link_name eq $bond_data->{active_interface} ? \1 : \0
		};
	};

	foreach my $interface_name (sort { $a cmp $b } keys %$interfaces)
	{
		my $interface = $interfaces->{$interface_name};
		# Only a bond's link will have the bond_uuid entry.
		my $bond_uuid = $interface->{bond_uuid};

		if ($bond_uuid)
		{
			my $bond_name  = $bond_uuids->{$bond_uuid}{name};
			my $bond_index = $bond_uuid_index_map->{$bond_uuid};

			$anvil->Log->variables({
				source => $THIS_FILE,
				line   => __LINE__,
				level  => 2,
				list   => {
					bond_name  => $bond_name,
					bond_index => $bond_index
				}
			});

			if (defined $bond_index)
			{
				my $bond = @{$host_networks->{bonds}}[$bond_index];

				push(@{$bond->{links}}, &$build_bond_link_hash({
					bond_data   => $interfaces->{$bond_name},
					link_name   => $interface_name,
					link_data   => $interface,
					known_links => $bond->{links}
				}));
			}
			else
			{
				my $bond = { bond_name => $bond_name, bond_uuid => $bond_uuid, links => [] };
				my $link = &$build_bond_link_hash({
					bond_data => $interfaces->{$bond_name},
					link_name => $interface_name,
					link_data => $interface
				});

				push(@{$bond->{links}}, $link);

				push(@{$host_networks->{bonds}}, $bond);

				# Get the index of the most recently inserted item and map it to the bond's UUID.
				$bond_uuid_index_map->{$bond_uuid} = $#{$host_networks->{bonds}};
			}
		}
	}

	return $host_networks;
}

$anvil->Get->switches;

# Temporary; for debugging
$anvil->Log->level({ set => 2 });

$anvil->Database->connect;
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, secure => 0, key => "log_0132"});
if (not $anvil->data->{sys}{database}{connections})
{
	# No databases, exit.
	$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, 'print' => 1, priority => "err", key => "error_0003"});
	$anvil->nice_exit({exit_code => 1});
}

# Read in any CGI variables, if needed.
$anvil->Get->cgi();

$anvil->Database->get_hosts();
$anvil->Database->get_anvils();

print $anvil->Template->get({file => "shared.html", name => "json_headers", show_name => 0})."\n";

my $anvil_uuid               = $anvil->data->{cgi}{anvil_uuid}{value};
my $anvil_uuid_variable_name = "anvil UUID";

my $response_body = {};

if ($anvil_uuid)
{
	if (exists $anvil->data->{anvils}{anvil_uuid}{$anvil_uuid})
	{
		my $anvil_networks = get_anvil_networks({ anvil_uuid => $anvil_uuid });

		$response_body->{hosts} = $anvil_networks;
	}
	else
	{
		handle_invalid_uuid({ name => $anvil_uuid_variable_name, uuid => $anvil_uuid });
	}
}
else
{
	handle_invalid_uuid({ name => $anvil_uuid_variable_name, uuid => $anvil_uuid });
}

print JSON->new->utf8->encode($response_body)."\n";