view release on metacpan or  search on metacpan

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

	# An installed system boots its own disk, whether it was freshly
	# installed or restored from the image cache. Such a system must
	# not fail here because the miniroot was pruned.
	my $image_path;

	if ( !$state->is_installed ) {
		$log->info("Checking OpenBSD image...");
		my $image =
		    App::FuguVM::Miniroot->new( $self->_cache_dir, $proxy );
		$image_path = $image->ensure( $config->{version} );

		if ( !defined $image_path ) {
			my $url = $image->url( $config->{version} );
			$log->error(
"Failed to download image for OpenBSD $config->{version}"
			);
			$log->error("URL: $url");
			$log->error("Try downloading manually: curl -fLO $url");
			return EXIT_ERROR;
		}

		$log->info("Using cached image: $image_path");
	}

	# Make sure that the disk exists
	my $disk_path = $state->disk_path;

	if ( !$state->disk_exists ) {
		$log->info("Creating disk image ($config->{disk_size})...");
		my $disk = App::FuguVM::Disk->new( $state->state_dir );
		my $result =
		    $disk->create( $config->{name}, $config->{disk_size} );
		if ( !defined $result ) {
			$log->error("Failed to create disk");
			return EXIT_ERROR;
		}
	}

	# Start the VM
	$log->info("Starting VM...");

	# Attach the install media only when the system is not installed
	my $boot_image = $state->is_installed ? undef : $image_path;
	my $pid        = $self->_start_qemu($boot_image);
	if ( !defined $pid ) {
		$log->error("Failed to start VM");
		return EXIT_ERROR;
	}

	$log->info("Started $config->{name} (PID: $pid)");

	# Install the system if necessary
	if ( !$state->is_installed ) {

		# The proxy already runs. The code above started it for the
		# image download. Use the VM-accessible URL for the
		# installation. The VM connects to the host through the
		# gateway.
		my $install_proxy_url = $proxy_vm_url // 'none';

		# Generate a strong random password for this installation
		my $root_password = Fugu::Random->random_password(32);
		$state->set_root_password($root_password);
		$log->info("Generated secure root password");

		$log->info("Installing OpenBSD...");
		my $expect = App::FuguVM::Console->new(
			host => '127.0.0.1',
			port => $config->{console_port},
		);

		# Use the generated password for the installation
		my $install_config = {
			%$config,
			root_password => $root_password,
			proxy_url     => $install_proxy_url,
		};
		my $ok = $expect->run_install($install_config);
		if ( !$ok ) {
			$log->error("Installation failed");
			return EXIT_ERROR;
		}

		$state->mark_installed;
		$log->info("Installation complete");

		# Stop the VM gracefully through QMP. The image cache
		# captures the disk at exactly this point: installed,
		# pristine, and without the per-checkout SSH key. Thus the
		# capture must know that QEMU is really gone. It must not
		# assume it.
		$log->info("Stopping installation VM...");
		$self->_qmp_quit;
		my $clean_exit = $self->_wait_exit(30);

		if ( !$clean_exit ) {
			$log->warning(
"Installation VM did not exit on request, force stopping"
			);
			$self->_force_stop;
			$self->_wait_exit(10);
		}
		$state->clear_vm_pid;

		# Publish the installed disk as a cached base image. A VM
		# that was force stopped can leave the disk mid-write. Thus
		# the code skips that capture and does not publish it.
		if ( defined $cache_key ) {
			if ($clean_exit) {
				$self->_cache_store( $cache, $cache_key,
					$root_password );
			}
			else {
				$log->warning(
"Skipping image cache: installation VM was force stopped"
				);
			}
		}

		# Restart the VM without the install media
		$log->info("Restarting installed system...");
		$pid = $self->_start_qemu;    # No boot image, no exit_on_halt
		if ( !defined $pid ) {
			$log->error("Failed to restart VM");
			return EXIT_ERROR;
		}
		$log->info("Started $config->{name} (PID: $pid)");

		# Install the SSH authorized key for future key-based
		# authentication
		return $self->_complete_ssh_setup;
	}

	# The VM is installed. Check if the SSH key must be installed or
	# updated.
	if ( $self->_needs_ssh_key_update ) {

		# The SSH key is not installed, or it changed in the
		# configuration. Use password authentication to wait for
		# SSH. Then install the key.
		return $self->_complete_ssh_setup;
	}

	# Wait for SSH. An installed VM uses key-based authentication.
	$log->info("Waiting for SSH...");
	if ( !$self->wait_ssh(120) ) {
		$log->error("Timeout waiting for SSH");
		return EXIT_TIMEOUT;
	}

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

# $self->_image_cache:
#	Return the installed-image cache for this VM's configured
#	cache_dir. Return undef when caching is off. 'up --no-cache'
#	turns caching off for a single invocation. 'image_cache no'
#	turns it off in the configuration. Both stop restore and save
#	together. A half-cached run would leave an overlay with a base
#	that nothing published.
sub _image_cache ($self)
{
	return if $self->{no_cache};

	my $enabled = $self->{config}{image_cache};
	return if defined $enabled && !$enabled;

	return App::FuguVM::DiskCache->new( $self->_cache_dir );
}

# $self->_verify_backing_chain:
#	Make sure that the backing image of the working disk, if the
#	disk has one, is present. Return true when the chain resolves.
#	On a break, log the missing file and a remedy, and return
#	false. Thus a pruned or evicted cache entry fails with an
#	explanation, not with an opaque QEMU open error at boot.
sub _verify_backing_chain ($self)
{
	my $config = $self->{config};
	my $state  = $self->{state};
	my $log    = $self->{log};

	my $disk    = App::FuguVM::Disk->new( $state->state_dir );
	my $backing = $disk->backing_file( $config->{name} );
	return 1 if !defined $backing;
	return 1 if -f $backing;

	$log->error("Backing image missing: $backing");

	my $cache_dir = $self->_cache_dir;
	if ( index( $backing, "$cache_dir/" ) == 0 ) {
		$log->error(
"The image cache no longer holds this disk's base image."
		);
	}
	$log->error("Run 'fuguvm destroy' and 'fuguvm up' to rebuild the VM.");

	return 0;
}

# $self->_cache_restore($cache, $key):
#	Create the working disk as an overlay on a cached base image.
#	Seed the state that the installation would have written. Return
#	true on a cache hit. Return false on a miss or on any failure.
#	In both cases the caller then installs from scratch.
sub _cache_restore ( $self, $cache, $key )
{
	my $config = $self->{config};
	my $state  = $self->{state};
	my $log    = $self->{log};

	my $hit = $cache->lookup($key);
	if ( !defined $hit ) {
		$log->info("No cached image for $key, installing");
		return 0;
	}

	my $disk = App::FuguVM::Disk->new( $state->state_dir );
	my $path =
	    $disk->create( $config->{name}, undef, $hit->{base} );
	if ( !defined $path ) {
		$log->warning(
			"Cannot overlay cached image $key, installing instead");
		return 0;
	}

	# The base was captured from an installed system. Thus the state
	# that the installer would have written comes from the metadata
	# of the base. The later SSH key install authenticates with the
	# root password. That password is baked into the image.
	$state->mark_installed;
	my $password = $hit->{meta}{root_password};
	$state->set_root_password($password) if defined $password;
	$state->data->{cached_from} = $key;
	$state->save;

	$log->info("Using cached image $key");
	return 1;
}

# $self->_cache_store($cache, $key, $root_password):
#	Publish the freshly installed disk as a cached base image. Then
#	replace the working disk with an overlay on that image. The
#	operation is best effort. On any failure it keeps the
#	standalone disk in place and warns. 'up' must never fail
#	because caching failed.
sub _cache_store ( $self, $cache, $key, $root_password )
{
	my $config = $self->{config};
	my $state  = $self->{state};
	my $log    = $self->{log};

	$log->info("Caching installed image as $key...");

	my $base = $cache->store(
		$key,
		$state->disk_path,
		{
			root_password => $root_password,
			version       => $config->{version},
			disk_size     => $config->{disk_size},
		} );
	if ( !defined $base ) {
		$log->warning("Could not cache installed image, continuing");
		return 0;
	}

	if ( !$self->_reparent_disk($base) ) {
		$log->warning(
			"Cached image saved but disk left standalone: $base");
		return 0;
	}

	$log->info("Cached installed image: $base");
	return 1;
}

# $self->_reparent_disk($base):
#	Replace the working disk with a fresh overlay backed by $base.
#	The method moves the old disk aside and does not delete it.
#	Thus a failure to create the overlay cannot leave the VM
#	without a disk.
sub _reparent_disk ( $self, $base )
{
	my $config = $self->{config};
	my $state  = $self->{state};
	my $log    = $self->{log};

	my $disk_path = $state->disk_path;
	my $saved     = "$disk_path.replaced";

	unlink $saved if -f $saved;
	rename $disk_path, $saved or do {
		$log->warning("Cannot move $disk_path aside: $!");
		return 0;
	};

	# Disk::create returns early on an existing path. Thus the
	# rename above is what makes this call create the overlay.
	my $disk = App::FuguVM::Disk->new( $state->state_dir );
	my $path = $disk->create( $config->{name}, undef, $base );
	if ( !defined $path ) {
		rename $saved, $disk_path
		    or $log->error("Cannot restore $disk_path: $!");
		return 0;
	}

	unlink $saved or $log->warning("Cannot remove $saved: $!");
	return 1;
}

sub down ($self)
{
	# Stop the proxy if it runs
	if ( $self->_stop_proxy ) {
		$self->{log}->info("Proxy stopped");
	}

	return $self->stop;

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

# $self->_stop_unclean:
#	Force-stop the VM and record the unclean shutdown, so the next
#	'up' checks the disk.
sub _stop_unclean ($self)
{
	my $state = $self->{state};

	$state->mark_unclean_shutdown;
	$self->_force_stop;
	$state->clear_vm_pid;
	$self->{log}->info("VM stopped");

	return EXIT_SUCCESS;
}

sub status ($self)
{
	my $state  = $self->{state};
	my $config = $self->{config};

	my $running = $self->_is_running;
	my $pid     = $state->get_vm_pid;

	# Query the QEMU status through QMP if the VM runs
	my $qemu_status;
	if ($running) {
		my $qmp = $self->_qmp_connect;
		if ($qmp) {
			my $status = $qmp->query_status;
			$qemu_status = $status->{status} if $status;
			$qmp->disconnect;
		}
	}

	return {
		name  => $config->{name},
		state => $running ? ( $qemu_status // 'running' ) : 'stopped',
		pid   => $pid,
		ssh_port     => $config->{ssh_port},
		console_port => $config->{console_port},
		installed    => $state->is_installed ? 1 : 0,
		disk_exists  => $state->disk_exists  ? 1 : 0,
	};
}

sub is_running ($self)
{
	return $self->_is_running;
}

sub ssh_port ($self)
{
	return $self->{config}{ssh_port};
}

sub console_port ($self)
{
	return $self->{config}{console_port};
}

# $self->wait_ssh($timeout, $password):
#	Wait for SSH to become available. Without a password, the
#	connection uses the SSH agent for authentication. The initial
#	installation gives the root password, because the SSH key is
#	not in yet.
sub wait_ssh ( $self, $timeout = 120, $password = undef )
{
	my $ssh = Fugu::SSH->new(
		host => '127.0.0.1',
		port => $self->{config}{ssh_port},
		user => 'root',
		( defined $password ? ( password => $password ) : () ),
	);

	return $ssh->wait_available($timeout);
}

# $self->_needs_ssh_key_update:
#	Check if the SSH key must be installed or updated. Return true
#	if no key is installed. Also return true if the configured key
#	differs from the installed key.
sub _needs_ssh_key_update ($self)
{
	my $config = $self->{config};
	my $state  = $self->{state};

	my $configured_key = $config->{ssh_pubkey};
	my $installed_key  = $state->get_installed_ssh_pubkey;

	# No key is configured. There is nothing to install.
	return 0 if !defined $configured_key || $configured_key eq '';

	# No key is installed yet
	return 1 if !defined $installed_key;

	# Compare the keys. Normalize the whitespace for the comparison.
	my $configured_normalized = $configured_key =~ s/\s+/ /gr;
	my $installed_normalized  = $installed_key  =~ s/\s+/ /gr;

	return $configured_normalized ne $installed_normalized;
}

# $self->_complete_ssh_setup():
#	Install or update the SSH key on the VM. The method
#	authenticates with the stored root password. It runs to recover
#	from a failed first boot, or when the configured SSH key
#	changed.
sub _complete_ssh_setup ($self)
{
	my $state  = $self->{state};
	my $config = $self->{config};
	my $log    = $self->{log};

	my $root_password = $state->get_root_password;
	if ( !defined $root_password ) {
		$log->error(
			"No root password stored - cannot complete SSH setup");
		return EXIT_ERROR;
	}

	$log->info("Updating SSH key...");

	# Wait for SSH with password authentication
	$log->info("Waiting for SSH...");
	if ( !$self->wait_ssh( 120, $root_password ) ) {
		$log->error("Timeout waiting for SSH");
		return EXIT_TIMEOUT;
	}

	# Install the SSH authorized key
	if ( !$self->_install_ssh_key($root_password) ) {
		$log->error("Failed to install SSH key");
		return EXIT_ERROR;
	}
	$log->info("SSH key installed");

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

# $self->_install_ssh_key($password):
#	Install the SSH public key from the configuration into
#	authorized_keys. The method uses password authentication,
#	because the key is not yet installed.
sub _install_ssh_key ( $self, $password )
{
	my $config = $self->{config};
	my $state  = $self->{state};
	my $log    = $self->{log};

	# Get the SSH public key from the configuration
	my $ssh_pubkey = $config->{ssh_pubkey};
	if ( !defined $ssh_pubkey || $ssh_pubkey eq '' ) {
		$log->error("No ssh_pubkey configured in ~/.fuguvmrc");
		return 0;
	}

	# Connect with the password
	my $ssh = Fugu::SSH->new(
		host     => '127.0.0.1',
		port     => $config->{ssh_port},
		user     => 'root',
		password => $password,
	);

	# 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 $config = $self->{config};
	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 => '127.0.0.1',
				port => $config->{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;
}