view release on metacpan or  search on metacpan

lib/App/FuguVM/CLI.pm  view on Meta::CPAN

	return EXIT_ERROR if !$self->_require_running($vm);

	my $port = $self->_require_port( $vm, 'console_port' );
	return EXIT_ERROR if !defined $port;

	my $host = $vm->connect_address;

	# The line goes through the logger, so --quiet drops it and
	# the attachment still happens.
	$self->{log}
	    ->info("Attaching to $host:$port. Leave with Ctrl-], then 'quit'.");

	my $console = App::FuguVM::Console->new(
		host => $host,
		port => $port,
	);

	return $console->attach;
}

# Run an expect script
sub cmd_expect ( $self, $cli, @args )
{
	my $script = shift @args;
	if ( !defined $script ) {
		$self->{log}->error("Usage: fuguvm expect <script> [args...]");
		return EXIT_INVALID_ARGS;
	}

	my $vm = $self->_load_vm or return $self->{load_exit};

	my $port = $self->_require_port( $vm, 'console_port' );
	return EXIT_ERROR if !defined $port;

	my $expect = App::FuguVM::Console->new(
		host => $vm->connect_address,
		port => $port,
	);

	my $result = $expect->run_script( $script, @args );
	return $result ? EXIT_SUCCESS : EXIT_EXPECT_FAILED;
}

# Wait for SSH to become available
sub cmd_wait ( $self, $cli, @args )
{
	my $timeout = $cli->option('timeout') // 120;

	# Make sure that the timeout is a positive integer
	if ( $timeout !~ /^[1-9][0-9]*$/ ) {
		$self->{log}->error("Invalid timeout value: $timeout");
		return EXIT_INVALID_ARGS;
	}

	my $vm = $self->_load_vm or return $self->{load_exit};

	my $port = $self->_require_port( $vm, 'ssh_port' );
	return EXIT_ERROR if !defined $port;

	if ( !$vm->wait_ssh($timeout) ) {
		$self->{log}->error("Timeout waiting for SSH");
		return EXIT_TIMEOUT;
	}

	$self->{log}->info("VM ready");
	return EXIT_SUCCESS;
}

# Installed-image cache management
sub cmd_cache ( $self, $cli, @args )
{
	my $action = shift @args;
	if ( !defined $action || $action !~ /^(list|clear)$/ ) {
		$self->{log}
		    ->error("Usage: fuguvm cache <list|clear [--stale]>");
		return EXIT_INVALID_ARGS;
	}

	my $cache = App::FuguVM::DiskCache->new( $self->{config}->cache_dir );

	return $self->_cache_list($cache) if $action eq 'list';
	return $self->_cache_clear( $cli, $cache, @args );
}

# $self->_cache_list($cache):
#	Show one line for each cached entry. Mark the entry that the
#	configuration of the invoked VM currently derives. Then show
#	what the proxy holds.
sub _cache_list ( $self, $cache )
{
	my $entries = $cache->list;
	if ( !@$entries ) {
		$self->{log}->info("No cached images");
		return $self->_proxy_list;
	}

	my $current = $self->_current_cache_key($cache);

	for my $entry (@$entries) {
		my $created =
		    defined $entry->{created_at}
		    ? scalar localtime $entry->{created_at}
		    : 'unknown';
		my $marker = defined $current
		    && $entry->{key} eq $current ? ' (current)' : '';

		$self->{log}->info(
			sprintf(
				'  - %s  %s  %s  snapshots: %d%s',
				$entry->{key},
				_format_size( $entry->{size} ),
				$created,
				scalar @{ $entry->{snapshots} },
				$marker
			) );
	}

	return $self->_proxy_list;
}

# $self->_proxy_list: