view release on metacpan or  search on metacpan

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

	# Create the .ssh directory
	my $result =
	    $ssh->run_command('mkdir -p /root/.ssh && chmod 700 /root/.ssh');
	if ( $result->{exit_code} != 0 ) {
		return 0;
	}

	# Write the authorized_keys file
	my $authkeys_content = $ssh_pubkey . "\n";
	if (
		$ssh->write_file(
			'/root/.ssh/authorized_keys', $authkeys_content,
			0600
		) != 0
	    )
	{
		return 0;
	}

	# Store the installed pubkey for a future comparison
	$state->mark_ssh_key_installed($ssh_pubkey);
	return 1;
}

# Graceful shutdown with a filesystem sync: sync through SSH, then
# power off through the ACPI power button, and report the result.
sub _graceful_shutdown ($self)
{
	my $log = $self->{log};

	# Do a best-effort filesystem sync over SSH before the code
	# pulls the power. The sync has a hard time bound. A wedged
	# guest must never stall the shutdown. Also, libssh2 does not
	# reliably obey its own timeout on the connect and handshake. A
	# failure or a timeout here is acceptable. The ACPI powerdown
	# below runs the orderly shutdown of the guest, which syncs. A
	# force stop is the ultimate fallback.
	$self->_bounded(
		Fugu::SSH::DEFAULT_TIMEOUT() + 5,
		sub {
			my $ssh = Fugu::SSH->new(
				host => $self->connect_address,
				port => $self->ssh_port,
				user => 'root',
			);
			return $ssh->run_command('sync; sync; sync');
		} );

	# Ask the guest to power off through the ACPI power button. Then
	# wait.
	if ( $self->_qmp_powerdown && $self->_wait_exit(60) ) {
		$log->info("Shutdown via ACPI powerdown");
		return 1;
	}

	return 0;
}

# $self->_bounded($seconds, $code):
#	Run $code under a hard wall-clock deadline, so a blocked guest
#	interaction cannot stall the caller. The guard itself is
#	Fugu::Timeout; this wrapper adds the log line.
sub _bounded ( $self, $seconds, $code )
{
	my $result = Fugu::Timeout::bounded( $seconds, $code );
	return $result if defined $result;

	$self->{log}->warning("Guest did not respond within ${seconds}s");
	return;
}

# $self->_ensure_proxy:
#	Start the caching proxy if it does not run, and return it. The
#	method returns undef when the proxy cannot start.
#
#	The lifecycle lives here and not in App::FuguVM::State, because a
#	state file must not start a process. That split is what removed
#	the require cycle between the two modules.
sub _ensure_proxy ($self)
{
	my $proxy = $self->_proxy;
	return $proxy if $proxy->is_running;

	# The spawn passes a fixed argument list, so the distfile cap
	# reaches the child through the environment.
	$ENV{FUGUVM_DISTFILE_LIMIT} = $self->{config}{distfile_cache} // 0;

	unless ( defined $proxy->start ) {
		$self->{log}->warning(
			'Proxy did not start: %s',
			$proxy->error // 'unknown'
		);
		return;
	}

	return $proxy;
}

# $self->_stop_proxy:
#	Stop the proxy if it runs. The method returns 1 when it stopped
#	one, and 0 when there was none.
sub _stop_proxy ($self)
{
	my $proxy = $self->_proxy;
	return 0 unless $proxy->is_running;

	$proxy->stop;

	return 1;
}

# $self->_proxy:
#	Build the proxy supervisor over this VM's state.
sub _proxy ($self)
{
	my $state = $self->{state};

	return App::FuguVM::Proxy->new(
		cache => App::FuguVM::Proxy::Cache->new(
			$self->_cache_dir, $self->{config}{distfile_cache} // 0

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

	return;
}

# $self->_free_port($first, $last, $taken):
#	Return the first port of the range that binds on the bind
#	address and that $taken does not hold. Return undef for an
#	exhausted range.
sub _free_port ( $self, $first, $last, $taken )
{
	require IO::Socket::INET;

	for my $port ( $first .. $last ) {
		next if $taken->{$port};

		my $sock = IO::Socket::INET->new(
			LocalAddr => $self->bind_address,
			LocalPort => $port,
			Proto     => 'tcp',
			Listen    => 1,
		);
		next if !defined $sock;

		$sock->close;
		return $port;
	}

	return;
}

# $self->_taken_ports:
#	Return the recorded ports of every guest of the project, as a
#	hash reference keyed by port. The method enumerates the state
#	directory, like App::FuguVM::CLI::_disks_backed_by: a record
#	counts whether a 'vm' block still declares its guest or not.
sub _taken_ports ($self)
{
	my %taken;

	my $state_dir = $self->{state}->state_dir;
	return \%taken if !-d $state_dir;

	opendir my $dh, $state_dir or return \%taken;
	my @names = sort grep { !/^\./ && -d "$state_dir/$_" } readdir $dh;
	closedir $dh;

	for my $name (@names) {
		my $sibling = App::FuguVM::State->new( $state_dir, $name )
		    or next;
		my $runtime = $sibling->get_runtime;
		for my $directive (qw(ssh_port console_port)) {
			my $port = $runtime->{$directive};
			$taken{$port} = 1 if defined $port;
		}
	}

	return \%taken;
}

# $self->_lock_ports:
#	Return the locked handle of ports.lock, or undef on the
#	deadline. The lock file lives in the cache directory, so every
#	project that shares that directory probes one port at a time.
#	The record exclusion of _taken_ports covers this project only.
#	A collision with an other project surfaces when QEMU binds the
#	port, as a reported startup failure. The caller probes without
#	the lock when the deadline elapses: a wedged holder must not
#	fail a run.
sub _lock_ports ($self)
{
	my $dir = $self->_cache_dir;
	Fugu::File->ensure_dir($dir) or return;

	my $path = "$dir/ports.lock";
	open my $fh, '>>', $path or do {
		$self->{log}->warning("Cannot open $path: $!");
		return;
	};

	my $locked = Fugu::Timeout::bounded( PORT_LOCK_TIMEOUT,
		sub { flock $fh, LOCK_EX } );
	return $fh if $locked;

	close $fh;
	$self->{log}->warning("Port lock not acquired, probing without it");

	return;
}

# $self->_check_installed_arch:
#	Report if the configured architecture matches the installed
#	disk, once for up and start. A disk belongs to one
#	architecture, so a changed directive must not start the wrong
#	QEMU on an existing disk. An absent record cannot prove a
#	difference, so the check passes.
sub _check_installed_arch ($self)
{
	my $config = $self->{config};

	my $installed = $self->{state}->get_installed_arch;
	return 1 if !defined $installed || $installed eq $config->{arch};

	$self->{log}->error(
"The disk of '$config->{name}' holds an $installed installation, not $config->{arch}"
	);
	$self->{log}->error("Run 'fuguvm destroy' to rebuild the VM.");

	return 0;
}

# _host_arch():
#	Return the host machine architecture from uname.
sub _host_arch ()
{
	require POSIX;
	my @uname = POSIX::uname();
	return $uname[4] // '';
}

# $self->_find_efi_firmware:
#	Return the firmware of the architecture as { code, vars }, or
#	undef. The vars entry is the variable-store template beside
#	the code file. It is undef when -bios boots the code file
#	alone. A code file without its template is not usable, so the
#	search walks on.
sub _find_efi_firmware ($self)
{
	my $arch = $self->_arch;

	my @candidates = $arch->firmware_paths;
	push @candidates, glob( $arch->firmware_glob );

	for my $code (@candidates) {
		next unless -f $code;

		my $vars = $arch->firmware_vars_path($code);
		next if defined $vars && !-f $vars;

		return { code => $code, vars => $vars };
	}

	return;