anvil/tools/anvil-access-module

#!/usr/bin/perl
#
# This script exposes access to the Perl modules written for the Anvil! system.
# It can be executed on Anvil! nodes, DR hosts, or strikers.
#
# Upon execution, creates an instance of Anvil::Tools which provides reference
# to all *.pm instances under the Anvil/Tools/ directory. With these
# references, proceed to execute 1 operation specified by one of --query,
# --sub, or --data flags.
#
#
# --- Notes ---
#
# * In this documentation, a "JSON object" does NOT include array.
#
#
# --- Usages ---
#   To use interactively or process a script:
#   anvil-access-module [--script <file path>]
#
#   * Inputs are processed by lines. Each line must satisfy one of the
#     following format:
#
#     [<line UUID> ]r[ uuid=<database UUID>] <SQL script>
#
#       Performs a data query script (SELECT) on the database. Targets the
#       specified database if "uuid=" is provided.
#
#     [<line UUID> ]w[ uuid=<database UUID>] <SQL script, i.e., >
#
#       Performs a data definition or manipulation script on the database.
#
#     [<line UUID> ]x <module->subroutine, or hash available in Anvil::Tools class> [space-separated positional subroutine parameters...]
#
#       Executes an Anvil module subroutine OR retrieves a hash value. This is
#       designed to expose the most-used parts of "$anvil->..." to the
#       interactive/script function of this tool.
#
#       * A quoted string is treated as one positional parameter with the
#         wrapping quotes removed.
#
#       ! The tool will attempt to decode each positional parameter as JSON.
#         Parameters that fail the decoding will be passed to the subroutine
#         as-is.
#
#   * The response will be prefixed with line UUID if provided. Line UUID must
#     be followed by a space to be recognized.
#
#   * Lines that fail to meet the format above are ignored.
#
#   To read from database:
#   anvil-access-module --query <SQL query> [--uuid <database UUID>]
#   > [ [row0_value0, row0_value1, row0_value2, ...],
#       [row1_value0, row1_value1, row1_value2, ...],
#       [row2_value0, row2_value1, row2_value2, ...], ... ]
#
#   To write to database:
#   anvil-access-module --mode write --query <SQL command> [--uuid <database UUID>]
#   > { write_code: 0 | 1 | "!!error!!" }
#
#   * The --query flag is required for specifying the SQL query (or command)
#     for both read and write.
#
#   * To perform a write, the --mode flag must be set to 'write' (quotes are
#     optional).
#
#   * It's possible to specify which database to access by providing the
#     UUID; this can be ignored most of the time because it's rare to only
#     target one database in a redundant system.
#
#   ! A non-zero 'write_code' means the write failed. Try running the same
#     subroutine with a lower debug value, for example:
#
#     anvil-access-module --sub 'write' --sub-params '{ "query": <SQL command>, "debug": 2 }'
#
#
#   To execute a Perl subroutine:
#   anvil-access-module --sub <subroutine name> [--sub-module <module name>] [--sub-params <JSON object>]
#   > { sub_results: only_value | [value0, value1, value2, ...] }
#
#   * The --sub flag is required for specifying the name of the target
#     subroutine.
#
#   * The --sub-module flag sets the module name that the subroutine exists
#     in. Module name is the file name (case sensitive and without extension)
#     of any .pm file under '<root of this repository>/Anvil/Tools/'.
#
#     This flag defaults to 'Database'.
#
#   * The --sub-params flag accepts a JSON object which will be converted to a
#     Perl hash and passed to the target subroutine as parameters.
#
#     This flag defaults to '{}' (blank JSON object).
#
#   ! In the case where the target subroutine returns a tuple or array, the
#     'sub_results' key in the output JSON object will be an array.
#
#
#   To access the data hash:
#   anvil-access-module --data <JSON object> [--predata <JSON array>]
#   > { ... }
#
#   * The --data flag is required for specifying the data structure to copy
#     from the data hash. The script will recursively traverse each of the
#     given JSON object's properties and pick values from the data hash for
#     each property key that exists.
#
#     JSON object:
#     {
#       [key: string]: boolean | number | null | <JSON object>;
#     }
#
#   * The --predata flag is a 2 dimentional JSON array for speficying 1 or more
#     subroutines to execute in ascending-index-order before extracting data
#     from the data hash. Each element of the top-level array contains a
#     2nd-level array.
#
#     Each 2nd-level array contains:
#     * in element 0, a string in Perl syntax that identifies the target
#       subroutine, and
#     * in element 1, a JSON object with parameters to supply to the target
#       subroutine.
#
#     JSON array:
#     [subroutine: string, parameters: object][];
#
#
# --- Example usages ---
#
#   Select hosts from database:
#   $ anvil-access-module --query "SELECT host_uuid, host_name FROM hosts;"
#   [["09a3ac2f-5904-42a6-bb5e-28cffc7fa4af","mockhost01"],["df3653e3-7378-43e2-be2a-ead1b8aee881","mockhost02"],...]
#
#   Get local host name:
#   $ anvil-access-module --sub 'host_name' --sub-module 'Get' --sub-params '{ "debug": 1 }'
#   {"sub_results":"..."}
#
#   Get database data and 1 path from data hash:
#   $ anvil-access-module --data '{ "database": true, "path": { "exe": { "grep": true } } }'
#   {"database":{...},"path":{"exe":{"grep":"/usr/bin/grep"}}}
#
#   Get network data collected and recorded by the Network->get_ips() subroutine:
#   $ anvil-access-module --predata '[ ["Network->get_ips", { "debug": 1 }] ]' --data '{ "network": true }'
#   {"network":{...}}
#

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

$| = 1;

my $THIS_FILE           =  ($0 =~ /^.*\/(.*)$/)[0];
my $running_directory   =  ($0 =~ /^(.*?)\/$THIS_FILE$/)[0];

$running_directory =~ s/^\./$ENV{PWD}/ if $running_directory =~ /^\./ && $ENV{PWD};

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

sub access_chain
{
	my $parameters = shift;
	my $chain_args = $parameters->{chain_args} // [];
	my $chain_str  = $parameters->{chain};
	my $debug      = $parameters->{debug} // 3;

	my @chain        = split(/->|[.]/, $chain_str);
	my $key_index    = 0;
	my $intermediate = $anvil;
	my @results      = (1);

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

	foreach my $key (@chain)
	{
		my $is_intermediate_hash = is_hash($intermediate);
		my $is_last_key          = $key_index == $#chain;

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

		if ($is_intermediate_hash) # Left-hand is hash; treat it as reading data
		{
			last if (not exists $intermediate->{$key});

			if ($is_last_key)
			{
				@results = ($intermediate->{$key});

				last;
			}

			$intermediate = $intermediate->{$key};
		}
		else # Left-hand is not hash; treat it as blessed/class object (module) and try to call a method from it
		{
			# Don't continue follow the chain when key if not found
			# Note: can() results in truthy when key refers to something that can return a value
			eval { $intermediate->can($key) } or last;

			# On the last key of the chain; try to execute the subroutine if it exists
			if ($is_last_key)
			{
				# Trailing 1 means the eval block will return success if the subroutine and assign succeeded
				eval { (@results) = $intermediate->${key}(@$chain_args); 1; };

				last;
			}

			$intermediate = $intermediate->${key};
		}

		$key_index += 1;
	}

	return (@results);
}

sub call_fn
{
	my $parameters = shift;
	my $chain      = $parameters->{chain};
	my $fallback   = $parameters->{fallback};
	my $fn_wrapper = $parameters->{fn};

	if (exists $fn_wrapper->{fn})
	{
		my $fn        = $fn_wrapper->{fn};
		my $fn_params = $fn_wrapper->{params};

		$fn_params->{chain} = $chain;

		return $fn->($fn_params);
	}
	else
	{
		return $fallback;
	}
}

sub call_pre_data_fns
{
	my $parameters = shift;
	my $fns        = $parameters->{fns};

	if (is_array($fns))
	{
		foreach my $fn_wrapper ( @{$fns} )
		{
			if (is_array($fn_wrapper))
			{
				# The double dash ( // ) operator is similar to the or ( || )
				# operator; it tests for defined instead of true.

				my @cargs = @{$fn_wrapper}[1..$#{$fn_wrapper}];

				access_chain({
					chain      => @{$fn_wrapper}[0],
					chain_args => \@cargs,
				});
			}
		}
	}
}

sub db_access
{
	my $parameters     = shift;
	my $db_access_mode = $parameters->{db_access_mode} // "";
	my $db_uuid        = $parameters->{db_uuid};
	my $sql_query      = $parameters->{sql_query};

	my $access_parameters = { query => $sql_query, uuid => $db_uuid, source => $THIS_FILE, line => __LINE__ };

	return ($db_access_mode eq "write")
		? { write_code => $anvil->Database->write($access_parameters) }
		: $anvil->Database->query($access_parameters);
}

sub foreach_nested
{
	my $parameters   = shift;
	# Required parameters:
	my $hash         = $parameters->{hash};
	# Optional parameters:
	my $chain        = exists $parameters->{chain}        ? $parameters->{chain}        : ();
	my $depth        = exists $parameters->{depth}        ? $parameters->{depth}        : 0;
	my $on_key       = exists $parameters->{on_key}       ? $parameters->{on_key}       : {};
	my $on_chain_end = exists $parameters->{on_chain_end} ? $parameters->{on_chain_end} : {};

	foreach my $key (keys %{$hash})
	{
		my $is_continue_chain = 1;
		my $value             = $hash->{$key};

		push(@{$chain}, $key);

		$is_continue_chain = call_fn({ chain => $chain, fallback => $is_continue_chain, fn => $on_key });

		if ( ($is_continue_chain) && is_hash($value) )
		{
			foreach_nested({
				chain        => $chain,
				depth        => $depth + 1,
				hash         => $value,
				on_chain_end => $on_chain_end,
				on_key       => $on_key,
			});
		}
		else
		{
			call_fn({ chain => $chain, fn => $on_chain_end });
		}

		pop(@{$chain});
	}
}

sub get_anvil_data
{
	my $parameters          = shift;
	my $chain               = $parameters->{chain};
	my $target_intermediate = $parameters->{data};

	my $source_intermediate = $anvil->data;
	my $key_index           = 0;

	foreach my $key ( @{$chain} )
	{
		last if not exists $source_intermediate->{$key};

		$source_intermediate = $source_intermediate->{$key};

		if (not exists $target_intermediate->{$key})
		{
			$target_intermediate->{$key} = {};
		}

		if ($key_index < $#{$chain})
		{
			$target_intermediate = $target_intermediate->{$key};
		}
		else
		{
			$target_intermediate->{$key} = $source_intermediate;
		}

		$key_index += 1;
	}
}

sub get_scmd_args
{
	my $parameters = shift;
	# Required:
	my $input      = $parameters->{input};
	my $get_values = $parameters->{get_values};
	# Optional:
	my $cmd        = $parameters->{cmd};
	my $arg_names  = $parameters->{names} // [];

	my $i       = 0;
	my $args    = {};
	my @matches = $get_values->($input, $cmd);

	foreach (@matches)
	{
		my $arg_name = $arg_names->[$i++] // "$i";

		$args->{$arg_name} = $_ if defined $arg_name;
	}

	return $args;
}

sub is_array
{
	return ref($_[0]) eq "ARRAY";
}

sub is_hash
{
	return ref($_[0]) eq "HASH";
}

sub prettify
{
	my $var_value = shift;
	my $var_name  = shift;

	local $Data::Dumper::Indent  = 1;
	local $Data::Dumper::Varname = $var_name;
	local $Data::Dumper::Terse = (defined $var_name) ? 0 : 1;

	return Dumper($var_value);
}

sub process_scmd_db
{
	my $parameters = shift;
	# Required:
	my $cmd        = $parameters->{cmd};
	my $input      = $parameters->{input};
	# Optional:
	my $lid        = $parameters->{lid} // "";
	my $mode       = $parameters->{mode};

	my $sargs = get_scmd_args({
		cmd        => $cmd,
		input      => $input,
		get_values => sub { my $c = $_[1]; return $_[0] =~ /^$c\s+(?:uuid=([^\s]+))?\s*(.*)$/; },
		names      => ["uuid", "script"],
	});

	eval {
		my $results = db_access({ db_uuid => $sargs->{uuid}, sql_query => $sargs->{script}, db_access_mode => $mode });

		pstdout($lid.JSON->new->utf8->encode($results));
	} or do {
		pstderr("failed to access database; cause: $@");
	}
}

sub process_scmd_execute
{
	my $parameters = shift;
	my $debug      = $parameters->{debug} // 3;
	my $input      = $parameters->{input};
	my $lid        = $parameters->{lid} // "";

	my @sargs = parse_line('\s+', 0, $input);

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

	return if $#sargs < 1;

	my $chain_str  = $sargs[1];
	my @chain_args = $#sargs > 1 ? @sargs[2..$#sargs] : ();

	for my $i (0..$#chain_args)
	{
		my $param             = $chain_args[$i];
		my $is_decode_success = eval { $param = decode_json($param); };

		$chain_args[$i] = $param if $is_decode_success;
	}

	$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $debug, list => {
		chain_args => prettify(\@chain_args),
		chain_str  => $chain_str,
	} });

	my (@results) = access_chain({ chain => $chain_str, chain_args => \@chain_args, debug => $debug });

	pstdout($lid.JSON->new->utf8->allow_blessed->encode({ sub_results => \@results }));
}

sub pstdout
{
	print $_[0]."\n" if defined $_[0];
}

sub pstderr
{
	print STDERR "error: ".$_[0]."\n" if defined $_[0];
}

$anvil->Get->switches;

my $data_hash       = $anvil->data->{switches}{'data'};
my $switch_debug    = $anvil->data->{switches}{'debug'} // 3;
my $db_access_mode  = $anvil->data->{switches}{'mode'} // "";
my $db_uuid         = $anvil->data->{switches}{'uuid'};
#
# Events in this context are simply printing the event name before
# and/or after operations. The output should enable other programs to
# parse and activate additional logic as necessary.
#
# Event names should be present-tense before an operation, and
# past-tense after.
#
my $emit_events     = $anvil->data->{switches}{'emit-events'};
my $pre_data        = $anvil->data->{switches}{'predata'};
my $script_file     = $anvil->data->{switches}{'script'} // "-";
my $sql_query       = $anvil->data->{switches}{'query'};
my $sub_module_name = $anvil->data->{switches}{'sub-module'} // "Database";
my $sub_name        = $anvil->data->{switches}{'sub'} // "";
my $sub_params      = $anvil->data->{switches}{'sub-params'} // "{}";

emit("initialized");

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

emit("connected");

if ($sql_query)
{
	my $results = db_access({ db_uuid => $db_uuid, sql_query => $sql_query, db_access_mode => $db_access_mode });

	pstdout(JSON->new->utf8->encode($results));
}
elsif ($anvil->${sub_module_name}->can($sub_name))
{
	my $decoded_sub_params;
	my $is_decode_sub_params_success = eval { $decoded_sub_params = decode_json($sub_params); };

	if (not $is_decode_sub_params_success)
	{
		pstderr("failed to parse subroutine parameters");

		$anvil->nice_exit({ exit_code => 1 });
	}

	my (@results) = $anvil->${sub_module_name}->${sub_name}($decoded_sub_params);

	pstdout(JSON->new->utf8->encode({ sub_results => scalar(@results) > 1 ? \@results : $results[0] }));
}
elsif ($data_hash)
{
	if ($pre_data)
	{
		my $decoded_pre_data;
		my $is_decode_pre_data_success = eval { $decoded_pre_data = decode_json($pre_data); };

		if ($is_decode_pre_data_success && is_array($decoded_pre_data))
		{
			call_pre_data_fns({ fns => $decoded_pre_data });
		}
	}

	my $decoded_data_hash;
	my $is_decode_data_hash_success = eval { $decoded_data_hash = decode_json($data_hash); };

	if (not $is_decode_data_hash_success)
	{
		pstderr("failed to parse data structure");

		$anvil->nice_exit({ exit_code => 1 });
	}

	my $get_anvil_data_params = { data => {} };

	foreach_nested({
		hash         => $decoded_data_hash,
		on_chain_end => { fn => \&get_anvil_data, params => $get_anvil_data_params },
	});

	pstdout(JSON->new->utf8->allow_blessed->encode($get_anvil_data_params->{data}));
}
else
{
	my $script_file_handle;

	eval {
		# TODO: make this script read piped input

		$script_file = "-" if ($script_file =~ /^#!SET!#$/);

		if ($script_file =~ /^-$/)
		{
			open($script_file_handle, $script_file);
		}
		else
		{
			open($script_file_handle, "< :encoding(UTF-8)", $script_file);
		}
	} or do {
		# open() sets $! upon error, different from the database module failure (which sets $@)
		pstderr("failed to open $script_file as script input; cause: $!");

		$anvil->nice_exit({ exit_code => 1 });
	};

	while (my $script_line = <$script_file_handle>)
	{
		last if ($script_line =~ /^(?:q|quit)\s+$/);

		$script_line =~ s/\s+$//;

		my $scmd_db_read  = "r";
		my $scmd_db_write = "w";
		my $scmd_execute  = "x";

		$script_line =~ s/^([[:xdigit:]]{8}-(?:[[:xdigit:]]{4}-){3}[[:xdigit:]]{12})\s+//;

		my $script_line_id = $1;
		
		$anvil->Log->variables({ source => $THIS_FILE, line => __LINE__, level => $switch_debug, list => {
			script_line_id => $script_line_id,
			script_line    => $script_line,
		} });

		if ($script_line =~ /^$scmd_db_read\s+/)
		{
			process_scmd_db({ cmd => $scmd_db_read, input => $script_line, lid => $script_line_id });
		}
		elsif ($script_line =~ /^$scmd_db_write\s+/)
		{
			process_scmd_db({ cmd => $scmd_db_write, input => $script_line, lid => $script_line_id, mode => "write" });
		}
		elsif ($script_line =~ /^$scmd_execute\s+/)
		{
			process_scmd_execute({ debug => $switch_debug, input => $script_line, lid => $script_line_id });
		}
	}

	close($script_file_handle) or do {
		pstderr("failed to close $script_file handle; cause: $!");

		$anvil->nice_exit({ exit_code => 1 });
	};
}

emit("exit");

$anvil->nice_exit({ exit_code => 0 });

##################################################
# Functions
##################################################
# TODO: need to move all subroutines down here.

sub emit
{
	pstdout("event=".$_[0]) if ($emit_events);
}