Commit 1a98b240 authored by Francesc Guasch's avatar Francesc Guasch
Browse files

[#41] rename void VMs and almost there with KVM

parent 9b5c94aa
......@@ -950,6 +950,23 @@ sub _cmd_ping_backend {
return 1;
}
sub _cmd_rename_domain {
my $self = shift;
my $request = shift;
my $uid = $request->args('uid');
my $name = $request->args('name');
my $id_domain = $request->args('id_domain') or die "ERROR: Missing id_domain";
my $user = Ravada::Auth::SQL->search_by_id($uid);
my $domain = $self->search_domain_by_id($id_domain);
confess "Unkown domain ".Dumper($request) if !$domain;
$domain->rename(user => $user, name => $name);
}
sub _req_method {
my $self = shift;
my $cmd = shift;
......@@ -967,6 +984,7 @@ sub _req_method {
,remove_base => \&_cmd_remove_base
,ping_backend => \&_cmd_ping_backend
,prepare_base => \&_cmd_prepare_base
,rename_domain => \&_cmd_rename_domain
,open_iptables => \&_cmd_open_iptables
,list_vm_types => \&_cmd_list_vm_types
);
......
......@@ -36,6 +36,7 @@ requires 'resume';
requires 'prepare_base';
requires 'rename';
requires 'rename_volumes';
#storage
requires 'add_volume';
......@@ -112,7 +113,7 @@ before 'remove_base' => \&_can_remove_base;
after 'remove_base' => \&_remove_base_db;
before 'rename' => \&_pre_rename;
after 'rename' => \&_rename_domain_db;
after 'rename' => \&_post_rename;
##################################################
sub _vm_connect {
......@@ -922,14 +923,18 @@ sub _active_iptables {
}
sub _check_duplicate_domain_name {
my $self = shift;
# TODO
# check name not in current domain in db
# check name not in other VM domain
$self->id();
}
sub _rename_domain_db {
my $self = shift;
my $new_name = shift;
my %args = @_;
my $new_name = $args{name} or confess "Missing new name";
my $sth = $$CONNECTOR->dbh->prepare("UPDATE domains set name=?"
." WHERE id=?");
......@@ -945,8 +950,14 @@ sub _pre_rename {
my $user = $args{user};
$self->_check_duplicate_domain_name(@_);
$self->resume($user) if $self->is_paused;
$self->shutdown(user => $user) if $self->is_active;
}
sub _post_rename {
my $self = shift;
my %args = @_;
$self->rename_volumes($args{name});
$self->_rename_domain_db(@_);
}
1;
......@@ -736,6 +736,25 @@ Renames the domain
sub rename {
my $self = shift;
my %args = @_;
my $new_name = $args{name};
$self->domain->rename($new_name);
}
=head2 rename_volumes
Renames all the volumes of a domain
Argument: the new name of the volumes.
=cut
sub rename_volumes {
my $self = shift;
for my $volume ($self->list_volumes) {
warn "Rename volume ".Dumper($volume);
}
}
1;
......@@ -220,7 +220,7 @@ sub rename_volumes {
my $data = LoadFile($self->_config_file);
for my $name (%{$data->{device}}) {
for my $name (keys %{$data->{device}}) {
my $path = $data->{device}->{$name}->{path};
next if !$path;
$data->{device}->{$name}->{path}
......@@ -330,7 +330,6 @@ sub rename {
unlink($file_yml);
$self->domain($new_name);
$self->rename_volumes($new_name);
}
1;
......@@ -47,6 +47,7 @@ our %VALID_ARG = (
,shutdown_domain => { name => 1, uid => 1, timeout => 2 }
,screenshot_domain => { id_domain => 1, filename => 2 }
,start_domain => {%$args_manage, remote_ip => 1 }
,rename_domain => { uid => 1, name => 1, id_domain => 1}
);
our $CONNECTOR;
......@@ -658,6 +659,29 @@ sub open_iptables {
, args => encode_json($args));
}
=head2 rename_domain
Request to rename a domain
=cut
sub rename_domain {
my $proto = shift;
my $class=ref($proto) || $proto;
my $args = _check_args('rename_domain', @_ );
my $self = {};
bless($self,$class);
return $self->_new_request(
command => 'rename_domain'
, id_domain => $args->{id_domain}
, args => encode_json($args)
);
}
sub AUTOLOAD {
my $self = shift;
......
......@@ -34,7 +34,7 @@ sub test_create_domain {
my $ravada = Ravada->new(@ARG_RVD);
my $vm = $ravada->search_vm($vm_name);
ok($vm,"I can't find VM $vm_name") or return;
ok($vm,"Expecting VM $vm_name") or return;
if (!$ARG_CREATE_DOM{$vm_name}) {
......@@ -43,6 +43,7 @@ sub test_create_domain {
}
my @arg_create = @{$ARG_CREATE_DOM{$vm_name}};
diag("[$vm_name] creating domain $name");
my $domain;
eval { $domain = $vm->create_domain(name => $name
, id_owner => $USER->id
......@@ -65,21 +66,50 @@ sub test_rename_domain {
my $vm = rvd_back->search_vm($vm_name);
my $domain = $vm->search_domain($domain_name);
ok($domain,"Expecting found $domain_name") or return;
ok($domain,"[$vm_name] Expecting found $domain_name") or return;
my $new_domain_name = new_domain_name();
$domain->rename(name => $new_domain_name, user => $USER);
my $domain0 = $vm->search_domain($domain_name);
ok(!$domain0,"Expecting not found $domain_name");
ok(!$domain0,"[$vm_name] Expecting not found $domain_name");
my $domain1 = $vm->search_domain($new_domain_name);
ok($domain1,"Expecting renamed domain $new_domain_name");
ok($domain1,"[$vm_name] Expecting renamed domain $new_domain_name") or return;
}
sub test_req_rename_domain {
my ($vm_name, $domain_name) = @_;
my $domain_id;
{
my $vm = rvd_back->search_vm($vm_name);
my $domain = $vm->search_domain($domain_name);
ok($domain,"[$vm_name-req] Expecting found $domain_name") or return;
$domain_id = $domain->id;
}
my $new_domain_name = new_domain_name();
my $req = Ravada::Request->rename_domain(
uid => $USER->id,
name => $new_domain_name,
id_domain => $domain_id,
);
ok($req);
rvd_back()->process_requests();
wait_request($req);
ok($req->status eq 'done'
,"Status of request is ".$req->status." it should be done");
ok(!$req->error,"Error ".$req->error." creating domain ".$domain_name)
or return;
my $vm = rvd_back->search_vm($vm_name);
my $domain0 = $vm->search_domain($domain_name);
ok(!$domain0,"[$vm_name-req] Expecting not found $domain_name");
my $domain1 = $vm->search_domain($new_domain_name);
ok($domain1,"[$vm_name-req] Expecting renamed domain $new_domain_name") or return;
}
......@@ -90,7 +120,6 @@ remove_old_disks();
for my $vm_name (qw( Void KVM )) {
diag("Testing $vm_name VM");
my $CLASS= "Ravada::VM::$vm_name";
use_ok($CLASS) or next;
......@@ -115,7 +144,7 @@ for my $vm_name (qw( Void KVM )) {
test_create_domain($vm_name, $domain_name);
$domain_name = test_create_domain($vm_name);
test_req_rename_domain($vm_name, $domain_name);
test_req_rename_domain($vm_name, $domain_name) or next;
test_create_domain($vm_name, $domain_name);
};
......
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