App-FuguVM

 view release on metacpan or  search on metacpan

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

}

# $self->_resolve_path($value):
#	Expand a leading tilde, then make a relative path absolute
#	against the project root. The result is always absolute: the
#	project root itself can be relative, from a --project option,
#	and a daemonized child can read the path from an other working
#	directory.
sub _resolve_path ( $self, $value )
{
	my $path = Fugu::File->expand_tilde($value);
	$path = "$self->{project_root}/$path" if $path !~ m{^/};

	require File::Spec;
	return File::Spec->rel2abs($path);
}

# $self->error:
#	Return the reason of the last failed load_vm, or undef.
sub error ($self)
{

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

		return 0 if $part > 255;
	}

	return 1;
}

sub cache_dir ($self)
{
	my $dir = $self->_setting('cache_dir') // '~/.cache/fuguvm';

	return Fugu::File->expand_tilde($dir);
}

# $self->image_cache:
#	Return whether 'fuguvm up' may use the installed-image cache.
#	The project configuration wins over the global one. The default
#	is on.
sub image_cache ($self)
{
	my $value = $self->_setting('image_cache');
	return 1 if !defined $value;

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

sub verify ($self)
{
	my $value = $self->_setting('verify');
	return 1 if !defined $value;

	return $self->_bool( $value, 1 );
}

# $self->signify_dir:
#	Return the resolved directory of the signify public keys, or
#	undef without the directive. A leading tilde expands, and a
#	relative path resolves against the project root.
sub signify_dir ($self)
{
	my $dir = $self->_setting('signify_dir');
	return if !defined $dir;

	return $self->_resolve_path($dir);
}

# $self->distfile_cache:

lib/App/FuguVM/Config.pod  view on Meta::CPAN

field, and no module compares the directives again.

    neither directive     expect       install with install.exp
    autoinstall <file>    autoinstall  install from the response file
    base_disk <path>      import       overlay an existing image

C<autoinstall> names an autoinstall(8) response file. C<base_disk>
names an existing full-disk image; C<qemu-img> reads a qcow2 file and
a raw file. C<root_password_file> names a file whose first line is
the root password of the image. Each of the three values is a path: a
leading tilde expands, and a relative path resolves against the
project root. The loader validates each path one time, and the file
must be readable.

The loader refuses these configurations, and C<error> names the
cause:

=over 4

=item * An absent or unreadable C<autoinstall>, C<base_disk> or
C<root_password_file> file. The message names the resolved path.

lib/App/FuguVM/Config.pod  view on Meta::CPAN

C<ssh_pubkey> and bake the key into the image.

=back

=head2 error

Return the reason of the last failed C<load_vm>, or C<undef>.

=head2 cache_dir, state_dir, default_vm, ssh_pubkey, bind_address, qemu_version

The top-level settings. C<cache_dir> expands a leading tilde;
C<state_dir> resolves a relative path against the project root.
C<bind_address> returns the setting of the enclosing files, or
C<127.0.0.1>. C<qemu_version> returns the setting, or C<undef>.

=head2 verify

Return 1 or 0. The directive switches the mirror verification of
L<App::FuguVM::Mirror>, and the default is 1. A value that is neither
yes nor no gives a warning and the default, like C<image_cache>.

=head2 signify_dir

Return the resolved directory of the signify public keys, or C<undef>
without the directive. The value expands a leading tilde, and a
relative path resolves against the project root.

=head2 distfile_cache

Return the distfile cap in bytes. The value of the directive is a
size: a bare number of bytes, or a number with a C<K>, C<M> or C<G>
suffix. The suffix is 1024-based, and the letter case does not
matter. The default is 0, and 0 turns the distfile cache off. An
unparsable value gives one warning and the value 0: an unrecognized
spelling must not silently mean its opposite, and off is the closed

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

	GENERATION_FILE    => 'cache-generation',
	INSTALL_SCRIPT     => 'install.exp',
	AUTOINSTALL_SCRIPT => 'autoinstall.exp',
	KEY_HASH_LENGTH    => 8,
	MAX_SNAPSHOT_NAME  => 128,
};

sub new ( $class, $cache_dir )
{
	my $self =
	    bless { cache_dir => Fugu::File->expand_tilde($cache_dir), },
	    $class;

	return $self;
}

# $self->installed_dir:
#	Return the directory that holds every cached entry.
sub installed_dir ($self)
{
	return "$self->{cache_dir}/" . INSTALLED_DIR;

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


The working disk must come from a stopped VM. A live overlay is not
consistent.

=head1 METHODS

=over 4

=item new($cache_dir)

The constructor creates a cache over C<$cache_dir>. It expands a
C<~> at the start of the path.

=item installed_dir

=item entry_dir($key)

=item base_path($key)

These methods return locations. The paths do not have to exist.

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


# $class->new($cache_dir, $proxy, $mirror):
#	The proxy can be undef. The mirror is required: it carries the
#	version, the architecture and the verification switch.
sub new ( $class, $cache_dir, $proxy, $mirror )
{
	die "App::FuguVM::Miniroot needs a mirror\n"
	    if !defined $mirror;

	my $self = bless {
		cache_dir => Fugu::File->expand_tilde($cache_dir),
		proxy     => $proxy,
		mirror    => $mirror,
	}, $class;

	return $self;
}

# $self->path:
#	Return the path to the cached miniroot image of the mirror
#	version. Return undef if the image is not cached.

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

	}, $class;

	return $self;
}

# $class_or_self->quote_argv(@argv):
#	Return one remote command string. Each word gets single
#	quotes, and a single quote inside a word becomes the '\''
#	form. An empty word becomes ''. The words join with one
#	space. So the remote shell splits the string at the word
#	boundaries only: it expands nothing, and it globs nothing.
sub quote_argv ( $, @argv )
{
	my @words;
	for my $word (@argv) {
		my $quoted = $word;
		$quoted =~ s/'/'\\''/g;
		push @words, "'$quoted'";
	}

	return join ' ', @words;

lib/App/FuguVM/Remote.pod  view on Meta::CPAN

gives no host, and it dies when the caller gives no port.

=head2 quote_argv

    App::FuguVM::Remote->quote_argv(@argv)

Return one remote command string. A class method. The method wraps
each word in single quotes, and it replaces each single quote inside
a word with the C<'\''> form. An empty word becomes C<''>. The words
join with one space. So the remote shell splits the string at the
word boundaries only: it expands nothing, and it globs nothing.

=head2 run

    $remote->run(@argv)

Run one argument vector on the guest. The method returns the hash of
C<< Fugu::SSH->run_command >>: C<stdout>, C<stderr> and C<exit_code>.
It dies on an empty vector. A connect failure reads as exit code 1,
with the reason in C<stderr>.

man/fuguvm/fuguvm.1  view on Meta::CPAN

or in the global
.Pa ~/.fuguvmrc ,
with that precedence.
.Pp
.Ar signify_dir
names the directory of the signify public keys,
before
.Pa /etc/signify/
and the shipped keys.
The value is a path:
a leading tilde expands,
and a relative path resolves against the project root.
A value that is not a directory is a configuration error.
.Pp
.Ar distfile_cache
sets the size cap of the distfile tree,
as a byte count or a number with a
.Cm K ,
.Cm M
or
.Cm G

man/fuguvm/fuguvm.1  view on Meta::CPAN

names an
.Xr autoinstall 8
response file,
.Ar base_disk
names an existing full-disk image
.Pq qcow2 or raw ,
and
.Ar root_password_file
names a file whose first line is the root password of the image.
Each value is a path:
a leading tilde expands,
and a relative path resolves against the project root.
The file must be readable when the configuration loads.
The response file is an artifact of the operator,
and
.Nm
validates no answer in it:
.Xr autoinstall 8
owns that grammar.
Outside the default install,
.Ar ssh_pubkey

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

    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');

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

    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";

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

    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";

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


    $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,

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

	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}$/,



( run in 0.896 second using v1.01-cache-2.11-cpan-a49fcb8fa48 )