App-FuguVM

 view release on metacpan or  search on metacpan

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

			# the file gets its mode before its content
			return Fugu::File->write_json( "$tmp/" . META_NAME,
				\%record, mode => 0600 ) ? 1 : 0;
		} );
	return if !defined $built;

	return "$target/" . BASE_NAME;
}

# $self->lock_entry($key, $timeout):
#	Return an open, exclusively locked handle on the lock file of
#	$key. The caller holds the lock until the handle closes or the
#	process exits, so a stale lock file blocks nothing. Return
#	undef when the deadline elapses, and undef when the file cannot
#	open.
#
#	The lock serializes the first population of one entry across
#	every project that shares the cache directory. It does not
#	replace the write-once rule of store: a run that lost the lock
#	to the deadline still cannot publish a second entry.
#

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

	return if !defined $key;

	Fugu::File->ensure_dir( $self->installed_dir ) or return;

	my $path = $self->installed_dir . '/' . LOCK_PREFIX . $key;
	open my $fh, '>>', $path or do {
		Fugu::Log->default->warning( 'Cannot open %s: %s', $path, $! );
		return;
	};

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

	close $fh;
	return;
}

# $self->list:
#	Return every complete entry, newest first, as
#	{ key, dir, base, size, created_at, meta, snapshots }
sub list ($self)
{

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

	# 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;
}

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

		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

t/fuguvm/disk.t  view on Meta::CPAN

# A running QEMU holds an exclusive lock on its disk. Thus inspection
# must ask for shared access. Without it, info() fails on exactly the
# VMs whose chain callers most need. 'cache clear' then sees no backing
# file for a running VM and removes the base while the VM uses it.
SKIP: {
    my $has_qemu_io = `which qemu-io 2>/dev/null`;
    skip 'qemu-io not installed', 4 unless $has_qemu_io;

    my $tmpdir = tempdir(CLEANUP => 1);
    my $disk = App::FuguVM::Disk->new($tmpdir);
    my $path = $disk->create('locked', '64M');
    my $parent = $disk->create('parent', '64M');

    my $overlay_dir = tempdir(CLEANUP => 1);
    my $overlay = App::FuguVM::Disk->new($overlay_dir);
    $overlay->create('kid', undef, $parent);

    # qemu-io holds the image, and its lock, while its stdin is open.
    my $spawned = open(my $io, '|-', "qemu-io '$path' >/dev/null 2>&1");
    my $spawned_kid =
	open(my $io2, '|-', "qemu-io '@{[$overlay->path('kid')]}' >/dev/null 2>&1");
    skip 'cannot spawn qemu-io', 4 unless $spawned && $spawned_kid;

    # Wait for the lock and prove that qemu-io really holds it. An
    # unshared query that fails here is the condition that used to
    # break the callers.
    my $locked = 0;
    for (1 .. 100) {
	`qemu-img info --output=json '$path' 2>&1`;
	if ($? != 0) { $locked = 1; last; }
	select(undef, undef, undef, 0.1);
    }
    ok($locked, 'qemu-io holds an exclusive lock on the image');

    my $info = $disk->info('locked');
    ok(defined $info, 'info still reads a locked image');
    is($info->{'virtual-size'}, 64 * 1024 * 1024,
	'and reports its size correctly');
    is($overlay->backing_file('kid'), $parent,
	'backing_file resolves the chain of a locked overlay');

    close $io;
    close $io2;
}

done_testing();

t/fuguvm/guest.t  view on Meta::CPAN

		    cache_dir => "$root/cache" },
		state => $dead_state,
		log   => TestLog->new,
	);
	is($dead->_resolve_ports, App::FuguVM::Guest::EXIT_ERROR(),
	    'an exhausted range gives EXIT_ERROR');
	like(join("\n", @{ $dead->{log}{errors} }), qr/2222-2321/,
	    'and the message names the range');

	# The port lock is exclusive across processes
	my $locked = $fleet->_lock_ports;
	ok(defined $locked, '_lock_ports returns a handle');
	is(_flock_in_child("$root/cache/ports.lock"), 0,
	    'a child cannot take the held lock');
	close $locked;
	is(_flock_in_child("$root/cache/ports.lock"), 1,
	    'the lock is free once the handle closes');
}

# The accelerator answer: the record wins for a running guest, and
# the current selection serves a stopped one
{
	require App::FuguVM::State;

	my $root = tempdir(CLEANUP => 1);