App-FuguVM

 view release on metacpan or  search on metacpan

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

    open my $gh, '>', "$homedir/.fuguvmrc" or die $!;
    print $gh "distfile_cache 1K\n";
    print $gh "verify yes\n";
    print $gh "signify_dir /global/keys\n";
    close $gh;

    my $config = $write->("distfile_cache 2K\n"
	. "verify no\n"
	. "signify_dir /project/keys\n");
    is($config->distfile_cache, 2048,
	'the project distfile_cache wins over the global one');
    is($config->verify, 0, 'the project verify wins over the global one');
    is($config->signify_dir, '/project/keys',
	'the project signify_dir wins over the global one');

    # The global file serves without a project value
    $config = $write->("cache_dir /tmp\n");
    is($config->distfile_cache, 1024, 'the global distfile_cache serves');
    is($config->verify, 1, 'the global verify serves');
    is($config->signify_dir, '/global/keys', 'the global signify_dir serves');
}

# The verify directive: the default is on, and it reads the yes/no
# spellings like image_cache
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    local $ENV{HOME} = $homedir;
    make_path("$tmpdir/.fuguvm/vms");

    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "vm test {\n}\n";
    close $fh;
    my $config = App::FuguVM::Config->new($tmpdir);
    is($config->verify, 1, 'verify defaults to 1');
    is($config->load_vm('test')->{verify}, 1,
	'and the default reaches the VM hash');

    open $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "verify no\n";
    print $fh "vm test {\n}\n";
    close $fh;
    $config = App::FuguVM::Config->new($tmpdir);
    is($config->verify, 0, 'verify no reads as 0');
    is($config->load_vm('test')->{verify}, 0, 'and reaches the VM hash');
}

# The signify_dir directive: the tilde, the project-relative path,
# the VM hash, and the refusal of a value that is not a directory
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    local $ENV{HOME} = $homedir;
    make_path("$tmpdir/.fuguvm/vms", "$tmpdir/keys", "$homedir/keys");

    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "signify_dir ~/keys\n";
    print $fh "vm test {\n}\n";
    close $fh;
    my $config = App::FuguVM::Config->new($tmpdir);
    is($config->signify_dir, "$homedir/keys", 'signify_dir expands a tilde');
    is($config->load_vm('test')->{signify_dir}, "$homedir/keys",
	'and load_vm carries it into the VM hash');

    open $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "signify_dir keys\n";
    print $fh "vm test {\n}\n";
    close $fh;
    $config = App::FuguVM::Config->new($tmpdir);
    like($config->signify_dir, qr{\Q/keys\E$},
	'a relative path resolves against the project root');
    like($config->signify_dir, qr{^/}, 'and the result is absolute');

    # A value that is not a directory is a refusal at the boundary
    open $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "vm test {\n";
    print $fh "    signify_dir absent-keys\n";
    print $fh "}\n";
    close $fh;
    $config = App::FuguVM::Config->new($tmpdir);
    is($config->load_vm('test'), undef,
	'an absent signify_dir makes load_vm return undef');
    like($config->error, qr/absent-keys/, 'and error names the path');

    # The distfile cap is a project fact, and load_vm injects it
    open $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "distfile_cache 4G\n";
    print $fh "vm test {\n}\n";
    close $fh;
    $config = App::FuguVM::Config->new($tmpdir);
    is($config->load_vm('test')->{distfile_cache}, 4 * 1024**3,
	'load_vm injects the distfile cap of the project');

    # A cap in a VM block does not apply, and the operator hears
    # about it
    open $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "distfile_cache 4G\n";
    print $fh "vm test {\n";
    print $fh "    distfile_cache 8G\n";
    print $fh "}\n";
    close $fh;
    my $warning = '';
    my $loaded;
    {
	local *STDERR;
	open STDERR, '>', \$warning or die "capture stderr: $!";
	$loaded = App::FuguVM::Config->new($tmpdir)->load_vm('test');
    }
    is($loaded->{distfile_cache}, 4 * 1024**3,
	'the project cap wins over a cap in a VM block');
    like($warning, qr/distfile_cache/,
	'and the loader warns about the block value');
}

# The parser normalizes image_cache inside a vm block like the global
# directive
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    local $ENV{HOME} = $homedir;
    make_path("$tmpdir/.fuguvm/vms");

    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "image_cache yes\n";
    print $fh "vm test {\n";
    print $fh "    image_cache no\n";
    print $fh "}\n";
    close $fh;

    my $vm = App::FuguVM::Config->new($tmpdir)->load_vm('test');
    is($vm->{image_cache}, 0,
	'a VM block switches its own image cache off, as a number');
}

# A VM without any cache_dir configured still gets the default
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    local $ENV{HOME} = $homedir;
    make_path("$tmpdir/.fuguvm/vms");

    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "vm test {\n}\n";
    close $fh;

    my $config = App::FuguVM::Config->new($tmpdir);
    my $vm = $config->load_vm('test');

    is($vm->{cache_dir}, "$homedir/.cache/fuguvm",
	'default cache_dir is injected and tilde-expanded');
}

# Test ssh_pubkey from project config
{
    my $tmpdir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    # Create a config with ssh_pubkey at the project root
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "ssh_pubkey ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAI test\@example\n";
    close $fh;
    
    my $config = App::FuguVM::Config->new($tmpdir);
    like($config->ssh_pubkey, qr/^ssh-ed25519/, 'ssh_pubkey parsed from project config');
}

# Test ssh_pubkey from global config fallback
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    # No ssh_pubkey in project config
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "default_vm test\n";
    close $fh;
    
    # Create a global config with ssh_pubkey
    open my $gh, '>', "$homedir/.fuguvmrc";
    print $gh "ssh_pubkey ssh-rsa AAAAB3NzaC1 global\@test\n";
    close $gh;
    
    local $ENV{HOME} = $homedir;
    my $config = App::FuguVM::Config->new($tmpdir);
    like($config->ssh_pubkey, qr/^ssh-rsa/, 'ssh_pubkey falls back to global config');
}

# Test ssh_pubkey included in VM config
{
    my $tmpdir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "ssh_pubkey ssh-ed25519 TESTKEY test\@vm\n";
    print $fh "\n";
    print $fh "vm \"test\" {\n";
    print $fh "    memory 2048\n";
    print $fh "}\n";
    close $fh;
    
    my $config = App::FuguVM::Config->new($tmpdir);
    my $vm = $config->load_vm('test');
    is($vm->{ssh_pubkey}, 'ssh-ed25519 TESTKEY test@vm', 'ssh_pubkey included in VM config');
}

# Test project config overrides global config
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");

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

    print $fh "# This is a comment\n";
    print $fh "   \n";
    print $fh "default_vm test  # inline comment\n";
    print $fh "  cache_dir   /path/with/spaces   \n";
    close $fh;
    
    my $config = App::FuguVM::Config->new($tmpdir);
    is($config->default_vm, 'test', 'inline comments stripped');
    is($config->cache_dir, '/path/with/spaces', 'whitespace trimmed');
}

# Test data_dir accessor
{
    my $tmpdir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    close $fh;
    
    my $config = App::FuguVM::Config->new($tmpdir);
    is($config->{data_dir}, "$tmpdir/.fuguvm", 'data_dir set correctly');
}

# Test state_dir default
{
    my $tmpdir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    close $fh;
    
    my $config = App::FuguVM::Config->new($tmpdir);
    is($config->state_dir, "$tmpdir/.fuguvm/state", 'state_dir defaults to .fuguvm/state');
}

# Test state_dir from config
{
    my $tmpdir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "state_dir /custom/state\n";
    close $fh;
    
    my $config = App::FuguVM::Config->new($tmpdir);
    is($config->state_dir, '/custom/state', 'state_dir from config');
}

# Test cache_dir tilde expansion
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "cache_dir ~/cache/fuguvm\n";
    close $fh;
    
    local $ENV{HOME} = $homedir;
    my $config = App::FuguVM::Config->new($tmpdir);
    is($config->cache_dir, "$homedir/cache/fuguvm", 'cache_dir expands tilde');
}

# Test VM block in global config
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    # VM defined in global config
    open my $gh, '>', "$homedir/.fuguvmrc";
    print $gh "vm \"shared\" {\n";
    print $gh "    memory 1024\n";
    print $gh "    version 7.8\n";
    print $gh "}\n";
    close $gh;
    
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    close $fh;
    
    local $ENV{HOME} = $homedir;
    my $config = App::FuguVM::Config->new($tmpdir);
    my $vm = $config->load_vm('shared');
    
    ok(defined $vm, 'VM loaded from global config');
    is($vm->{memory}, 1024, 'VM memory from global config');
}

# Test project VM overrides global VM
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    make_path("$tmpdir/.fuguvm/vms");
    
    # VM in global config
    open my $gh, '>', "$homedir/.fuguvmrc";
    print $gh "vm \"test\" {\n";
    print $gh "    memory 1024\n";
    print $gh "}\n";
    close $gh;
    
    # Same VM name in project config with different settings
    open my $fh, '>', "$tmpdir/.fuguvmrc";
    print $fh "vm \"test\" {\n";
    print $fh "    memory 4096\n";
    print $fh "}\n";
    close $fh;
    
    local $ENV{HOME} = $homedir;
    my $config = App::FuguVM::Config->new($tmpdir);
    my $vm = $config->load_vm('test');
    
    is($vm->{memory}, 4096, 'project VM config overrides global');
}

# The bind_address directive: the merge, the fallback chain, the
# default, and the validation at the configuration boundary
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    local $ENV{HOME} = $homedir;

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

    ok($ports->{2300} && $ports->{4500},
	'declared_ports holds the fixed ports of a project block');
    ok($ports->{2400} && $ports->{4600},
	'and the fixed ports of a global block');
    ok($ports->{2222} && $ports->{4444},
	'a declaration that omits a directive holds the default port');
    ok($ports->{2500}, 'a vms/ file counts too');
    ok(!$ports->{auto}, 'the word auto is not a port');

    is_deeply($config->load_vm('fleet')->{declared_ports}, $ports,
	'load_vm folds the set into the per-VM configuration');
}

# The three image-lifecycle directives: the resolution, the derived
# install_mode, and each refusal at the configuration boundary
{
    my $tmpdir = tempdir(CLEANUP => 1);
    my $homedir = tempdir(CLEANUP => 1);
    local $ENV{HOME} = $homedir;
    make_path("$tmpdir/.fuguvm/vms");

    # The files that the directives point at
    for my $seed (["$tmpdir/install.conf", "System hostname = image\n"],
	["$tmpdir/base.qcow2", 'not a real image'],
	["$homedir/password", "secret\n"]) {
	open my $fh, '>', $seed->[0] or die $!;
	print $fh $seed->[1];
	close $fh;
    }

    my $write = sub ($body) {
	open my $fh, '>', "$tmpdir/.fuguvmrc" or die $!;
	print $fh $body;
	close $fh;
	return App::FuguVM::Config->new($tmpdir);
    };

    # install_mode derives from the directives; there is no
    # install_mode directive
    my $config = $write->("vm \"plain\" {\n}\n");
    is($config->load_vm('plain')->{install_mode}, 'expect',
	'no directive derives the expect mode');

    $config = $write->("vm \"auto\" {\n    autoinstall install.conf\n}\n");
    my $vm = $config->load_vm('auto');
    is($vm->{install_mode}, 'autoinstall',
	'autoinstall derives the autoinstall mode');
    is($vm->{autoinstall}, "$tmpdir/install.conf",
	'a relative path resolves against the project root');

    $config = $write->("vm \"import\" {\n    base_disk base.qcow2\n}\n");
    $vm = $config->load_vm('import');
    is($vm->{install_mode}, 'import', 'base_disk derives the import mode');
    is($vm->{base_disk}, "$tmpdir/base.qcow2",
	'and its path resolves the same way');

    $config = $write->(
	"vm \"tilde\" {\n    root_password_file ~/password\n}\n");
    is($config->load_vm('tilde')->{root_password_file},
	"$homedir/password", 'a leading tilde expands');

    # An absent file is a refusal that names the resolved path
    $config = $write->("vm \"gone\" {\n    autoinstall absent.conf\n}\n");
    is($config->load_vm('gone'), undef,
	'an absent autoinstall file makes load_vm return undef');
    like($config->error, qr{\Q$tmpdir/absent.conf\E},
	'and error names the resolved path');

    $config = $write->("vm \"gone\" {\n    base_disk absent.qcow2\n}\n");
    is($config->load_vm('gone'), undef,
	'an absent base_disk file behaves the same way');
    like($config->error, qr{\Q$tmpdir/absent.qcow2\E},
	'and error names the resolved path');

    # Two origins contradict each other
    $config = $write->("vm \"both\" {\n"
	. "    autoinstall install.conf\n"
	. "    base_disk base.qcow2\n"
	. "}\n");
    is($config->load_vm('both'), undef,
	'autoinstall with base_disk makes load_vm return undef');
    like($config->error, qr/autoinstall/, 'error names one directive');
    like($config->error, qr/base_disk/, 'and the other');

    # An imported base lives in the cache, so the cache must be on
    $config = $write->("vm \"import\" {\n"
	. "    base_disk base.qcow2\n"
	. "    image_cache no\n"
	. "}\n");
    is($config->load_vm('import'), undef,
	'base_disk with image_cache no makes load_vm return undef');
    like($config->error, qr/image cache/, 'and error names the cause');

    # ssh_pubkey without root_password_file refuses outside the
    # expect mode, because the tool cannot authenticate
    for my $origin ('autoinstall install.conf', 'base_disk base.qcow2') {
	$config = $write->("ssh_pubkey ssh-ed25519 KEY test\@host\n"
	    . "vm \"keyed\" {\n    $origin\n}\n");
	is($config->load_vm('keyed'), undef,
	    "ssh_pubkey with no root_password_file refuses ($origin)");
	like($config->error, qr/root_password_file/,
	    'and error names one remedy');
	like($config->error, qr/ssh_pubkey/, 'and the other');
    }

    $config = $write->("ssh_pubkey ssh-ed25519 KEY test\@host\n"
	. "vm \"keyed\" {\n"
	. "    autoinstall install.conf\n"
	. "    root_password_file ~/password\n"
	. "}\n");
    ok(defined $config->load_vm('keyed'),
	'root_password_file satisfies the refusal');

    $config = $write->("ssh_pubkey ssh-ed25519 KEY test\@host\n"
	. "vm \"keyed\" {\n}\n");
    ok(defined $config->load_vm('keyed'),
	'the expect mode needs no password file');
    is($config->error, undef, 'and error returns undef after it');
}