Skip to content
GitLab
Commit c302797a authored by Francesc Guasch's avatar Francesc Guasch
Browse files

rvd_back works again with new source architecture

parent ac3b276d
Expand all Hide whitespace changes
Inline Side-by-side
bin/rvd_back.pl
View file @ c302797a
This diff is collapsed.
lib/Ravada.pm
View file @ c302797a
......@@ -41,7 +41,12 @@ has 'vm' => (
);
has 'connector' => (
is => 'ro'
is => 'rw'
);
has 'config' => (
is => 'ro'
,isa => 'Str'
);
=head2 BUILD
......@@ -53,11 +58,16 @@ Internal constructor
sub BUILD {
my $self = shift;
if ($self->config ) {
_init_config($self->config);
}
if ( $self->connector ) {
$CONNECTOR = $self->connector
} else {
$CONNECTOR = $self->_connect_dbh();
$self->connector($CONNECTOR);
}
}
sub _connect_dbh {
......@@ -140,6 +150,25 @@ sub search_domain {
}
}
=head2 list_domains
List all created domains
my @list = $ravada->list_domains();
=cut
sub list_domains {
my $self = shift;
my @domains;
for my $vm (@{$self->vm}) {
for my $domain ($vm->list_domains) {
push @domains,($domain);
}
}
return @domains;
}
=head2 remove_volume
$ravada->remove_volume($file);
......
lib/Ravada/Domain.pm
View file @ c302797a
......@@ -3,9 +3,11 @@ package Ravada::Domain;
use warnings;
use strict;
use Carp qw(confess);
use Carp qw(confess croak);
use Moose::Role;
our $TIMEOUT_SHUTDOWN = 20;
requires 'name';
requires 'remove';
requires 'display';
......@@ -15,6 +17,14 @@ has 'domain' => (
,is => 'ro'
);
has 'timeout_shutdown' => (
isa => 'Int'
,is => 'ro'
,default => $TIMEOUT_SHUTDOWN
);
##################################################################################3
#
sub id {
......@@ -22,9 +32,12 @@ sub id {
}
sub file_base_img {
return $_[0]->_data('file_base_img');
my $file;
eval { $file = $_[0]->_data('file_base_img') };
return $file ;
}
##################################################################################
sub _data {
......@@ -32,22 +45,11 @@ sub _data {
my $field = shift or confess "Missing field name";
return $self->{_data}->{$field} if exists $self->{_data}->{$field};
$self->_load_sql_data();
return $self->{_data}->{$field};
}
$self->{_data} = $self->_select_domain_db( name => $self->name);
sub _load_sql_data {
my $self = shift;
my $sth = $self->connector->dbh->prepare("SELECT * FROM domains "
." WHERE name=?"
);
$sth->execute($self->name);
my $data = $sth->fetchrow_hashref;
$sth->finish;
$self->{_data} = $data;
confess "No DB info for domain ".$self->name if !$self->{_data};
return $data;
return $self->{_data}->{$field};
}
sub open {
......@@ -58,7 +60,7 @@ sub open {
my $id = $args{id} or confess "Missing required argument id";
delete $args{id};
my $row = $self->_select_domain_db ( id => $id );
my $row = $self->_select_domain_db ( );
return $self->search_domain($row->{name});
# confess $row;
}
......@@ -67,6 +69,16 @@ sub _select_domain_db {
my $self = shift;
my %args = @_;
if (!keys %args) {
my $id;
eval { $id = $self->id };
if ($id) {
%args =( id => $id );
} else {
%args = ( name => $self->name );
}
}
my $sth = $self->connector->dbh->prepare(
"SELECT * FROM domains WHERE ".join(",",map { "$_=?" } sort keys %args )
);
......@@ -74,6 +86,7 @@ sub _select_domain_db {
my $row = $sth->fetchrow_hashref;
$sth->finish;
$self->{_data} = $row;
return $row;
}
......@@ -81,12 +94,59 @@ sub _prepare_base_db {
my $self = shift;
my $file_img = shift;
if (!$self->_select_domain_db) {
$self->_insert_db( name => $self->name );
}
my $sth = $self->connector->dbh->prepare(
"UPDATE domains set is_base='y',file_base_img=? "
." WHERE id=?"
);
$sth->execute($file_img , $self->id);
$sth->finish;
$self->{_data} = $self->_select_domain_db();
}
sub _insert_db {
my $self = shift;
my %field = @_;
croak "Field name is mandatory ".Dumper(\%field)
if !exists $field{name};
my $query = "INSERT INTO domains "
."(" . join(",",sort keys %field )." )"
." VALUES (". join(",", map { '?' } keys %field )." ) "
;
my $sth = $self->connector->dbh->prepare($query);
eval { $sth->execute( map { $field{$_} } sort keys %field ) };
if ($@) {
warn "$query\n".Dumper(\%field);
die $@;
}
$sth->finish;
}
sub _remove_domain_db {
my $self = shift;
$self->_select_domain_db or return;
my $sth = $self->connector->dbh->prepare("DELETE FROM domains "
." WHERE id=?");
$sth->execute($self->id);
$sth->finish;
}
=head2 is_base
Returns true or false if the domain is a prepared base
=cut
sub is_base {
my $self = shift;
$self->_select_domain_db or return;
return $self->_data('is_base') =~ /y/i
};
1;
lib/Ravada/Domain/KVM.pm
View file @ c302797a
......@@ -29,10 +29,6 @@ has 'connector' => (
,required => 1
);
#################################################3
#
our $TIMEOUT_SHUTDOWN = 20;
##################################################
#
......@@ -50,7 +46,7 @@ sub name {
sub _wait_down {
my $self = shift;
my $seconds = (shift or $TIMEOUT_SHUTDOWN);
my $seconds = (shift or $self->timeout_shutdown);
for my $sec ( 0 .. $seconds) {
return if !$self->domain->is_active;
print "Waiting for ".$self->domain->get_name." to shutdown." if !$sec;
......@@ -124,14 +120,6 @@ sub remove {
$self->_remove_domain_db();
}
sub _remove_domain_db {
my $self = shift;
my $sth = $self->connector->dbh->prepare("DELETE FROM domains "
." WHERE id=?");
$sth->execute($self->id);
$sth->finish;
}
sub remove_file_image {
my $self = shift;
......@@ -206,7 +194,6 @@ sub prepare_base {
my $self = shift;
my $file_qcow = $self->_create_qcow_base();
#update domains set is_base='y' , img = $file_qcow
$self->_prepare_base_db($file_qcow);
}
......@@ -230,4 +217,5 @@ sub display {
return "$type://$address:$port";
}
1;
lib/Ravada/VM.pm
View file @ c302797a
......@@ -16,6 +16,8 @@ requires 'connect';
requires 'create_domain';
requires 'search_domain';
requires 'list_domains';
# storage volume
requires 'create_volume';
......@@ -63,25 +65,6 @@ sub _domain_remove_db {
$sth->finish;
}
sub _domain_insert_db {
my $self = shift;
my %field = @_;
croak "Field name is mandatory ".Dumper(\%field)
if !exists $field{name};
my $query = "INSERT INTO domains "
."(" . join(",",sort keys %field )." )"
." VALUES (". join(",", map { '?' } keys %field )." ) "
;
my $sth = $self->connector->dbh->prepare($query);
eval { $sth->execute( map { $field{$_} } sort keys %field ) };
if ($@) {
warn "$query\n".Dumper(\%field);
die $@;
}
$sth->finish;
}
sub domain_remove {
my $self = shift;
$self->domain_remove_vm();
......
lib/Ravada/VM/KVM.pm
View file @ c302797a
......@@ -94,6 +94,10 @@ sub _load_storage_pool {
}
sub dir_img {
return $DEFAULT_DIR_IMG;
}
=head2 create_domain
Creates a domain.
......@@ -121,7 +125,7 @@ sub create_domain {
} else {
confess "TODO";
}
$self->_domain_insert_db(@fields);
$domain->_insert_db(@fields);
return $domain;
}
......@@ -147,6 +151,29 @@ sub search_domain {
}
}
=head2 list_domains
Returns a list of the created domains
my @list = $vm->list_domains();
=cut
sub list_domains {
my $self = shift;
my @list;
for my $name ($self->vm->list_all_domains()) {
push @list, (Ravada::Domain::KVM->new(
domain => $name
,storage => $self->storage_pool
,connector => $self->connector
)
);
}
return @list;
}
=head2 create_volume
Creates a new storage volume. It requires a name and a xml template file defining the volume
......@@ -244,12 +271,17 @@ sub _create_disk_qcow2 {
die "WARNING: output file $file_out already existed [skipping]\n";
}
die "ERROR: Missing file_base_img in base ".$base->id
." "
.Dumper($base->_select_domain_db)
if ! $base->file_base_img;
my @cmd = ('qemu-img','create'
,'-f','qcow2'
,"-b", $base->file_base_img
,$file_out
);
print join(" ",@cmd)."\n";
# warn join(" ",@cmd)."\n";
my ($in, $out, $err);
run3(\@cmd,\$in,\$out,\$err);
......
t/20_domain_kvm.t
View file @ c302797a
use warnings;
use strict;
use Data::Dumper;
use IPC::Run3;
use Test::More;
use Test::SQL::Data;
......@@ -11,6 +12,8 @@ use_ok('Ravada::Domain::KVM');
my $test = Test::SQL::Data->new( config => 't/etc/ravada.conf');
my $ravada = Ravada->new( connector => $test->connector);
my $cont = 0;
sub test_vm_kvm {
my $vm = $ravada->vm->[0];
ok($vm,"No vm found") or exit;
......@@ -60,6 +63,7 @@ sub search_domain_db {
sub test_new_domain {
my ($name) = $0 =~ m{.*/(.*)\.t};
$name .= "_".$cont++;
test_remove_domain($name);
......@@ -93,19 +97,37 @@ sub test_prepare_base {
$sth->finish;
}
################################################################
test_vm_kvm();
{
sub test_domain{
my ($name) = $0 =~ m{.*/(.*)\.t};
test_remove_domain($name);
my $n_domains = scalar $ravada->list_domains();
my $domain = test_new_domain();
if (ok($domain,"test domain not created")) {
my @list = $ravada->list_domains();
ok(scalar(@list) == $n_domains + 1,"Found ".scalar(@list)." domains, expecting "
.($n_domains+1)
." "
.join(",", sort map { $_->name } @list)
);
ok(!$domain->is_base,"Domain shouldn't be base "
.Dumper($domain->_select_domain_db()));
test_prepare_base($domain);
ok($domain->is_base,"Domain should be base"
.Dumper($domain->_select_domain_db())
);
test_remove_domain($domain->name);
}
}
{
sub test_domain_by_name {
my $domain = test_new_domain();
if (ok($domain,"test domain not created")) {
......@@ -113,5 +135,39 @@ test_vm_kvm();
}
}
sub test_prepare_import {
my $domain = test_new_domain();
if (ok($domain,"test domain not created")) {
my $sth = $test->connector->dbh->prepare("DELETE FROM domains WHERE id=?");
$sth->execute($domain->id);
test_prepare_base($domain);
ok($domain->is_base,"Domain should be base"
.Dumper($domain->_select_domain_db())
);
test_remove_domain($domain);
}
}
sub remove_old_domains {
my ($name) = $0 =~ m{.*/(.*)\.t};
for ( 0 .. 10 ) {
test_remove_domain($name."_".$_);
}
}
################################################################
test_vm_kvm();
remove_old_domains();
test_domain();
test_domain_by_name();
test_prepare_import();
done_testing();
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