Commit f247e344 authored by Francesc Guasch's avatar Francesc Guasch
Browse files

Merge branch 'develop' of https://github.com/UPC/ravada into develop

parents 702b5a96 924a6bb7
......@@ -46,6 +46,7 @@ my $LIST;
my $HIBERNATE_DOMAIN;
my $START_DOMAIN;
my $SHUTDOWN_DOMAIN;
my $REBASE;
my $IMPORT_DOMAIN_OWNER;
......@@ -56,6 +57,7 @@ my $USAGE = "$0 "
." [--change-password] [--make-admin=username] [--import-vbox=image_file.vdi]"
." [--test-ldap] "
." [-X] [start|stop|status]"
." [--rebase MACHINE]"
."\n"
." --add-user : adds a new db user\n"
." --add-user-ldap : adds a new LDAP user\n"
......@@ -90,6 +92,7 @@ GetOptions ( help => \$help
,list => \$LIST
,debug => \$DEBUG
,verbose => \$VERBOSE
,rebase => \$REBASE
,'no-fork'=> \$NOFORK
,'start=s' => \$START_DOMAIN
,'config=s'=> \$FILE_CONFIG
......@@ -134,6 +137,9 @@ die "ERROR: Shutdown requires a domain name, or --all , --hibernated , --disconn
die "ERROR: Hibernate requires a domain name, or --all , --disconnected\n"
if defined $HIBERNATE_DOMAIN && !$HIBERNATE_DOMAIN && !$ALL && !$DISCONNECTED;
die "ERROR: Missing the machine name or id\n$USAGE"
if $REBASE && !@ARGV;
my %CONFIG;
%CONFIG = ( config => $FILE_CONFIG ) if $FILE_CONFIG;
......@@ -527,6 +533,22 @@ sub add_locale_repository {
}
}
sub rebase {
my ($domain_name) = $ARGV[0];
my $rvd_back = Ravada->new(%CONFIG);
my $domain;
if ($domain_name =~ /^\d+$/) {
$domain = Ravada::Domain->open($domain_name);
} else {
$domain = $rvd_back->search_domain($domain_name);
}
die "Error: Unknown domain $domain_name\n" if !$domain;
die "Error: ".$domain->name." is not a clone\n" if !$domain->id_base;
my $base = Ravada::Domain->open($domain->id_base);
$base->rebase(Ravada::Utils::user_daemon, $domain);
}
sub DESTROY {
}
......@@ -545,6 +567,7 @@ make_admin($MAKE_ADMIN_USER) if $MAKE_ADMIN_USER;
remove_admin($REMOVE_ADMIN_USER) if $REMOVE_ADMIN_USER;
set_url_isos($URL_ISOS) if $URL_ISOS;
test_ldap if $TEST_LDAP;
rebase() if $REBASE;
list($ALL) if $LIST;
hibernate($HIBERNATE_DOMAIN , $ALL) if defined $HIBERNATE_DOMAIN;
......
......@@ -2023,6 +2023,8 @@ sub process_requests {
warn $@ if $@;
next if !$req;
next if !$req->requirements_done;
next if $request_type ne 'all' && $req->type ne $request_type;
next if $req->command !~ /shutdown/i
......@@ -2321,20 +2323,6 @@ sub _do_execute_command {
}
sub _cmd_domdisplay {
my $self = shift;
my $request = shift;
my $name = $request->args('name');
confess "Unknown name for request ".Dumper($request) if!$name;
my $domain = $self->search_domain($request->args->{name});
my $user = Ravada::Auth::SQL->search_by_id( $request->args->{uid});
$request->error('');
my $display = $domain->display($user);
$request->result({display => $display});
}
sub _cmd_screenshot {
my $self = shift;
my $request = shift;
......@@ -2562,6 +2550,28 @@ sub _cmd_start {
}
sub _cmd_dettach($self, $request) {
my $domain = Ravada::Domain->open($request->id_domain);
my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
die "Error: ".$user->name." not authorized to dettach domain"
if !$user->is_admin;
$domain->dettach($user);
}
sub _cmd_rebase_volumes($self, $request) {
my $domain = Ravada::Domain->open($request->id_domain);
my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
die "Error: ".$user->name." not authorized to dettach domain"
if !$user->is_admin;
my $new_base = Ravada::Domain->open($request->args('id_base'));
$domain->rebase_volumes($new_base);
}
sub _cmd_start_clones {
my $self = shift;
my $request = shift;
......@@ -3185,12 +3195,12 @@ sub _req_method {
,create => \&_cmd_create
,remove => \&_cmd_remove
,resume => \&_cmd_resume
,dettach => \&_cmd_dettach
,cleanup => \&_cmd_cleanup
,download => \&_cmd_download
,shutdown => \&_cmd_shutdown
,hybernate => \&_cmd_hybernate
,set_driver => \&_cmd_set_driver
,domdisplay => \&_cmd_domdisplay
,screenshot => \&_cmd_screenshot
,add_disk => \&_cmd_add_disk
,copy_screenshot => \&_cmd_copy_screenshot
......@@ -3206,6 +3216,7 @@ sub _req_method {
,list_vm_types => \&_cmd_list_vm_types
,enforce_limits => \&_cmd_enforce_limits
,force_shutdown => \&_cmd_force_shutdown
,rebase_volumes => \&_cmd_rebase_volumes
,refresh_storage => \&_cmd_refresh_storage
,refresh_machine => \&_cmd_refresh_machine
,refresh_vms => \&_cmd_refresh_vms
......
......@@ -59,6 +59,7 @@ requires 'resume';
requires 'prepare_base';
requires 'rename';
requires 'dettach';
#storage
requires 'add_volume';
......@@ -181,6 +182,8 @@ after 'remove_base' => \&_post_remove_base;
before 'rename' => \&_pre_rename;
after 'rename' => \&_post_rename;
after 'dettach' => \&_post_dettach;
before 'clone' => \&_pre_clone;
after 'screenshot' => \&_post_screenshot;
......@@ -2531,6 +2534,16 @@ sub _post_rename {
$self->_rename_domain_db(@_);
}
sub _post_dettach($self, @) {
my $sth = $$CONNECTOR->dbh->prepare(
"UPDATE domains set id_base=? "
." WHERE id=?"
);
$sth->execute(undef, $self->id);
$sth->finish;
delete $self->{_data};
}
sub _post_screenshot {
my $self = shift;
my ($filename) = @_;
......@@ -3545,4 +3558,48 @@ sub cache_volume_info($self, %info) {
$sth->execute(encode_json(\%info), $name, $file, $self->id, $n_order, $row->{id});
}
sub rebase($self, $user, $new_base) {
croak "Error: ".$self->name." is not a base\n" if !$self->is_base;
my @reqs = Ravada::Request->dettach(
uid => $user->id
,id_domain => $new_base->id
);
push @reqs, Ravada::Request->prepare_base(
uid => $user->id
,id_domain => $new_base->id
,after_request => $reqs[0]->id
);
for my $clone_info ( $self->clones ) {
next if $clone_info->{id} == $new_base->id;
push @reqs,Ravada::Request->rebase_volumes(
uid => $user->id
,id_base => $new_base->id
,id_domain => $clone_info->{id}
,after_request => $reqs[1]->id
);
}
return @reqs;
}
sub rebase_volumes($self, $new_base) {
die "Error: domain ".$new_base->name." is not a base\n"
if !$new_base->is_base;
my @files_target = $new_base->list_files_base_target();
my %file_target = map { $_->[1] => $_->[0] } @files_target;
warn "rebasing ".$self->name."\n";
for my $vol ( $self->list_volumes_info) {
next if $vol->{device} ne 'disk';
my $new_base = $file_target{$vol->{target}};
die "I can't find new base file for ".Dumper($vol) if !$new_base;
warn "$vol->{file}\n$new_base\n";
my @cmd = ('/usr/bin/qemu-img','rebase','-b',$new_base,$vol->{file});
my ($out, $err) = $self->_vm->run_command(@cmd);
}
$self->id_base($new_base->id);
}
1;
......@@ -2340,4 +2340,12 @@ sub _change_xml_address_virtio($self, $address) {
$address->setAttribute(slot => $self->_new_pci_slot);
}
sub dettach($self, $user) {
$self->id_base(undef);
$self->start($user) if !$self->is_active;
for my $vol ($self->list_disks ) {
$self->domain->block_pull($vol,0);
}
}
1;
......@@ -176,6 +176,8 @@ sub shutdown_now { confess "TODO" }
sub spinoff_volumes { confess "TODO" }
sub start { confess "TODO" }
sub dettach { confess "TODO" }
sub get_driver {}
sub get_controller_by_name { }
sub list_controllers {}
......
......@@ -447,107 +447,11 @@ sub shutdown_domain {
return $self->_new_request(command => 'shutdown' , args => $args);
}
=head2 prepare_base
Returns a new request for preparing a domain base
my $req = Ravada::Request->prepare_base( $name );
=cut
sub prepare_base {
my $proto = shift;
my $class=ref($proto) || $proto;
my %args = @_;
confess "Missing uid" if !$args{uid};
my $args = _check_args('prepare_base', @_);
my $self = {};
bless($self,$class);
return $self->_new_request(command => 'prepare_base'
, id_domain => $args{id_domain}
, args => $args );
}
=head2 remove_base
Returns a new request for making a base regular domain. It marks it
as 'non base' and removes the files.
It must have not clones. All clones must be removed before calling
this method.
my $req = Ravada::Request->remove_base( $name );
=cut
sub remove_base {
my $proto = shift;
my $class=ref($proto) || $proto;
my %_args = @_;
confess "Missing uid" if !$_args{uid};
my $args = _check_args('remove_base', @_);
my $self = {};
bless($self,$class);
my $req = $self->_new_request(command => 'remove_base'
, id_domain => $args->{id_domain}
, args => $args );
return $req;
}
=head2 ping_backend
Returns wether the backend is alive or not
=cut
sub ping_backend {
my $proto = shift;
my $class=ref($proto) || $proto;
my $self = {};
bless ($self, $class);
return $self->_new_request( command => 'ping_backend' );
}
=head2 domdisplay
Returns the domdisplay of a domain
Arguments:
* domain name
=cut
sub domdisplay {
my $proto = shift;
my $class=ref($proto) || $proto;
my $name = shift;
my $uid = shift;
my $self = {};
bless ($self, $class);
return $self->_new_request( command => 'domdisplay'
,args => { name => $name, uid => $uid });
}
sub _new_request {
my $self = shift;
if (!ref($self)) {
my $class = $self;
if ( !ref($self) ) {
my $proto = $self ;
my $class = ref($proto) || $proto;
$self = {};
bless ($self, $class);
}
......@@ -864,238 +768,6 @@ sub copy_screenshot {
}
=head2 open_iptables
Request to open iptables for a remote client
=cut
sub open_iptables {
my $proto = shift;
my $class=ref($proto) || $proto;
my $args = _check_args('open_iptables', @_ );
my $self = {};
bless($self,$class);
return $self->_new_request(
command => 'open_iptables'
, id_domain => $args->{id_domain}
, args => $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 => $args
);
}
=head2 set_driver
Sets a driver to a domain
$domain->set_driver(
id_domain => $domain->id
,uid => $USER->id
,id_driver => $driver->id
);
=cut
sub set_driver {
my $proto = shift;
my $class = ref($proto) || $proto;
my $args = _check_args('set_driver', @_ );
my $self = {};
bless($self,$class);
return $self->_new_request(
command => 'set_driver'
, id_domain => $args->{id_domain}
, args => $args
);
}
=head2 add_hardware
Sets hardware to a VM
$domain->add_hardware(
id_domain => $domain->id
,uid => $USER->id
,name => 'usb'
);
=cut
sub add_hardware {
my $proto = shift;
my $class = ref($proto) || $proto;
my $args = _check_args('add_hardware', @_);
my $self = {};
bless($self, $class);
return $self->_new_request(
command => 'add_hardware'
,id_domain => $args->{id_domain}
,args => $args
);
}
=head2 remove_hardware
Removes hardware to a VM
$domain->remove_hardware(
id_domain => $domain->id
,uid => $USER->id
,name_hardware => 'usb'
);
=cut
sub remove_hardware {
my $proto = shift;
my $class = ref($proto) || $proto;
my $args = _check_args('remove_hardware', @_);
my $self = {};
bless($self, $class);
return $self->_new_request(
command => 'remove_hardware'
,id_domain => $args->{id_domain}
,args => $args
);
}
sub change_hardware {
return _new_request_generic('change_hardware',@_);
}
=head2 hybernate
Hybernates a domain.
Ravada::Request->hybernate(
id_domain => $domain->id
,uid => $user->id
);
=cut
sub hybernate {
my $proto = shift;
my $class = ref($proto) || $proto;
my $args = _check_args('hybernate', @_ );
my $self = {};
bless($self,$class);
return $self->_new_request(
command => 'hybernate'
, id_domain => $args->{id_domain}
, args => $args
);
}
=head2 download
Downloads a file. Actually used only to download iso images
for KVM domains.
=cut
sub download {
my $proto = shift;
my $class = ref($proto) || $proto;
my $args = _check_args('download', @_ );
my $self = {};
bless($self,$class);
return $self->_new_request(
command => 'download'
, args => $args
);
}
=head2 refresh_storage
Refreshes a storage pool
=cut
sub refresh_storage {
my $proto = shift;
my $class = ref($proto) || $proto;
my $args = _check_args('refresh_storage', @_ );
my $self = {};
bless($self,$class);
return $self->_new_request(
command => 'refresh_storage'
, args => $args
);
}
=head2 clone
Copies a virtual machine
my $req = Ravada::Request->clone(
,uid => $user->id
id_domain => $domain->id
);
=cut
sub clone {
my $proto = shift;
my $class = ref($proto) || $proto;
my $args = _check_args('clone', @_ );
my $self = {};
bless($self,$class);
return _new_request($self
, command => 'clone'
, args =>$args
);
}
=head2 refresh_vms
Refreshes the Virtual Mangers
......@@ -1148,33 +820,6 @@ sub set_base_vm {
}
=head2 cleanup
Performs cleanup operations on the virtual machines.
- Enforces limits
- .. more .. ?
=cut
sub cleanup($proto , @args) {
my $class = ref($proto) || $proto;
my $args = _check_args('cleanup', @args );
return if _requested('cleanup');
my $self = {};
bless ($self, $class);
return $self->_new_request(
command => 'cleanup'
, args => $args
);
}