Unverified Commit 3535855f authored by Francesc Guasch's avatar Francesc Guasch Committed by GitHub
Browse files

Feature/841 storage (#845)

* feat(fallback): add fallback JS & CSS

Issue [#806]

* feat(fallback): fix check option

Issue [#806]

* fix(package): create debian package with fallback files

issue #806

* fix(fallback): read parameter

issue [#806]

* ignore fallback fails on source

issue #806

* test(download): do not download iso and checks

issue #838

* test(storage): check base and clone pools

issue #841

* refactor(backend): create domain check args

issue #841

* feature(storage): base and clone storage fields

issue #841
parent 4c1cafc7
......@@ -222,7 +222,7 @@ sub _update_isos {
,url => 'http://dl-cdn.alpinelinux.org/alpine/v3.7/releases/x86_64/'
,file_re => 'alpine-virt-3.7.\d+-x86_64.iso'
,sha256_url => 'http://dl-cdn.alpinelinux.org/alpine/v3.7/releases/x86_64/alpine-virt-3.7.0-x86_64.iso.sha256'
,min_disk_size => '10'
,min_disk_size => '1'
}
,artful => {
name => 'Ubuntu Artful Aardvark'
......@@ -1027,6 +1027,8 @@ sub _upgrade_tables {
$self->_upgrade_table('vms','min_free_memory',"text DEFAULT NULL");
$self->_upgrade_table('vms', 'max_load', 'int not null default 10');
$self->_upgrade_table('vms', 'active_limit','int DEFAULT NULL');
$self->_upgrade_table('vms', 'base_storage','varchar(64) DEFAULT NULL');
$self->_upgrade_table('vms', 'clone_storage','varchar(64) DEFAULT NULL');
$self->_upgrade_table('requests','at_time','int(11) DEFAULT NULL');
$self->_upgrade_table('requests','run_time','float DEFAULT NULL');
......@@ -1296,55 +1298,62 @@ sub create_domain {
my %args = @_;
croak "Argument id_owner required "
if !$args{id_owner};
my $start = $args{start};
my $vm_name = $args{vm};
delete $args{vm};
my $request = ( $args{request} or undef);
my $id_base = $args{id_base};
my $request = $args{request};
my $id_owner = $args{id_owner};
my $vm;
if ($request) {
%args = %{$request->args};
$vm_name = $request->defined_arg('vm') if $request->defined_arg('vm');
}
if ($vm_name) {
$vm = $self->search_vm($vm_name);
confess "ERROR: vm $vm_name not found" if !$vm;
}
if ($args{id_base}) {
my $base = Ravada::Domain->open($args{id_base});
if ($id_base) {
my $base = Ravada::Domain->open($id_base)
or confess "Unknown base id: $id_base";
$vm = Ravada::VM->open($base->_vm->id);
}
confess "No vm found" if !$vm;
confess "No vm found, request = ".Dumper(request => $request) if !$vm;
carp "WARNING: no VM defined, we will use ".$vm->name
if !$vm_name && !$args{id_base};
if !$vm_name && !$id_base;
confess "I can't find any vm ".Dumper($self->vm) if !$vm;
my $domain;
$request->status("creating") if $request;
eval { $domain = $vm->create_domain(@_) };
my $domain;
eval { $domain = $vm->create_domain(%args)};
my $error = $@;
if ( $request ) {
$request->error($error) if $error;
if ($error =~ /has \d+ requests/) {
$request->status('retry');
}
if (!$error && $request->defined_arg('start')) {
$request->status("starting");
eval {
my $user = Ravada::Auth::SQL->search_by_id($request->args('id_owner'));
$domain->start(
user => $user
,remote_ip => $request->defined_arg('remote_ip')
,request => $request
)
};
my $error = $@;
$request->error($error) if $error;
}
} elsif ($@) {
die $@;
} elsif ($error) {
die $error;
}
if (!$error && $start) {
$request->status("starting") if $request;
eval {
my $user = Ravada::Auth::SQL->search_by_id($id_owner);
my $remote_ip;
$remote_ip = $request->defined_arg('remote_ip') if $request;
$domain->start(
user => $user
,remote_ip => $remote_ip
,request => $request
)
};
my $error = $@;
die $error if $error && !$request;
$request->error($error) if $error;
}
return $domain;
}
......@@ -1361,18 +1370,31 @@ sub remove_domain {
my $self = shift;
my %arg = @_;
confess "Argument name required "
if !$arg{name};
my $name = delete $arg{name} or confess "Argument name required ";
confess "Argument uid required "
if !$arg{uid};
lock_hash(%arg);
my $domain = $self->search_domain($arg{name}, 1)
or die "ERROR: I can't find domain '$arg{name}', maybe already removed.";
my $sth = $CONNECTOR->dbh->prepare("SELECT id FROM domains WHERE name = ?");
$sth->execute($name);
my ($id)= $sth->fetchrow;
confess "Error: Unknown domain $name" if !$id;
my $user = Ravada::Auth::SQL->search_by_id( $arg{uid});
die "Error: user ".$user->name." can't remove domain $id"
if !$user->can_remove_machine($id);
my $domain = Ravada::Domain->open(id => $id, _force => 1)
or do {
warn "Warning: I can't find domain '$id', maybe already removed.";
$sth = $CONNECTOR->dbh->prepare("DELETE FROM domains where id=?");
$sth->execute($id);
return;
};
$domain->remove( $user);
}
......@@ -1972,7 +1994,7 @@ sub _cmd_create{
warn "$$ creating domain" if $DEBUG;
my $domain;
$domain = $self->create_domain(%{$request->args},request => $request);
$domain = $self->create_domain(request => $request);
my $msg = '';
......
......@@ -351,14 +351,17 @@ sub _create_qcow_base {
my @base_img;
my $base_name = $self->name;
my $base_dir = $self->_vm->_storage_path($self->_vm->storage_pool);
for my $vol_data ( $self->list_volumes_target()) {
my ($file_img,$target) = @$vol_data;
my $base_img = $file_img;
my $pool_base = $self->_vm->default_storage_pool_name;
$pool_base = $self->_vm->base_storage_pool() if $self->_vm->base_storage_pool();
my $dir_base = $self->_vm->_storage_path($pool_base);
my @cmd;
$base_img =~ s{(.*)/(.*)\.\w+$}{$base_dir/$2\.ro.qcow2};
$base_img =~ s{(.*)/(.*)\.\w+$}{$dir_base/$2\.ro.qcow2};
die "ERROR: base image already exists '$base_img'" if -e $base_img;
......
......@@ -365,7 +365,7 @@ sub _check_require_base {
delete $args{start};
delete $args{remote_ip};
delete @args{'_vm','name','vm', 'memory','description'};
delete @args{'_vm','name','vm', 'memory','description','id_iso'};
confess "ERROR: Unknown arguments ".join(",",keys %args)
if keys %args;
......@@ -483,6 +483,56 @@ sub default_storage_pool_name {
return $self->_data('default_storage');
}
=head2 base_storage_pool
Set the storage pool for bases in this Virtual Machine Manager
$vm->base_storage_pool('pool2');
=cut
sub base_storage_pool {
my $self = shift;
my $value = shift;
#TODO check pool exists
if (defined $value) {
my $id = $self->id();
my $sth = $$CONNECTOR->dbh->prepare(
"UPDATE vms SET base_storage=?"
." WHERE id=?"
);
$sth->execute($value,$id);
$self->{_data}->{base_storage} = $value;
}
return $self->_data('base_storage');
}
=head2 clone_storage_pool
Set the storage pool for clones in this Virtual Machine Manager
$vm->clone_storage_pool('pool3');
=cut
sub clone_storage_pool {
my $self = shift;
my $value = shift;
#TODO check pool exists
if (defined $value) {
my $id = $self->id();
my $sth = $$CONNECTOR->dbh->prepare(
"UPDATE vms SET clone_storage=?"
." WHERE id=?"
);
$sth->execute($value,$id);
$self->{_data}->{clone_storage} = $value;
}
return $self->_data('clone_storage');
}
=head2 min_free_memory
Returns the minimun free memory necessary to start a new virtual machine
......
......@@ -741,6 +741,8 @@ sub _create_disk_qcow2 {
confess "Missing name" if !$name;
my $dir_img = $self->dir_img;
my $clone_pool = $self->clone_storage_pool();
$dir_img = $self->_storage_path($clone_pool) if $clone_pool;
my @files_out;
......
......@@ -10,6 +10,9 @@ use Test::SQL::Data;
use lib 't/lib';
use Test::Ravada;
no warnings "experimental::signatures";
use feature qw(signatures);
my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
use_ok('Ravada');
......@@ -193,6 +196,177 @@ sub test_default_pool {
is($vm->default_storage_pool_name, $pool_name);
}
sub test_base_pool {
my $vm = shift;
my $pool_name = shift;
my %pool = (
default => '/var/lib/libvirt'
,$pool_name => $vm->_storage_path($pool_name)
);
for my $name1 (keys %pool ) {
my $dir_pool1 = $pool{$name1};
$vm->default_storage_pool_name($name1);
my $domain = create_domain($vm->type);
$domain->add_volume_swap( size => 1000000 );
ok($domain);
for my $volume ($domain->list_volumes ) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool1});
}
for my $name2 ( $pool_name, 'default' ) {
my $dir_pool2 = $pool{$name2};
$vm->base_storage_pool($name2);
is($vm->base_storage_pool(),$name2);
$domain->prepare_base(user_admin);
ok(scalar ($domain->list_files_base));
for my $volume ($domain->list_files_base) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool2});
}
my $clone = $domain->clone(
name => new_domain_name()
,user => user_admin
);
ok(scalar ($clone->list_volumes));
for my $volume ($clone->list_volumes) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool1});
}
$clone->remove(user_admin);
$domain->remove_base(user_admin);
is($domain->is_base,0);
}
$domain->remove(user_admin);
}
}
sub test_clone_pool {
my $vm = shift;
my $pool_name = shift;
$vm->base_storage_pool('');
my %pool = (
default => '/var/lib/libvirt'
,$pool_name => $vm->_storage_path($pool_name)
);
for my $name1 (keys %pool ) {
my $dir_pool1 = $pool{$name1};
$vm->default_storage_pool_name($name1);
my $domain = create_domain($vm->type);
$domain->add_volume_swap( size => 1000000 );
ok($domain);
for my $volume ($domain->list_volumes ) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool1});
}
for my $name2 ( $pool_name, 'default' ) {
my $dir_pool2 = $pool{$name2};
$vm->clone_storage_pool($name2);
is($vm->clone_storage_pool(),$name2);
$domain->prepare_base(user_admin);
ok(scalar ($domain->list_files_base));
for my $volume ($domain->list_files_base) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool1});
}
my $clone = $domain->clone(
name => new_domain_name()
,user => user_admin
);
ok(scalar ($clone->list_volumes));
for my $volume ($clone->list_volumes) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool2});
}
$clone->remove(user_admin);
$domain->remove_base(user_admin);
is($domain->is_base,0);
}
$domain->remove(user_admin);
}
}
sub test_base_clone_pool {
my $vm = shift;
my $pool_name1 = shift;
my $pool_name2 = shift;
$vm->base_storage_pool('');
my %pool = (
default => '/var/lib/libvirt'
,$pool_name1 => $vm->_storage_path($pool_name1)
,$pool_name2 => $vm->_storage_path($pool_name2)
);
# default pool
for my $name (keys %pool ) {
my $dir_pool = $pool{$name};
$vm->default_storage_pool_name($name);
my $domain = create_domain($vm->type);
$domain->add_volume_swap( size => 1000000 );
ok($domain);
for my $volume ($domain->list_volumes ) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool});
}
test_base_pool_2($vm, \%pool, $domain);
$domain->remove(user_admin);
}
}
sub test_base_pool_2($vm, $pool, $domain) {
for my $name ( keys %$pool) {
my $dir_pool = $pool->{$name};
$vm->base_storage_pool($name);
is($vm->base_storage_pool(),$name);
$domain->prepare_base(user_admin);
ok(scalar ($domain->list_files_base));
for my $volume ($domain->list_files_base) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool});
}
test_clone_pool_2($vm, $pool, $domain);
$domain->remove_base(user_admin);
is($domain->is_base,0);
}
}
sub test_clone_pool_2($vm, $pool, $base) {
for my $name ( keys %$pool) {
my $dir_pool = $pool->{$name};
$vm->clone_storage_pool($name);
is($vm->clone_storage_pool($name), $name);
my $clone = $base->clone(
name => new_domain_name()
,user => user_admin
);
ok(scalar ($clone->list_volumes));
for my $volume ($clone->list_volumes) {
my ($path ) = $volume =~ m{(.*)/.*};
like($path, qr{$dir_pool});
}
$clone->remove(user_admin);
}
}
sub test_default_pool_base {
my $vm = shift;
my $pool_name = shift;
......@@ -228,6 +402,8 @@ sub test_default_pool_base {
$domain->remove(user_admin);
}
}
#
#########################################################################
clean();
......@@ -253,9 +429,15 @@ SKIP: {
test_volumes_in_two_pools($vm_name);
$domain->remove(user_admin);
test_base_pool($vm, $pool_name);
test_clone_pool($vm, $pool_name);
test_default_pool_base($vm, $pool_name);
my $pool_name2 = create_pool($vm_name);
test_base_clone_pool($vm, $pool_name, $pool_name2);
$domain->remove(user_admin);
}
clean();
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment