Skip to content
GitLab
Unverified Commit 85393630 authored by Francesc Guasch's avatar Francesc Guasch Committed by GitHub
Browse files

Merge branch 'develop' into fix/1218_copy_local_screenshots_database

parents b21b5fe3 b77b80dd
Hide whitespace changes
Inline Side-by-side
.gitignore
View file @ 85393630
......@@ -5,7 +5,6 @@ Makefile.old
blib
pm_to_blib
t/.db
t/etc/ravada_ldap*.conf
t/etc/remote_vm*.conf
t/etc/front_ldap*.conf
hypnotoad.pid
......
CHANGELOG.md
View file @ 85393630
......@@ -3,12 +3,5 @@
**Implemented enhancements:**
- Multiple copies of machines [\#1091]
- Pools of virtual machines [\#1115]
**Bugfixes**
- Access option missing in settings machine [\#1098]
- Logout timeout on start machine too quick [\#1119]
- Change current memory fails [\#1123]
- Data too long for column display [\#1107]
Makefile.PL
View file @ 85393630
......@@ -19,6 +19,7 @@ WriteMakefile(
,'XML::LibXML'=> 0
,'YAML' => 0
,'Image::Magick' => 0
,'IO::Scalar' => 0
,'MooseX::Types::NetAddr::IP' => 0
,'IO::Interface' => 0
,'Sys::Statistics::Linux' => 0
......
bin/rvd_back.pl
View file @ 85393630
......@@ -27,6 +27,7 @@ my $FILE_CONFIG_DEFAULT = "/etc/ravada.conf";
my $FILE_CONFIG;
my $ADD_USER_LDAP;
my $REMOVE_USER;
my $IMPORT_DOMAIN;
my $IMPORT_VBOX;
my $CHANGE_PASSWORD;
......@@ -46,7 +47,9 @@ my $LIST;
my $HIBERNATE_DOMAIN;
my $START_DOMAIN;
my $SHUTDOWN_DOMAIN;
my $REMOVE_DOMAIN;
my $REBASE;
my $RUN_REQUEST;
my $IMPORT_DOMAIN_OWNER;
......@@ -58,9 +61,11 @@ my $USAGE = "$0 "
." [--test-ldap] "
." [-X] [start|stop|status]"
." [--rebase MACHINE]"
." [--remove-user=name]"
."\n"
." --add-user : adds a new db user\n"
." --add-user-ldap : adds a new LDAP user\n"
." --remove-user : removes a db user\n"
." --change-password : changes the password of an user\n"
." --import-domain : import a domain\n"
." --import-domain-owner : owner of the domain to import\n"
......@@ -76,6 +81,7 @@ my $USAGE = "$0 "
." --start\n"
." --hibernate machine\n"
." --shutdown machine\n"
." --remove machine\n"
."\n"
."Operations modifiers:\n"
." --all : execute on all virtual machines\n"
......@@ -102,7 +108,9 @@ GetOptions ( help => \$help
,'url-isos=s'=> \$URL_ISOS
,'shutdown:s'=> \$SHUTDOWN_DOMAIN
,'hibernate:s'=> \$HIBERNATE_DOMAIN
,'remove:s'=> \$REMOVE_DOMAIN
,'disconnected'=> \$DISCONNECTED
,'remove-user=s'=> \$REMOVE_USER
,'make-admin=s' => \$MAKE_ADMIN_USER
,'remove-admin=s' => \$REMOVE_ADMIN_USER
,'change-password'=> \$CHANGE_PASSWORD
......@@ -112,6 +120,7 @@ GetOptions ( help => \$help
,'import-domain-owner=s' => \$IMPORT_DOMAIN_OWNER
,'add-locale-repository=s' => \$ADD_LOCALE_REPOSITORY
,'run-request=s' => \$RUN_REQUEST
) or exit;
$START = 1 if $DEBUG || $FILE_CONFIG || $NOFORK;
......@@ -126,7 +135,7 @@ if ($help) {
exit;
}
die "Only root can do that\n" if $> && ( $ADD_USER || $ADD_USER_LDAP || $IMPORT_DOMAIN);
die "Only root can do that\n" if $> && ( $ADD_USER || $REMOVE_USER || $ADD_USER_LDAP || $IMPORT_DOMAIN);
die "ERROR: Missing file config $FILE_CONFIG\n"
if $FILE_CONFIG && ! -e $FILE_CONFIG;
......@@ -169,6 +178,8 @@ sub do_start {
$ravada->process_long_requests();
$ravada->process_requests();
exit if done_request();
if ( time - $t_refresh > 60 ) {
Ravada::Request->cleanup();
Ravada::Request->refresh_vms() if rand(5)<3;
......@@ -181,6 +192,16 @@ sub do_start {
}
sub done_request {
return 0 if !$RUN_REQUEST;
my $req;
eval { $req = Ravada::Request->open($RUN_REQUEST) };
warn $req->status;
warn $@ if $@;
return 1 if !$req || $req->status eq 'done';
}
sub clean_old_requests {
my $ravada = Ravada->new( %CONFIG );
$ravada->clean_old_requests();
......@@ -200,6 +221,7 @@ sub start {
for (;;) {
eval { do_start() };
warn $@ if $@;
exit if done_request();
}
}
......@@ -237,6 +259,21 @@ sub add_user_ldap {
Ravada::Auth::LDAP::add_user($login, $password);
}
sub remove_user {
my $login = shift;
my $ravada = Ravada->new( %CONFIG);
my $user = Ravada::Auth::SQL->new(name => $login);
die "ERROR: Unknown user '$login'\n" if !$user->id;
print "Are you sure you want remove $login user ? : [y/n] ";
my $remove_it = <STDIN>;
if ( $remove_it =~ /y/i ) {
$user->remove();
print "USER $login was removed\n";
}
}
sub change_password {
print "User login name : ";
my $login = <STDIN>;
......@@ -409,6 +446,20 @@ sub hibernate {
if !$domain_name && !$found;
}
sub remove_domain {
my $domain_name = shift;
my $rvd_back = Ravada->new(%CONFIG);
my $domain = $rvd_back->search_domain($domain_name);
die "Error: domain $domain_name not found\n" if !$domain;
Ravada::Request->remove_domain(
uid => Ravada::Utils::user_daemon()->id
,name => $domain->name
);
print "Removing $domain_name\n";
}
sub start_domain {
my $domain_name = shift;
......@@ -561,6 +612,7 @@ my $rvd_back = Ravada->new(%CONFIG);
add_user($ADD_USER) if $ADD_USER;
add_user_ldap($ADD_USER_LDAP) if $ADD_USER_LDAP;
remove_user($REMOVE_USER) if $REMOVE_USER;
change_password() if $CHANGE_PASSWORD;
import_domain($IMPORT_DOMAIN) if $IMPORT_DOMAIN;
import_vbox($IMPORT_VBOX) if $IMPORT_VBOX;
......@@ -572,6 +624,7 @@ rebase() if $REBASE;
list($ALL) if $LIST;
hibernate($HIBERNATE_DOMAIN , $ALL) if defined $HIBERNATE_DOMAIN;
remove_domain($REMOVE_DOMAIN) if defined $REMOVE_DOMAIN;
start_domain($START_DOMAIN) if $START_DOMAIN;
shutdown_domain($SHUTDOWN_DOMAIN, $ALL, $HIBERNATED)
......
deb/debianize.pl
View file @ 85393630
......@@ -16,6 +16,9 @@ my $DIR_SRC = getcwd;
my $DIR_DST;
my $DEBIAN = "DEBIAN";
my %COPY_RELEASES = (
'ubuntu-19.04'=> ['ubuntu-18.10','ubuntu-19.10']
);
my %DIR = (
templates => '/usr/share/ravada'
,'etc/ravada.conf' => 'etc'
......@@ -324,6 +327,18 @@ sub get_fallback {
print `etc/get_fallback.pl`;
}
sub copy_identical_releases {
for my $source (sort keys %COPY_RELEASES ) {
for my $copy (@{$COPY_RELEASES{$source}}) {
my $file_source = "$DIR_SRC/../ravada_release/ravada_${VERSION}_${source}_all.deb";
die "Error: No $file_source" if !-e $file_source;
my $file_copy = "$DIR_SRC/../ravada_release/ravada_${VERSION}_${copy}_all.deb";
copy($file_source, $file_copy) or die "Error: $!\n$file_source -> $file_copy";
}
}
exit;
}
#########################################################################
get_fallback();
......@@ -367,3 +382,5 @@ tar($dist);
create_md5sums();
create_deb($dist);
}
copy_identical_releases();
debian/control-debian-10
View file @ 85393630
......@@ -4,7 +4,7 @@ Architecture: all
Section: utils
Priority: optional
Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils, libencode-locale-perl
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
debian/control-ubuntu-18.04
View file @ 85393630
......@@ -4,7 +4,7 @@ Architecture: all
Section: utils
Priority: optional
Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-bin,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils, libencode-locale-perl
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
debian/control-ubuntu-18.10 deleted 120000 → 0
View file @ b21b5fe3
control-ubuntu-19.04
\ No newline at end of file
debian/control-ubuntu-19.04
View file @ 85393630
......@@ -4,7 +4,7 @@ Architecture: all
Section: utils
Priority: optional
Maintainer: Francesc Guasch <frankie@telecos.upc.edu>
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
Depends: perl (>=5.18),libmojolicious-perl,mysql-common,libauthen-passphrase-perl, libdatetime-perl, libdbd-mysql-perl,libdbi-perl,libdbix-connector-perl,libipc-run3-perl,libio-stringy-perl,libnet-ldap-perl,libproc-pid-file-perl,libvirt-daemon-system,libsys-virt-perl,libxml-libxml-perl,libconfig-yaml-perl,libmoose-perl,libjson-xs-perl,qemu-utils,perlmagick,libmoosex-types-netaddr-ip-perl,libio-interface-perl,libiptables-chainmgr-perl,libnet-dns-perl,wget,liblocale-maketext-lexicon-perl,libmojolicious-plugin-i18n-perl,libdbd-sqlite3-perl, debconf (>= 0.2.26), adduser, libdigest-sha-perl, qemu-kvm, net-tools, libfile-rsync-perl, libnet-ssh2-perl, bridge-utils
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
lib/Ravada.pm
View file @ 85393630
......@@ -3,7 +3,7 @@ package Ravada;
use warnings;
use strict;
our $VERSION = '0.5.0-beta8';
our $VERSION = '0.6.0';
use Carp qw(carp croak);
use Data::Dumper;
......@@ -139,6 +139,7 @@ sub BUILD {
sub _install($self) {
$self->_create_tables();
$self->_upgrade_tables();
$self->_upgrade_timestamps();
$self->_update_data();
$self->_init_user_daemon();
}
......@@ -1282,6 +1283,30 @@ sub _upgrade_tables {
$self->_upgrade_table('domain_ports', 'internal_ip','char(200)');
}
sub _upgrade_timestamps($self) {
return if $CONNECTOR->dbh->{Driver}{Name} !~ /mysql/;
my $req = Ravada::Request->ping_backend();
return if $req->{date_changed};
my @commands = qw(cleanup enforce_limits list_isos list_network_interfaces
manage_pools open_exposed_ports open_iptables ping_backend
refresh_machine refresh_storage refresh_vms
screenshot);
my $sql ="DELETE FROM requests WHERE "
.join(" OR ", map { "command = '$_'" } @commands);
my $sth = $CONNECTOR->dbh->prepare($sql);
$sth->execute();
$self->_upgrade_timestamp('requests','date_changed');
}
sub _upgrade_timestamp($self, $table, $field) {
my $sth = $CONNECTOR->dbh->prepare("ALTER TABLE $table change $field "
."$field timestamp DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP");
$sth->execute();
}
sub _connect_dbh {
my $driver= ($CONFIG->{db}->{driver} or 'mysql');;
......@@ -2233,7 +2258,7 @@ sub _kill_stale_process($self) {
." AND pid IS NOT NULL "
." AND start_time IS NOT NULL "
);
$sth->execute(time - 5*scalar(@domains) + 60 );
$sth->execute(time - 5*scalar(@domains) - 60 );
while (my ($id, $pid, $command, $start_time) = $sth->fetchrow) {
if ($pid == $$ ) {
warn "HOLY COW! I should kill pid $pid stale for ".(time - $start_time)
......@@ -2269,7 +2294,8 @@ sub _domain_working {
}
my $sth = $CONNECTOR->dbh->prepare("SELECT id, status FROM requests "
." WHERE id <> ? AND id_domain=? "
." AND (status <> 'requested' AND status <> 'done' AND command <> 'set_base_vm')");
." AND (status <> 'requested' AND status <> 'done' AND status <> 'waiting' "
." AND command <> 'set_base_vm')");
$sth->execute($id_request, $id_domain);
my ($id, $status) = $sth->fetchrow;
# warn "CHECKING DOMAIN WORKING "
......@@ -2322,9 +2348,10 @@ sub _execute {
return;
}
$request->status('working','') unless $request->status() eq 'waiting';
$request->pid($$);
$request->start_time(time);
$request->error('');
$request->status('working','');
if ($dont_fork || !$CAN_FORK) {
$self->_do_execute_command($sub, $request);
return;
......@@ -2357,6 +2384,7 @@ sub _do_execute_command {
# local *STDERR = $f_err;
# }
$request->status('working','') unless $request->status() eq 'working';
$request->pid($$);
my $t0 = [gettimeofday];
eval {
......@@ -2366,6 +2394,18 @@ sub _do_execute_command {
my $elapsed = tv_interval($t0,[gettimeofday]);
$request->run_time($elapsed);
$request->error($err) if $err;
if ($err) {
my $user = $request->defined_arg('user');
if ($user) {
my $subject = $err;
my $message = '';
if (length($subject) > 40 ) {
$message = $subject;
$subject = substr($subject,0,40);
$user->send_message($subject, $message);
}
}
}
if ($err && $err =~ /retry.?$/i) {
my $retry = $request->retry;
if (defined $retry && $retry>0) {
......@@ -2377,11 +2417,10 @@ sub _do_execute_command {
$err =~ s/(.*?)retry.?/$1/i;
$request->error($err) if $err;
}
} else {
}
$request->status('done')
if $request->status() ne 'done'
&& $request->status() !~ /^retry/i;
}
}
sub _cmd_manage_pools($self, $request) {
......@@ -2568,22 +2607,35 @@ sub _can_fork {
warn $msg if $DEBUG;
$req->error($msg);
$req->at_time(time+10);
$req->status('waiting') if $req->status() !~ 'waiting';
$req->at_time(time+10);
return 0;
}
sub _wait_pids {
my $self = shift;
my @done;
for my $type ( keys %{$self->{pids}} ) {
for my $pid ( keys %{$self->{pids}->{$type}}) {
my $kid = waitpid($pid , WNOHANG);
last if $kid <= 0 ;
my $request = Ravada::Request->open($self->{pids}->{$type}->{$kid});
if ($request) {
$request->status('done') if $request->status =~ /working/i;
};
delete $self->{pids}->{$type}->{$kid};
push @done, ($pid) if $kid == $pid || $kid == -1;
}
}
return if !@done;
for my $pid (@done) {
my $id_req;
for my $type ( keys %{$self->{pids}} ) {
$id_req = $self->{pids}->{$type}->{$pid} if exists $self->{pids}->{$type}->{$pid};
next if !$id_req;
delete $self->{pids}->{$type}->{$pid};
last;
}
next if !$id_req;
my $request = Ravada::Request->open($id_req);
if ($request) {
$request->status('done') if $request->status =~ /working/i;
};
}
}
......@@ -2832,12 +2884,14 @@ sub _cmd_prepare_base {
my $user = Ravada::Auth::SQL->search_by_id( $uid)
or confess "Error: Unknown user id $uid in request ".Dumper($request);
my $with_cd = $request->defined_arg('with_cd');
my $domain = $self->search_domain_by_id($id_domain);
die "Unknown domain id '$id_domain'\n" if !$domain;
$self->_remove_unnecessary_downs($domain);
$domain->prepare_base($user);
$domain->prepare_base(user => $user, with_cd => $with_cd);
}
......@@ -2986,6 +3040,11 @@ sub _cmd_shutdown {
die "Unknown domain '$id_domain'\n" if !$domain
}
Ravada::Request->refresh_machine(
uid => $uid
,id_domain => $id_domain
,after_request => $request->id
);
my $user = Ravada::Auth::SQL->search_by_id( $uid);
$domain->shutdown(timeout => $timeout, user => $user
......@@ -3087,9 +3146,10 @@ sub _cmd_refresh_machine($self, $request) {
my $id_domain = $request->args('id_domain');
my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
my $domain = Ravada::Domain->open($id_domain) or confess "Error: domain $id_domain not found";
$domain->check_status();
$domain->list_volumes_info();
$self->_remove_unnecessary_downs($domain) if !$domain->is_active;
$domain->info($user);
$self->_remove_unnecessary_downs($domain);
}
......@@ -3313,6 +3373,7 @@ sub _refresh_disabled_nodes($self, $request = undef ) {
}
sub _refresh_active_domain($self, $domain, $active_domain) {
$domain->check_status();
return if $domain->is_hibernated();
my $is_active = $domain->is_active();
......
lib/Ravada/Auth/User.pm
View file @ 85393630
......@@ -161,6 +161,24 @@ sub unshown_messages {
}
=head2 send_message
Send a message to this user
$user->send_message($subject, $message)
=cut
sub send_message($self, $subject, $message='') {
_init_connector() if !$$CONNECTOR;
my $sth = $$CONNECTOR->dbh->prepare(
"INSERT INTO messages (id_user, subject, message) "
." VALUES(?, ? , ? )");
$sth->execute($self->id, $subject, $message);
}
=head2 show_message
......@@ -337,6 +355,10 @@ sub _load_allowed {
return if !$refresh && $self->{_load_allowed}++;
if (ref($self) !~ /SQL$/) {
$self = Ravada::Auth::SQL->new(name => $self->name);
}
my $ldap_entry;
$ldap_entry = $self->ldap_entry if $self->external_auth && $self->external_auth eq 'ldap';
......
lib/Ravada/Domain.pm
View file @ 85393630
......@@ -548,6 +548,8 @@ sub _around_add_volume {
}
sub _check_volume_added($self, $file) {
return if $file =~ /\.iso$/i;
my $sth = $$CONNECTOR->dbh->prepare("SELECT id,id_domain FROM volumes "
." WHERE file=?"
);
......@@ -592,10 +594,21 @@ sub _around_list_volumes_info($orig, $self, $attribute=undef, $value=undef) {
return @volumes;
}
sub _around_prepare_base($orig, $self, $user, $request = undef) {
sub _around_prepare_base($orig, $self, @args) {
#sub _around_prepare_base($orig, $self, $user, $request = undef) {
my ($user, $request, $with_cd);
if(ref($args[0]) =~/^Ravada::/) {
($user, $request) = @args;
} else {
my %args = @args;
$user = delete $args{user};
$request = delete $args{request};
$with_cd = delete $args{with_cd};
confess "Error: uknown args". Dumper(\%args) if keys %args;
}
$self->_pre_prepare_base($user, $request);
my @base_img = $self->$orig();
my @base_img = $self->$orig($with_cd);
die "Error: No information files returned from prepare_base"
if !scalar (\@base_img);
......@@ -605,16 +618,17 @@ sub _around_prepare_base($orig, $self, $user, $request = undef) {
$self->_post_prepare_base($user, $request);
}
sub prepare_base($self) {
sub prepare_base($self, $with_cd) {
my @base_img;
for my $volume ($self->list_volumes_info(device => 'disk')) {
confess "Undefined info->target ".Dumper($volume)
if !$volume->info->{target};
for my $volume ($self->list_volumes_info()) {
my $base_file = $volume->base_filename;
next if !$base_file || $base_file =~ /\.iso$/;
die "Error: file '$base_file' already exists" if $self->_vm->file_exists($base_file);
}
for my $volume ($self->list_volumes_info(device => 'disk')) {
for my $volume ($self->list_volumes_info()) {
next if !$volume->info->{target} && $volume->info->{device} eq 'cdrom';
next if $volume->info->{device} eq 'cdrom' && !$with_cd;
confess "Undefined info->target ".Dumper($volume)
if !$volume->info->{target};
......@@ -1059,14 +1073,15 @@ sub open($class, @args) {
$domain = $vm->search_domain($row->{name}, $force) or return;
$domain->_data(id_vm => $vm->id);
}
if (!$id_vm) {
$domain->_search_already_started() if !$domain->is_base;
$domain->_check_clean_shutdown() if $domain->domain && !$domain->is_active;
}
$domain->_insert_db_extra() if $domain && !$domain->is_known_extra();
return $domain;
}
sub check_status($self) {
$self->_search_already_started() if !$self->is_base;
$self->_check_clean_shutdown() if $self->domain && !$self->is_active;
}
=head2 is_known
Returns if the domain is known in Ravada.
......@@ -1285,6 +1300,7 @@ sub info($self, $user) {
,is_base => $self->is_base
,id_base => $self->id_base
,is_active => $is_active
,is_hibernated => $self->is_hibernated
,spice_password => $self->spice_password
,description => $self->description
,msg_timeout => ( $self->_msg_timeout or undef)
......@@ -1332,6 +1348,13 @@ sub info($self, $user) {
$info->{bases} = $self->_bases_vm();
$info->{clones} = $self->_clones_vm();
$info->{ports} = [$self->list_ports()];
my @cdrom = ();
for my $disk (@{$info->{hardware}->{disk}}) {
push @cdrom,($disk->{file}) if $disk->{file} && $disk->{file} =~ /\.iso$/;
}
$info->{cdrom} = \@cdrom;
$info->{requests} = $self->list_requests();
return $info;
}
......@@ -1429,6 +1452,8 @@ sub _pre_remove_domain($self, $user, @) {
}
# check the node is active
# search the domain in another node if it is not
sub _check_active_node($self) {
return $self->_vm if $self->_vm->is_active(1);
......@@ -1436,7 +1461,9 @@ sub _check_active_node($self) {
next if !$node->is_local;
$self->_vm($node);
$self->domain($node->search_domain_by_id($self->id)->domain);
my $domain_active = $node->search_domain_by_id($self->id);
next if !$domain_active;
$self->domain($domain_active->domain);
last;
}
return $self->_vm;
......@@ -1461,6 +1488,7 @@ sub _after_remove_domain {
$self->_finish_requests_db();
$self->_remove_base_db();
$self->_remove_access_attributes_db();
$self->_remove_ports_db();
$self->_remove_volumes_db();
$self->_remove_bases_vm_db();
$self->_remove_domain_db();
......@@ -1491,6 +1519,14 @@ sub _remove_domain_cascade($self,$user, $cascade = 1) {
}
}
sub _remove_ports_db($self) {
return if !$self->{_data}->{id};
my $sth = $$CONNECTOR->dbh->prepare("DELETE FROM domain_ports"
." WHERE id_domain=?");
$sth->execute($self->id);
$sth->finish;
}