view release on metacpan or  search on metacpan

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

#!/usr/bin/env perl
# ex:ts=8 sw=4:

use v5.36;
use Test::More;
use FindBin qw($RealBin);
use lib "$RealBin/../../lib";
use Fugu::TestLog;
use File::Path qw(make_path);
use File::Temp qw(tempdir);

BEGIN {
	eval { require JSON::XS; 1 }
	    or plan skip_all => 'JSON::XS not available';
}

use_ok('App::FuguVM::DiskCache');

my $HAS_QEMU_IMG = defined qx{sh -c 'command -v qemu-img 2>/dev/null'}
    && $? == 0
    && qx{sh -c 'command -v qemu-img 2>/dev/null'} ne '';

my %CONFIG = (
	name         => 'default',
	arch         => 'arm64',
	version      => '7.8',
	disk_size    => '8G',
	memory       => 2048,
	ssh_port     => 2222,
	console_port => 4444,
);

# Construction and layout
{
	my $tmp   = tempdir( CLEANUP => 1 );
	my $cache = App::FuguVM::DiskCache->new($tmp);

	is( $cache->installed_dir, "$tmp/installed",
		'entries live under installed/ in the configured path' );
	is( $cache->entry_dir('k'), "$tmp/installed/k", 'entry_dir' );
	is( $cache->base_path('k'), "$tmp/installed/k/base.qcow2",
		'base_path' );
}

# Tilde expansion, like App::FuguVM::Miniroot
{
	local $ENV{HOME} = '/home/somebody';
	my $cache = App::FuguVM::DiskCache->new('~/.cache/fuguvm');
	is( $cache->installed_dir, '/home/somebody/.cache/fuguvm/installed',
		'leading ~ is expanded' );
}

# Key derivation: shape, stability, and what does and does not rotate it
{
	my $tmp   = tempdir( CLEANUP => 1 );
	my $cache = App::FuguVM::DiskCache->new($tmp);

	my $key = $cache->key( \%CONFIG );
	ok( defined $key, 'key derived from a VM configuration' );
	like( $key, qr/^7\.8-arm64-[0-9a-f]{8}$/,
		'key is <version>-<arch>-<hash8>' );

	is( $cache->key( \%CONFIG ), $key, 'key is stable across calls' );

	my %same = ( %CONFIG, memory => 8192, ssh_port => 3333 );
	is( $cache->key( \%same ), $key,
		'memory and ports do not shape the disk, so the key holds' );

	my %bound = ( %CONFIG, bind_address => '0.0.0.0' );
	is( $cache->key( \%bound ), $key,
		'bind_address does not shape the disk either' );

	my %bigger = ( %CONFIG, disk_size => '16G' );
	isnt( $cache->key( \%bigger ), $key, 'disk_size rotates the key' );

	my %older = ( %CONFIG, version => '7.7' );
	isnt( $cache->key( \%older ), $key, 'version rotates the key' );

	# The verify switch shapes the install: the installer reads it,
	# and the miniroot of the run was fetched under it.
	my %unproven = ( %CONFIG, verify => 0 );
	isnt( $cache->key( \%unproven ), $key, 'verify rotates the key' );
	is( $cache->key( { %CONFIG, verify => 1 } ),
		$key, 'and an explicit verify yes reads as the default' );
}

# The record of each install mode. A configuration without an
# install_mode reads as the expect mode, so a hand-built test
# configuration behaves like a loaded one.
{
	my $tmp   = tempdir( CLEANUP => 1 );
	my $cache = App::FuguVM::DiskCache->new($tmp);

	_spit( "$tmp/install.conf", "System hostname = image\n" );

	my $expect_key = $cache->key( \%CONFIG );
	is( $cache->key( { %CONFIG, install_mode => 'expect' } ),
		$expect_key, 'an absent install_mode reads as expect' );

	my %auto = (
		%CONFIG,
		install_mode => 'autoinstall',
		autoinstall  => "$tmp/install.conf",
	);
	my $auto_key = $cache->key( \%auto );
	ok( defined $auto_key, 'an autoinstall configuration derives a key' );
	isnt( $auto_key, $expect_key,
		'and its key differs from the equal expect key' );

	_spit( "$tmp/install.conf", "System hostname = other\n" );