# Container::Buildah::Subcommand
# ABSTRACT: wrapper class for Container::Buildah to run subcommands of buildah
# by Ian Kluft

## no critic (Modules::RequireExplicitPackage)
# 'use strict' and 'use warnings' included here
use Modern::Perl qw(2018); # require 5.26 security update
## use critic (Modules::RequireExplicitPackage)

package Container::Buildah::Subcommand;
$Container::Buildah::Subcommand::VERSION = '0.2.0';
use autodie;
use Carp qw(croak confess);
use IPC::Run;
use Data::Dumper;
use YAML::XS;
require Container::Buildah;

# exports
use Exporter qw(import);
our @EXPORT_OK   = qw(process_params prog);

#
# parameter processing functions used by process_params()
#

# params_extract - set aside parameters which caller wants extracted for further processing that we can't generalize
# private class function
sub params_extract
{
	my ($defs, $params, $extract_ref) = @_;

	if (exists $defs->{extract}) {
		if (ref $defs->{extract} ne "ARRAY") {
			confess "process_params parameter 'extract' must be an array, got ".(ref $defs->{extract});
		}
		foreach my $argname (@{$defs->{extract}}) {
			if (exists $params->{$argname}) {
				$extract_ref->{$argname} = $params->{$argname};
				delete $params->{$argname};
			}
		}
	}
	return;
}

# param_arg_init - initialize argument list
# private class function
sub param_arg_init
{
	my ($defs, $arg_ref) = @_;

	if (exists $defs->{arg_init}) {
		if (not ref $defs->{arg_init}) {
			push @$arg_ref, $defs->{arg_init};
		} elsif (ref $defs->{arg_init} eq "ARRAY") {
			push @$arg_ref, @{$defs->{arg_init}};
		} else {
			confess "process_params parameter 'arg_init' must be scalar or array, got ".(ref $defs->{arg_init});
		}
	}
	return;
}

# param_exclusive - check for exclusive parameters - if any are present, it must be the only parameter
# private class function
sub param_exclusive
{
	my ($name, $defs, $params, $extract_ref) = @_;

	if (exists $defs->{exclusive}) {
		if (ref $defs->{exclusive} ne "ARRAY") {
			confess "process_params parameter 'exclusive' must be an array, got ".(ref $defs->{exclusive});
		}
		foreach my $argname (@{$defs->{exclusive}}) {
			if (exists $params->{$argname}) {
				# if other flags exist with an exclusive flag, that's an error
				if (scalar keys %$params > 1) {
					croak "$name parameter '".$argname."' is exclusive - cannot be passed with other parameters";
				}

				# exclusive flag saved in extracted fields so caller can detect it
				$extract_ref->{$argname} = $params->{$argname};
			}
		}
	}
	return;
}

# param_arg_flag - process arguments which are boolean flags, excluding those requiring true/false as a string
# private class function
sub param_arg_flag
{
	my ($name, $defs, $params, $arg_ref) = @_;

	if (exists $defs->{arg_flag}) {
		if (ref $defs->{arg_flag} ne "ARRAY") {
			confess "process_params parameter 'arg_flag' must be an array, got ".(ref $defs->{arg_flag});
		}
		foreach my $argname (@{$defs->{arg_flag}}) {
			if (exists $params->{$argname}) {
				if (ref $params->{$argname}) {
					confess "$name parameter '".$argname."' must be scalar, got ".(ref $params->{$argname});
				}
				push @$arg_ref, "--$argname";
				delete $params->{$argname};
			}
		}
	}
	return;
}

# param_arg_flag_str - process arguments which are boolean flags, requiring true/false as a string
# private class function
sub param_arg_flag_str
{
	my ($name, $defs, $params, $arg_ref) = @_;

	if (exists $defs->{arg_flag_str}) {
		if (ref $defs->{arg_flag_str} ne "ARRAY") {
			confess "process_params parameter 'arg_flag_str' must be an array, got ".(ref $defs->{arg_flag_str});
		}
		foreach my $argname (@{$defs->{arg_flag_str}}) {
			if (exists $params->{$argname}) {
				if (ref $params->{$argname}) {
					confess "$name parameter '".$argname."' must be scalar, got ".(ref $params->{$argname});
				}
				if ($params->{$argname} ne "true" and $params->{$argname} ne "false") {
					croak "$name parameter '".$argname."' must be 'true' or 'false', got '".$params->{$argname}."'";
				}
				push @$arg_ref, "--$argname", $params->{$argname};
				delete $params->{$argname};
			}
		}
	}
	return;
}

# param_arg_str - process arguments which take a single string
# private class function
sub param_arg_str
{
	my ($name, $defs, $params, $arg_ref) = @_;

	if (exists $defs->{arg_str}) {
		if (ref $defs->{arg_str} ne "ARRAY") {
			confess "process_params parameter 'arg_str' must be an array, got ".(ref $defs->{arg_str});
		}
		foreach my $argname (@{$defs->{arg_str}}) {
			if (exists $params->{$argname}) {
				if (ref $params->{$argname}) {
					confess "$name parameter '".$argname."' must be scalar, got ".(ref $params->{$argname});
				}
				push @$arg_ref, "--$argname", $params->{$argname};
				delete $params->{$argname};
			}
		}
	}
	return;
}

# param_arg_array - process arguments which take an array (converted to multiple occurrences on command line)
# private class function
sub param_arg_array
{
	my ($name, $defs, $params, $arg_ref) = @_;

	if (exists $defs->{arg_array}) {
		if (ref $defs->{arg_array} ne "ARRAY") {
			confess "process_params parameter 'arg_array' must be an array, got ".(ref $defs->{arg_array});
		}
		foreach my $argname (@{$defs->{arg_array}}) {
			if (exists $params->{$argname}) {
				if (not ref $params->{$argname}) {
					push @$arg_ref, "--$argname", $params->{$argname};
				} elsif (ref $params->{$argname} eq "ARRAY") {
					foreach my $entry (@{$params->{$argname}}) {
						push @$arg_ref, "--$argname", $entry;
					}
				} else {
					confess "$name parameter '".$argname."' must be scalar or array, got ".(ref $params->{$argname});
				}
				delete $params->{$argname};
			}
		}
	}
	return;
}

# param_arg_list - process arguments which are formatted as a list on the command-line
# This is only used by buildah-config's entrypoint parameter. This wrapper allows the parameter to be given as
# an array structure which will be provided to buildah formatted as a string parameter.
# private class function
sub param_arg_list
{
	my ($name, $defs, $params, $arg_ref) = @_;

	if (exists $defs->{arg_list}) {
		if (ref $defs->{arg_list} ne "ARRAY") {
			confess "process_params parameter 'arg_list' must be an array, got ".(ref $defs->{arg_list});
		}
		foreach my $argname (@{$defs->{arg_list}}) {
			if (exists $params->{$argname}) {
				if (not ref $params->{$argname}) {
					push @$arg_ref, "--$argname", $params->{$argname};
				} elsif (ref $params->{$argname} eq "ARRAY") {
					push @$arg_ref, "--$argname", '[ "'.join('", "', @{$params->{$argname}}).'" ]';
				} else {
					confess "$name parameter '$argname' must be scalar or array, got ".(ref $params->{$argname});
				}
				delete $params->{$argname};
			}
		}
	}
	return;
}

# parameter processing for buildah subcommand wrapper functions
# private class function - used only by Container::Buildah and Container::Buildah::Stage
#
# usage: ($extract, @args) = process_params({name => str, deflist => [ ... ], ... }, \%params);
#   deflist can be any of: extract exclusive arg_init arg_flag arg_flag_str arg_str arg_array arg_list
#
# All the buildah subcommand wrapper functions use similar logic to process parameters, which is centralized here.
# This builds an argument list to be used by a buildah subcommand.
# Parameters are the same names as command-line arguments of buildah subcommands.
sub process_params
{
	my $defs = shift; # defintions of parameters to process
	my $params = shift; # received parameters

	# results to build and return
	my @args; # argument list result to pass back
	my %extracted; # parameters extracted by name

	# get wrapper function name to use in error reporting
	# use caller function name if not provided
	my $name = $defs->{name} // (caller(1))[3];

	# set aside parameters which caller wants extracted for further processing that we can't generalize here
	params_extract($defs, $params, \%extracted);

	# initialize argument list
	param_arg_init($defs, \@args);

	# check for exclusive parameters - if any are present, it must be the only parameter
	param_exclusive($name, $defs, $params, \%extracted);

	# process arguments which are boolean flags, excluding those requiring true/false as a string
	param_arg_flag($name, $defs, $params, \@args);

	# process arguments which are boolean flags, requiring true/false as a string
	param_arg_flag_str($name, $defs, $params, \@args);

	# process arguments which take a single string
	param_arg_str($name, $defs, $params, \@args);

	# process arguments which take an array (converted to multiple occurrences on command line)
	param_arg_array($name, $defs, $params, \@args);

	# process arguments which are formatted as a list on the command-line
	# (this is only used by buildah-config's entrypoint parameter)
	param_arg_list($name, $defs, $params, \@args);

	# error out if any unexpected parameters remain
	if (%$params) {
		confess "$name received undefined parameters: ".(join(" ", keys %$params));
	}

	# return processed argument list
	return (\%extracted, @args);
}

#
# system access utility functions
#

# generate name of environment variable for where to find a command
# this is broken out as a separate function for tests to use it
# private class function
sub envprog
{
	my $progname = shift;
	my $envprog = (uc $progname)."_PROG";
	$envprog =~ s/[\W-]+/_/xg; # collapse any sequences of non-alphanumeric/non-underscore to a single underscore
	return $envprog;
}

# look up program in standard Linux/POSIX path, not using PATH environment variable for security
# private class function
sub prog
{
	my $progname = shift;
	my $cb = Container::Buildah->instance();

	if (!exists $cb->{prog}) {
		$cb->{prog} = {};
	}
	my $prog = $cb->{prog};

	# call with undef to initialize cache (needed for testing because normal use will auto-create it)
	if (!defined $progname) {
		return;
	}

	# return value from cache if found
	if (exists $prog->{$progname}) {
		return $prog->{$progname};
	}

	# if we didn't have the location of the program, look for it and cache the result
	my $envprog = envprog($progname);
	if (exists $ENV{$envprog} and -x $ENV{$envprog}) {
		$prog->{$progname} = $ENV{$envprog};
		return $prog->{$progname};
	}

	# search paths in order emphasizing recent Linux Filesystem that prefers /usr/bin, then Unix PATH order
	my $found;
	for my $path ("/usr/bin", "/sbin", "/usr/sbin", "/bin") {
		if (-x "$path/$progname") {
			$prog->{$progname} = "$path/$progname";
			$found = $prog->{$progname};
			last;
		}
	}

	# return path, or error if we didn't find a known secure location for the program
	if (not defined $found) {
		croak "unknown secure location for $progname - install it or set $envprog to point to it";
	}
	return $found
}

#
# external command functions
#

# run a command and report errors
# private class method
sub cmd
{
	my ($class_or_obj, $opts, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $name = (exists $opts->{name}) ? $opts->{name} : "cmd";

	# exception-handling wrapper
	my $outstr;
	eval {
		# disallow undef in in_args
		Container::Buildah::disallow_undef(\@in_args);

		# use IPC::Run to capture or suppress output as requested
		$cb->debug({level => 4}, "cmd $name ".join(" ", @in_args));
		my $outdest = \*STDOUT;
		my $errdest = \*STDERR;
		if ($opts->{capture_output} // 0) {
			$outdest = \$outstr;
		} elsif ($opts->{suppress_output} // 0) {
			$outdest = "/dev/null";
		}
		if ($opts->{suppress_error} // 0) {
			$errdest = "/dev/null";
		}
		IPC::Run::run(\@in_args, '<', \undef, '>', $outdest, '2>', $errdest);

		# process result codes
		if ($? == -1) {
			confess "failed to execute command (".join(" ", @in_args)."): $!";
		}
		if ($? & 127) {
			confess sprintf "command (".join(" ", @in_args)." child died with signal %d, %s coredump\n",
				($? & 127),  ($? & 128) ? 'with' : 'without';
		}
		my $retcode = $? >> 8;
		if (exists $opts->{save_retcode} and ref $opts->{save_retcode} eq "SCALAR") {
			${$opts->{save_retcode}} = $retcode; # save return code via a scalar ref for testing
		}
		if ($retcode != 0) {
			# invoke callback for nonzero result, and pass it the result code
			# this may be used to prevent exceptions for commands that return specific unharmful nonzero results
			if (exists $opts->{nonzero} and ref $opts->{nonzero} eq "CODE") {
				&{$opts->{nonzero}}($retcode);
			} else {
				confess "non-zero status ($retcode) from cmd ".join(" ", @in_args);
			}
		} elsif (exists $opts->{zero} and ref $opts->{zero} eq "CODE") {
			# invoke callback for zero result
			&{$opts->{zero}}();
		}
		1;
	} or do {
		if ($@) {
			confess "$name: ".$@;
		}
	};
	return $outstr;
}

# run buildah command with parameters
# public class method
sub buildah
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();

	# collect options to pass along to cmd() method
	my $opts = {};
	if (ref $in_args[0] eq "HASH") {
		$opts = shift @in_args;
	}
	$opts->{name} = "buildah";

	Container::Buildah::disallow_undef(\@in_args);
	$cb->debug({level => 3}, "buildah: args = ".join(" ", @in_args));
	return $cb->cmd($opts, prog("buildah"), @in_args);
}

#
# buildah subcommand wrapper methods
# for subcommands which do not have a container name parameter (those are in Container::Buildah::Stage)
#

# front end to "buildah bud" (build under dockerfile) subcommand
# usage: $cb->bud({name => value, ...}, context)
# public class method
sub bud
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'bud',
		extract => [qw(suppress_output suppress_error nonzero zero)],
		arg_flag => [qw(compress disable-content-trust http-proxy log-rusage no-cache pull pull-always pull-never
			quiet rm squash tls-verify)],
		arg_flag_str => [qw(disable-compression force-rm layers)],
		arg_str => [qw(arch authfile blob-cache cache-from cert-dir cgroup-parent cni-config-dir cni-plugin-path
			cpu-period cpu-quota cpu-shares cpuset-cpus cpuset-mems creds decryption-key file format http-proxy
			iidfile ipc isolation jobs logfile loglevel memory memory-swap network os override-arch override-os
			platform runtime shm-size sign-by signature-policy tag target timestamp userns userns-uid-map
			userns-gid-map userns-uid-map-user userns-gid-map-group uts)],
		arg_array => [qw(add-host annotation build-arg cap-add cap-drop device dns dns-option dns-search
			label runtime-flag security-opt ulimit volume)],
		}, $params);

	# run buildah-tag
	$cb->buildah($extract, "bud", @args, @in_args);
	return;
}

# front end to "buildah containers" subcommand
# usage: $str = $cb->containers({name => value, ...})
# public class method
sub containers
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'containers',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(all json noheading notruncate quiet)],
		arg_str => [qw(filter format)],
		}, $params);

	# run command and return output
	return $cb->buildah({capture_output => 1, %$extract}, "containers", @args);
}

# front-end to "buildah from" subcommand
# usage: $cb->from( [{[key => value], ...},] image )
# public instance method
sub from
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'from',
		extract => [qw(suppress_output suppress_error nonzero zero)],
		arg_flag => [qw(pull-always pull-never tls-verify quiet)],
		arg_flag_str => [qw(http-proxy pull)],
		arg_str => [qw(authfile blob-cache cert-dir cgroup-parent cidfile cni-config-dir cni-plugin-path cpu-period
			cpu-quota cpu-shares cpuset-cpus cpuset-mems creds device format ipc isolation memory memory-swap name
			network override-arch override-os pid shm-size ulimit userns userns-uid-map userns-gid-map
			userns-uid-map-user userns-gid-map-group uts)],
		arg_array => [qw(add-host cap-add cap-drop decryption-key device dns dns-option dns-search security-opt
			ulimit volume)],
	}, $params);

	# get image parameter
	my $image = shift @in_args;
	if (not defined $image) {
		croak "image parameter missing in call to 'from' method";
	}

	# run command
	$cb->buildah($extract, "from", @args, $image);
	return;
}

# front end to "buildah images" subcommand
# usage: $str = $cb->images({name => value, ...})
# public class method
sub images
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'images',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(all digests json history noheading no-trunc notruncate quiet)],
		arg_str => [qw(filter format)],
		}, $params);

	# run command and return output
	return $cb->buildah({capture_output => 1, %$extract}, "images", @args);
}

# front end to "buildah info" subcommand
# usage: $str = $cb->info([{debug => 1, format => format}])
# this uses YAML::XS with the assumption that buildah-info's JSON output is a proper subset of YAML
# public class method
sub info
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'info',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(debug)],
		arg_str => [qw(format)],
		}, $params);

	# run command and return output
	my $yaml = $cb->buildah({capture_output => 1, %$extract}, "info", @args);
	my $info = YAML::XS::Load($yaml);
	return $info;
}

# front end to "buildah inspect" subcommand
# usage: $str = $cb->inspect([{option => value, ...}], object_id)
# this uses YAML::XS with the assumption that buildah-inspect's JSON output is a proper subset of YAML
# public class method
sub inspect
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $object_id = $in_args[0];
	if (not defined $object_id) {
		croak "object id parameter missing in call to 'inspect' method";
	}
	my ($extract, @args) = process_params({name => 'inspect',
		extract => [qw(suppress_error nonzero zero)],
		arg_str => [qw(format type)],
		}, $params);

	# run command and return output
	my $yaml = $cb->buildah({capture_output => 1, %$extract}, "inspect", @args,  $object_id);
	my $inspect = YAML::XS::Load($yaml);
	return $inspect;
}

# front end to "buildah manifest_add" subcommand
# usage: $str = $cb->manifest_add([{option => value, ...}], list-or-index, image)
# public class method
sub manifest_add
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $list_or_index = $in_args[0];
	if (not defined $list_or_index) {
		croak "list/index parameter missing in call to 'manifest_add' method";
	}
	my $image = $in_args[1];
	if (not defined $image) {
		croak "object id parameter missing in call to 'manifest_add' method";
	}
	my ($extract, @args) = process_params({name => 'manifest_add',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(all tls-verify)],
		arg_str => [qw(arch authfile cert-dir creds os os-version override-arch override-os variant)],
		arg_array => [qw(annotation features os-features)],
		}, $params);

	# run command and return output
	my $manifest_add = $cb->buildah({capture_output => 1, %$extract}, "manifest_add", @args, $list_or_index, $image);
	return $manifest_add;
}

# front end to "buildah manifest_annotate" subcommand
# usage: $str = $cb->manifest_annotate([{option => value, ...}], list-or-index, digest)
# public class method
sub manifest_annotate
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $list_or_index = $in_args[0];
	if (not defined $list_or_index) {
		croak "list/index parameter missing in call to 'manifest_annotate' method";
	}
	my $digest = $in_args[1];
	if (not defined $digest) {
		croak "image manifest digest parameter missing in call to 'manifest_annotate' method";
	}
	my ($extract, @args) = process_params({name => 'manifest_annotate',
		extract => [qw(suppress_error nonzero zero)],
		arg_str => [qw(arch os os-version variant)],
		arg_array => [qw(annotation features os-features)],
		}, $params);

	# run command and return output
	my $manifest_annotate = $cb->buildah({capture_output => 1, %$extract}, "manifest_annotate", @args, $list_or_index,
		$digest);
	return $manifest_annotate;
}

# front end to "buildah manifest_create" subcommand
# usage: $str = $cb->manifest_create([{option => value, ...}], list-or-index, image)
# public class method
sub manifest_create
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $list_or_index = $in_args[0];
	if (not defined $list_or_index) {
		croak "list/index parameter missing in call to 'manifest_create' method";
	}
	my $image = $in_args[1];
	my ($extract, @args) = process_params({name => 'manifest_create',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(all)],
		arg_str => [qw(override-arch override-os)],
		arg_array => [qw()],
		}, $params);

	# run command and return output
	my $manifest_create = $cb->buildah({capture_output => 1, %$extract}, "manifest_create", @args, $list_or_index,
		($image // ()));
	return $manifest_create;
}

# front end to "buildah manifest_inspect" subcommand
# usage: $str = $cb->manifest_inspect([{option => value, ...}], list-or-index)
# public class method
sub manifest_inspect
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $list_or_index = $in_args[0];
	if (not defined $list_or_index) {
		croak "list/index parameter missing in call to 'manifest_inspect' method";
	}
	my ($extract, @args) = process_params({name => 'manifest_inspect',
		extract => [qw(suppress_error nonzero zero)],
		}, $params);

	# run command and return output
	my $manifest_inspect = $cb->buildah({capture_output => 1, %$extract}, "manifest_inspect", $list_or_index);
	return $manifest_inspect;
}

# front end to "buildah manifest_push" subcommand
# usage: $str = $cb->manifest_push([{option => value, ...}], list-or-index, registry)
# public class method
sub manifest_push
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $list_or_index = $in_args[0];
	if (not defined $list_or_index) {
		croak "list/index parameter missing in call to 'manifest_push' method";
	}
	my $registry = $in_args[1];
	my ($extract, @args) = process_params({name => 'manifest_push',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(all purge quiet remove-signatures tls-verify)],
		arg_str => [qw(authfile cert-dir creds digestfile format sign-by signature-policy)],
		arg_array => [qw()],
		}, $params);

	# run command and return output
	my $manifest_push = $cb->buildah({capture_output => 1, %$extract}, "manifest_push", @args, $list_or_index,
		$registry);
	return $manifest_push;
}

# front end to "buildah manifest_remove" subcommand
# usage: $str = $cb->manifest_remove([{option => value, ...}], list-or-index, image-manifest-digest)
# public class method
sub manifest_remove
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $list_or_index = $in_args[0];
	if (not defined $list_or_index) {
		croak "list/index parameter missing in call to 'manifest_remove' method";
	}
	my $image_manifest_digest = $in_args[0];
	if (not defined $image_manifest_digest) {
		croak "image manifest digest parameter missing in call to 'manifest_remove' method";
	}
	my ($extract, @args) = process_params({name => 'manifest_remove',
		extract => [qw(suppress_error nonzero zero)],
		}, $params);

	# run command and return output
	my $manifest_remove = $cb->buildah({capture_output => 1, %$extract}, "manifest_remove", $list_or_index,
		$image_manifest_digest);
	return $manifest_remove;
}

# front-end to "buildah mount" subcommand
# usage: $mounts = $cb->mount({[notruncate => 1]}, container, ...)
# public class method
sub mount
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'mount',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(notruncate)]
		}, $params);

	# run buildah-tag
	my $output = $cb->buildah({capture_output => 1, %$extract}, "mount", @args, @in_args);
	my %mounts = split(/\s+/sx, $output);
	return \%mounts;
}

# front end to "buildah pull" subcommand
# usage: $str = $cb->pull([{option => value, ...}], image)
# public class method
sub pull
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my $image = $in_args[0];
	if (not defined $image) {
		croak "object id parameter missing in call to 'pull' method";
	}
	my ($extract, @args) = process_params({name => 'pull',
		extract => [qw(suppress_error nonzero zero)],
		arg_flag => [qw(all-tags remove-signatures quiet tls-verify)],
		arg_str => [qw(authfile blob-cache cert-dir creds override-os override-arch signature-policy)],
		arg_array => [qw(decryption-key)],
		}, $params);

	# run command and return output
	my $pull = $cb->buildah({capture_output => 1, %$extract}, "pull", @args,  $image);
	return $pull;
}

# front end to "buildah push" subcommand
# named push_image() to de-conflict with Perl builtin push, but Container::Buildah links push() as an alias
# usage: $str = $cb->push_image([{option => value, ...}], image, [destination])
# or:    $str = $cb->push([{option => value, ...}], image, [destination])
# public class method
sub push_image
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'push_image',
		extract => [qw(suppress_output suppress_error nonzero zero)],
		arg_flag => [qw(disable-compression quiet remove-signatures tls-verify)],
		arg_str => [qw(authfile blob-cache cert-dir creds digestfile format sign-by signature-policy)],
		arg_array => [qw(encryption-key encrypt-layer)],
		}, $params);

	# run command and return output
	$cb->buildah({%$extract}, "push_image", @args,  @in_args);
	return;
}

# front end to "buildah rename" subcommand
# named rename_image() to de-conflict with Perl builtin rename, but Container::Buildah links rename() as an alias
# usage: $str = $cb->rename_image(image, new-name)
# or:    $str = $cb->rename(image, new-name)
# public class method
sub rename_image
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'rename_image',
		extract => [qw(suppress_output suppress_error nonzero zero)],
		}, $params);

	# run command and return output
	$cb->buildah({%$extract}, "rename_image", @in_args);
	return;
}


# front end to "buildah tag" subcommand
# usage: $cb->tag({image => "image_name"}, new_name, ...)
# public class method
sub tag
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'tag',
		extract => [qw(image suppress_output suppress_error nonzero zero)],
		}, $params);
	my $image = $extract->{image}
		or croak "tag: image parameter required";
	delete $extract->{image};

	# run buildah-tag
	$cb->buildah($extract, "tag", $image, @in_args);
	return;
}

# front end to "buildah rm" (remove container) subcommand
# usage: $cb->rm(container, [...])
#    or: $cb->rm({all => 1})
# public class method
sub rm
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'rm',
		extract => [qw(suppress_output suppress_error nonzero zero)],
		arg_flag => [qw(all)],
		exclusive => [qw(all)]
		}, $params);

	# remove containers listed in arguments
	# buildah will error out if --all is provided with container names/ids
	$cb->buildah($extract, "rm", @args, @in_args);
	return;
}

# front end to "buildah rmi" (remove image) subcommand
# usage: $cb->rmi([{force => 1},] image, [...])
#    or: $cb->rmi({prune => 1})
#    or: $cb->rmi({all => 1})
# public class method
sub rmi
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'rmi',
		extract => [qw(suppress_output suppress_error nonzero zero)],
		arg_flag => [qw(all prune force)],
		exclusive => [qw(all prune)],
		}, $params);

	# remove images listed in arguments
	# buildah will error out if --all or --prune are provided with image names/ids
	$cb->buildah($extract, "rmi", @args, @in_args);
	return;
}

# front-end to "buildah umount" subcommand
# usage: $cb->umount({[notruncate => 1]}, container, ...)
# public class method
sub umount
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'umount',
		extract => [qw(suppress_output suppress_error nonzero zero)],
		arg_flag => [qw(all)],
		exclusive => [qw(all)],
		}, $params);

	# run buildah-tag
	$cb->buildah($extract, "umount", @args, @in_args);
	return;
}


# front end to "buildah unshare" (user namespace share) subcommand
# usage: $cb->unshare({container => "name_or_id", [envname => "env_var_name"]}, "cmd", "args", ... )
# public class method
sub unshare
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'unshare',
		extract => [qw(container envname suppress_output suppress_error nonzero zero)],
		arg_str => [qw(mount)],
		}, $params);

	# construct arguments for buildah-unshare command
	# note: --mount may be specified directly or constructed from container/envname - use only one way, not both
	if (exists $extract->{container}) {
		if (exists $extract->{envname}) {
			CORE::push @args, "--mount", $extract->{envname}."=".$extract->{container};
			delete $extract->{envname};
		} else {
			CORE::push @args, "--mount", $extract->{container};
		}
		delete $extract->{container};
	}

	# run buildah-unshare command
	$cb->buildah($extract, "unshare", @args, "--", @in_args);
	return;
}

# front end to "buildah version" subcommand
# usage: $str = $cb->version([{debug => 1, format => format}])
# this uses YAML::XS with the assumption that buildah-version's JSON output is a proper subset of YAML
# public class method
sub version
{
	my ($class_or_obj, @in_args) = @_;
	my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
	my $params = {};
	if (ref $in_args[0] eq "HASH") {
		$params = shift @in_args;
	}

	# process parameters
	my ($extract, @args) = process_params({name => 'version',
		extract => [qw(suppress_error nonzero zero)],
		}, $params);

	# run command and return output
	my $yaml = $cb->buildah({capture_output => 1, %$extract}, "version", @args);
	my $version = YAML::XS::Load($yaml);
	return $version;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Container::Buildah::Subcommand - wrapper class for Container::Buildah to run subcommands of buildah

=head1 VERSION

version 0.2.0

=head1 SYNOPSIS

    use <Container::Buildah>;

=head1 DESCRIPTION

=head1 METHODS

=head2 buildah

=head2 bud

=head2 containers

=head2 from

=head2 images

=head2 info

=head2 inspect

=head2 mount

=head2 pull

=head2 push

=head2 rename

=head2 rm

=head2 rmi

=head2 tag

=head2 umount

=head2 unshare

=head2 version

=head1 BUGS AND LIMITATIONS

Please report bugs via GitHub at L<https://github.com/ikluft/Container-Buildah/issues>

Patches and enhancements may be submitted via a pull request at L<https://github.com/ikluft/Container-Buildah/pulls>

=head1 AUTHOR

Ian Kluft <https://github.com/ikluft>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2020 by Ian Kluft.

This is free software, licensed under:

  The Apache License, Version 2.0, January 2004

=cut
