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

Merge branch 'develop'

parents fa6e5def 5b0fa755
Expand all Hide whitespace changes
Inline Side-by-side
README.md
View file @ a1e82c67
# ravada
[![GitHub version](https://img.shields.io/badge/version-0.7.0-brightgreen.svg)](https://github.com/UPC/ravada/releases) [![License: AGPL v3](https://img.shields.io/badge/License-AGPL%20v3-blue.svg)](https://github.com/UPC/ravada/blob/master/LICENSE)
[![GitHub version](https://img.shields.io/badge/version-0.9.0-brightgreen.svg)](https://github.com/UPC/ravada/releases) [![License: AGPL v3](https://img.shields.io/badge/License-AGPL%20v3-blue.svg)](https://github.com/UPC/ravada/blob/master/LICENSE)
[![Documentation Status](https://readthedocs.org/projects/ravada/badge/?version=latest)](http://ravada.readthedocs.io/en/latest/?badge=latest)
[![Follow twitter](https://img.shields.io/twitter/follow/ravada_vdi.svg?style=social&label=Twitter&style=flat-square)](https://twitter.com/ravada_vdi)
[![Telegram Group](https://img.shields.io/badge/Telegram-Group-blue.svg)](https://t.me/ravadavdi)
[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active)
[![Translation status](https://hosted.weblate.org/widgets/ravada/-/svg-badge.svg)](https://hosted.weblate.org/engage/ravada/)
[![Conventional Commits](https://img.shields.io/badge/Conventional%20Commits-1.0.0-yellow.svg)](https://conventionalcommits.org)
<sup>**Frontend:**</sup><!-- [![Docker Stars](https://img.shields.io/docker/stars/ravada/front.svg?style=flat)](https://hub.docker.com/r/ravada/front/) -->
......
SECURITY.md 0 → 100644
View file @ a1e82c67
# RavadaVDI Security
We take security very seriously. We welcome any peer review of our 100% open source code to ensure nobody's Ravada is ever compromised or hacked.
## Reporting a Vulnerability
So, you think you found a vulnerability? Well, please let us know!
Please open up an [issue][1] and try to provide as much information as possible.
[1]: https://github.com/UPC/ravada/issues/new?assignees=&labels=&template=bug_report.md&title=
debian/control-debian-10
View file @ a1e82c67
......@@ -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,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-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl
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-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
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 @ a1e82c67
......@@ -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,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-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl
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-openssh-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
debian/control-ubuntu-19.04
View file @ a1e82c67
......@@ -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,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-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl
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-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
debian/control-ubuntu-20.04
View file @ a1e82c67
......@@ -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,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-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl
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-openssh-perl, bridge-utils, libpbkdf2-tiny-perl, libdatetime-format-dateparse-perl, libguestfs-tools
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 @ a1e82c67
......@@ -3,9 +3,9 @@ package Ravada;
use warnings;
use strict;
our $VERSION = '0.10.0';
our $VERSION = '0.11.0';
use Carp qw(carp croak);
use Carp qw(carp croak cluck);
use Data::Dumper;
use DBIx::Connector;
use File::Copy;
......@@ -83,6 +83,7 @@ $FILE_CONFIG = undef if ! -e $FILE_CONFIG;
our $CONNECTOR;
our $CONFIG = {};
our $FORCE_DEBUG = 0;
our $DEBUG;
our $VERBOSE;
our $CAN_FORK = 1;
......@@ -901,7 +902,6 @@ sub _remove_old_isos {
,"DELETE FROM iso_images "
." WHERE name like 'Debian Buster 32%'"
." AND file_re like '%xfce-CD-1.iso'"
,"DELETE FROM iso_images "
." WHERE (name LIKE 'Ubuntu Focal%' OR name LIKE 'Ubuntu Bionic%' ) "
." AND ( md5 IS NOT NULL OR md5_url IS NOT NULL) "
......@@ -1112,10 +1112,6 @@ sub _enable_grants($self) {
return if $self->_null_grants();
my $sth = $CONNECTOR->dbh->prepare(
"UPDATE grant_types set enabled=0"
);
$sth->execute;
my @grants = (
'change_settings', 'change_settings_all', 'change_settings_clones'
,'clone', 'clone_all', 'create_base', 'create_machine'
......@@ -1130,7 +1126,7 @@ sub _enable_grants($self) {
,'start_many'
);
$sth = $CONNECTOR->dbh->prepare("SELECT id,name FROM grant_types");
my $sth = $CONNECTOR->dbh->prepare("SELECT id,name FROM grant_types");
$sth->execute;
my %grant_exists;
while (my ($id, $name) = $sth->fetchrow ) {
......@@ -1150,7 +1146,14 @@ sub _enable_grants($self) {
$sth->execute($name);
}
$self->_disable_other_grants(@grants);
}
sub _disable_other_grants($self, @grants) {
my $query = "UPDATE grant_types set enabled=0 WHERE enabled=1 AND "
.join(" AND ",map { "name <> ? " } @grants );
my $sth = $CONNECTOR->dbh->prepare($query);
$sth->execute(@grants);
}
sub _update_old_qemus($self) {
......@@ -1489,6 +1492,7 @@ sub _upgrade_tables {
my $self = shift;
# return if $CONNECTOR->dbh->{Driver}{Name} !~ /mysql/i;
$self->_upgrade_table("base_xml",'xml','TEXT');
$self->_upgrade_table('file_base_images','target','varchar(64) DEFAULT NULL');
$self->_upgrade_table('vms','vm_type',"char(20) NOT NULL DEFAULT 'KVM'");
......@@ -1575,9 +1579,12 @@ sub _upgrade_tables {
$self->_upgrade_table('domains','shared_storage','varchar(254)');
$self->_upgrade_table('domains','post_shutdown','int not null default 0');
$self->_upgrade_table('domains','post_hibernated','int not null default 0');
$self->_upgrade_table('domains','is_compacted','int not null default 0');
$self->_upgrade_table('domains','has_backups','int not null default 0');
$self->_upgrade_table('domains_network','allowed','int not null default 1');
$self->_upgrade_table('domains_kvm','xml','TEXT');
$self->_upgrade_table('iptables','id_vm','int DEFAULT NULL');
$self->_upgrade_table('vms','security','varchar(255) default NULL');
$self->_upgrade_table('grant_types','enabled','int not null default 1');
......@@ -2136,16 +2143,8 @@ sub _search_domain {
=cut
sub search_domain_by_id {
my $self = shift;
my $id = shift or confess "ERROR: missing argument id";
my $sth = $CONNECTOR->dbh->prepare("SELECT name FROM domains WHERE id=?");
$sth->execute($id);
my ($name) = $sth->fetchrow;
confess "Unknown domain id=$id" if !$name;
return $self->search_domain($name);
sub search_domain_by_id($self, $id) {
return Ravada::Domain->open($id);
}
=head2 list_vms
......@@ -2772,7 +2771,7 @@ sub _do_execute_command {
my $err = ( $@ or '');
my $elapsed = tv_interval($t0,[gettimeofday]);
$request->run_time($elapsed);
$request->error($err) if $err;
$request->error(''.$err) if $err;
if ($err) {
my $user = $request->defined_arg('user');
if ($user) {
......@@ -3196,7 +3195,7 @@ sub _cmd_start {
my $domain;
$domain = $self->search_domain($name) if $name;
$domain = $self->search_domain_by_id($id_domain) if $id_domain;
$domain = Ravada::Domain->open($id_domain) if $id_domain;
die "Unknown domain '".($name or $id_domain)."'" if !$domain;
$domain->status('starting');
......@@ -3704,6 +3703,7 @@ sub _cmd_refresh_vms($self, $request=undef) {
$self->_clean_requests('refresh_vms', $request);
$self->_refresh_volatile_domains();
$request->error('') if $request;
}
sub _cmd_shutdown_node($self, $request) {
......@@ -3770,7 +3770,7 @@ sub _cmd_list_network_interfaces($self, $request) {
sub _cmd_list_isos($self, $request){
my $vm_type = $request->args('vm_type');
my $vm = Ravada::VM->open( type => $vm_type );
$vm->refresh_storage();
my @isos = sort { "\L$a" cmp "\L$b" } $vm->search_volume_path_re(qr(.*\.iso$));
......@@ -3791,17 +3791,60 @@ sub _cmd_set_time($self, $request) {
die "$@ , retry.\n" if $@;
}
sub _migrate_base($self, $domain, $node, $uid, $request) {
sub _cmd_compact($self, $request) {
my $id_domain = $request->args('id_domain');
my $domain = Ravada::Domain->open($id_domain)
or do {
$request->retry(0);
Ravada::Request->refresh_vms();
die "Error: domain $id_domain not found\n";
};
my $uid = $request->args('uid');
my $user = Ravada::Auth::SQL->search_by_id($uid);
die "Error: user ".$user->name." not allowed to compact ".$domain->name
unless $user->is_operator || $uid == $domain->_data('id_owner');
$domain->compact($request);
}
sub _cmd_purge($self, $request) {
my $id_domain = $request->args('id_domain');
my $domain = Ravada::Domain->open($id_domain)
or do {
$request->retry(0);
Ravada::Request->refresh_vms();
die "Error: domain $id_domain not found\n";
};
my $uid = $request->args('uid');
my $user = Ravada::Auth::SQL->search_by_id($uid);
die "Error: user ".$user->name." not allowed to compact ".$domain->name
unless $user->is_operator || $uid == $domain->_data('id_owner');
$domain->purge($request);
}
sub _migrate_base($self, $domain, $id_node, $uid, $request) {
if (ref($id_node)) {
$id_node = $id_node->id;
}
my $base = Ravada::Domain->open($domain->id_base);
return if $base->base_in_vm($node->id);
return if $base->base_in_vm($id_node);
my $req_base = Ravada::Request->set_base_vm(
id_domain => $base->id
, id_vm => $node->id
, id_vm => $id_node
, uid => $uid
, retry => 10
);
$request->after_request($req_base->id) if $req_base;
die "Base ".$base->name." still not prepared in node ".$node->name.". Retry\n";
confess "Error: no request for set_base_vm" if !$req_base;
confess "Error: same request" if $req_base->id == $request->id;
$request->retry(10) if !defined $request->retry();
$request->after_request_ok($req_base->id);
die "Base ".$base->name." still not prepared in node $id_node. Retry\n";
}
sub _cmd_migrate($self, $request) {
......@@ -3809,7 +3852,8 @@ sub _cmd_migrate($self, $request) {
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);
my $domain = Ravada::Domain->open($id_domain)
or confess "Error: domain $id_domain not found";
die "Error: user ".$user->name." not allowed to migrate domain ".$domain->name
unless $user->is_operator;
......@@ -3828,7 +3872,7 @@ sub _cmd_migrate($self, $request) {
,id_domain => $id_domain
,@timeout
);
$request->after_request($req_shutdown->id);
$request->after_request_ok($req_shutdown->id);
$request->retry(10) if !defined $request->retry();
die "Virtual Machine ".$domain->name." ".$request->retry." is active. Shutting down. Retry.\n";
}
......@@ -3911,6 +3955,7 @@ sub _refresh_active_domains($self, $request=undef) {
my @domains;
eval { @domains = $self->list_domains_data };
warn $@ if $@;
my $t0 = time;
for my $domain_data (sort { $b->{date_changed} cmp $a->{date_changed} }
@domains) {
$request->error("checking $domain_data->{name}") if $request;
......@@ -3919,6 +3964,7 @@ sub _refresh_active_domains($self, $request=undef) {
next if !$domain;
$self->_refresh_active_domain($domain, \%active_domain);
$self->_remove_unnecessary_downs($domain) if !$domain->is_active;
last if !$CAN_FORK && time - $t0 > 10;
}
$request->error("checked ".scalar(@domains)) if $request;
}
......@@ -4034,12 +4080,11 @@ sub _refresh_volatile_domains($self) {
$domain->_post_shutdown(user => $USER_DAEMON);
$domain->remove($USER_DAEMON);
} else {
confess;
my $sth= $CONNECTOR->dbh->prepare(
"DELETE FROM users where id=? "
." AND is_temporary=1");
$sth->execute($id_owner);
$sth->finish;
cluck "Warning: temporary user id=$id_owner should already be removed";
my $user;
eval { $user = Ravada::Auth::SQL->search_by_id($id_owner) };
warn $@ if $@;
$user->remove() if $user;
}
my $sth_del = $CONNECTOR->dbh->prepare("DELETE FROM domains WHERE id=?");
$sth_del->execute($id_domain);
......@@ -4073,16 +4118,19 @@ sub _cmd_set_base_vm {
# my $domain = $self->search_domain_by_id($id_domain) or confess "Error: Unknown domain id: $id_domain";
die "USER $uid not authorized to set base vm"
if !$user->is_admin;
if !$user->is_admin;
$domain->prepare_base($user) if $value && !$domain->is_base;
$self->_migrate_base($domain, $id_vm, $uid, $request) if $domain->id_base;
if ( $value && !$domain->is_base ) {
$domain->prepare_base($user);
}
$domain->set_base_vm(
id_vm => $id_vm
,user => $user
,value => $value
,request => $request
);
id_vm => $id_vm
,user => $user
,value => $value
,request => $request
);
}
sub _cmd_cleanup($self, $request) {
......@@ -4166,6 +4214,8 @@ sub _req_method {
,remove_hardware => \&_cmd_remove_hardware
,change_hardware => \&_cmd_change_hardware
,set_time => \&_cmd_set_time
,compact => \&_cmd_compact
,purge => \&_cmd_purge
# Domain ports
,expose => \&_cmd_expose
......@@ -4372,15 +4422,14 @@ sub _clean_temporary_users($self) {
." WHERE u.is_temporary = 1 AND u.date_created < ?"
);
my $sth_del = $CONNECTOR->dbh->prepare(
"DELETE FROM users "
." WHERE is_temporary = 1 AND id=?"
);
my $one_day = _date_now(-24 * 60 * 60);
$sth_users->execute( $one_day );
while ( my ( $id_user, $id_domain, $date_created ) = $sth_users->fetchrow ) {
next if $id_domain;
$sth_del->execute($id_user);
my $user;
eval { $user = Ravada::Auth::SQL->search_by_id($id_user) };
warn $@ if $@;
$user->remove() if $user;
}
}
......@@ -4403,10 +4452,10 @@ sub _clean_volatile_machines($self, %args) {
eval { $domain_real->remove($USER_DAEMON) };
warn $@ if $@;
} elsif ($domain->{id_owner}) {
my $sth = $CONNECTOR->dbh->prepare(
"DELETE FROM users where id=? "
."AND is_temporary=1");
$sth->execute($domain->{id_owner});
my $user;
eval { $user = Ravada::Auth::SQL->search_by_id($domain->{id_owner})};
warn $@ if $@;
$user->remove() if $user;
}
$sth_remove->execute($domain->{id});
......@@ -4460,10 +4509,9 @@ Sets debug global variable from setting
=cut
sub set_debug_value($self) {
$DEBUG = $self->setting('backend/debug');
$DEBUG = $FORCE_DEBUG || $self->setting('backend/debug');
}
=head2 setting
Returns the value of a configuration setting
......
lib/Ravada/Auth.pm
View file @ a1e82c67
......@@ -21,10 +21,12 @@ Initializes the submodules
sub init {
my ($config, $db_con) = @_;
if ($config->{ldap}) {
if ($config->{ldap} && (!defined $LDAP_OK || $LDAP_OK) ) {
eval {
$LDAP_OK = 0;
require Ravada::Auth::LDAP;
Ravada::Auth::LDAP::init($config);
Ravada::Auth::LDAP::_connect_ldap();
$LDAP_OK = 1;
};
warn $@ if $@;
......
lib/Ravada/Auth/SQL.pm
View file @ a1e82c67
......@@ -584,8 +584,10 @@ Removes the user
=cut
sub remove($self) {
confess if $self->name eq 'f';
my $sth = $$CON->dbh->prepare("DELETE FROM users where id=?");
my $sth = $$CON->dbh->prepare("DELETE FROM grants_user where id_user=?");
$sth->execute($self->id);
$sth = $$CON->dbh->prepare("DELETE FROM users where id=?");
$sth->execute($self->id);
$sth->finish;
}
......
lib/Ravada/Domain.pm
View file @ a1e82c67
......@@ -367,13 +367,13 @@ sub _around_start($orig, $self, @arg) {
}
sub _request_set_base($self) {
sub _request_set_base($self, $id_vm=$self->_vm->id) {
my $base = Ravada::Domain->open($self->id_base);
$base->_set_base_vm_db($self->_vm->id,0);
Ravada::Request->set_base_vm(
uid => Ravada::Utils::user_daemon->id
,id_domain => $base->id
,id_vm => $self->_vm->id
,id_vm => $id_vm
);
my $vm_local = $self->_vm->new( host => 'localhost' );
$self->_set_vm($vm_local, 1);
......@@ -830,7 +830,7 @@ sub _pre_prepare_base($self, $user, $request = undef ) {
# TODO: if disk is not base and disks have not been modified, do not generate them
# again, just re-attach them
# again, just re-attach them
# $self->_check_disk_modified(
confess "ERROR: domain ".$self->name." is already a base" if $self->is_base();
$self->_check_has_clones();
......@@ -850,14 +850,11 @@ sub _pre_prepare_base($self, $user, $request = undef ) {
sleep 1;
}
}
$self->_post_remove_base();
# $self->_post_remove_base();
if (!$self->is_local) {
my $vm_local = Ravada::VM->open( type => $self->vm );
$self->migrate($vm_local, $request);
}
if ($self->id_base ) {
$self->spinoff();
}
$self->_check_free_space_prepare_base();
}
......@@ -882,7 +879,6 @@ sub _post_prepare_base {
$self->description($base->description) if $base->description();
}
$self->_remove_id_base();
$self->_set_base_vm_db($self->_vm->id,1);
$self->autostart(0,$user);
};
......@@ -997,7 +993,7 @@ sub _check_cpu_usage($self, $request=undef){
chomp(my $cpu_count = `grep -c -P '^processor\\s+:' /proc/cpuinfo`);
die "Error: Too many active domains." if (scalar $self->_vm->vm->list_domains() >= $self->_vm->active_limit);
}
my @cpu;
my $msg;
for ( 1 .. 10 ) {
......@@ -1223,7 +1219,7 @@ sub _data($self, $field, $value=undef, $table='domains') {
$self->{$data} = $self->_select_domain_db( _table => $table, @field_select );
confess "No DB info for domain @field_select in $table ".$self->name
confess "No DB info for domain @field_select in $table ".$self->name
if ! exists $self->{$data};
confess "No field $field in $data ".Dumper(\@field_select)."\n".Dumper($self->{$data})
if !exists $self->{$data}->{$field};
......@@ -1589,7 +1585,7 @@ sub info($self, $user) {
,volatile_clones => $self->volatile_clones
,id_vm => $self->_data('id_vm')
};
for (qw(comment screenshot id_owner shutdown_disconnected)) {
for (qw(comment screenshot id_owner shutdown_disconnected is_compacted has_backups)) {
$info->{$_} = $self->_data($_);
}
if ($is_active) {
......@@ -1633,6 +1629,8 @@ sub info($self, $user) {
$info->{cdrom} = \@cdrom;
$info->{requests} = $self->list_requests();
Ravada::Front::init_available_actions($user, $info);
return $info;
}
......@@ -2054,9 +2052,9 @@ sub clones($self, %filter) {
_init_connector();
my $query =
"SELECT id, id_vm, name, id_owner, status, client_status, is_pool"
"SELECT id, id_vm, name, id_owner, status, client_status, is_pool, is_base"
." FROM domains "
." WHERE id_base = ? AND (is_base=NULL OR is_base=0)";
." WHERE id_base = ? ";
my @values = ($self->id);
if (keys %filter) {
$query .= "AND ( ".join(" AND ",map { "$_ = ?" } sort keys %filter)." )";
......@@ -2231,7 +2229,7 @@ sub _pre_remove_base {
my ($domain) = @_;
_allow_manage(@_);
_check_has_clones(@_);
if (!$domain->is_local) {
my $vm_local = $domain->_vm->new( host => 'localhost' );
confess "Error: I can't find local virtual manager ".$domain->type
......@@ -2323,7 +2321,7 @@ sub clone {
my %args2 = @_;
delete $args2{from_pool};
return $self->_copy_clone(%args2) if $self->id_base();
return $self->_copy_clone(%args2) if !$self->is_base && $self->id_base();
my $uid = $user->id;
......@@ -2399,6 +2397,14 @@ sub _copy_clone($self, %args) {
,from_pool => 0
,@copy_arg
);
_copy_volumes($self, $copy);
_copy_ports($self, $copy);
$copy->is_pool(1) if $add_to_pool;
return $copy;
}
sub _copy_volumes($self, $copy) {
my @volumes = $self->list_volumes_info(device => 'disk');
my @copy_volumes = $copy->list_volumes_info(device => 'disk');
......@@ -2408,8 +2414,21 @@ sub _copy_clone($self, %args) {
copy($volumes{$target}, $copy_volumes{$target})
or die "$! $volumes{$target}, $copy_volumes{$target}"
}
$copy->is_pool(1) if $add_to_pool;
return $copy;
}
sub _copy_ports($base, $copy) {
my %port_already;
for my $port ( $copy->list_ports ) {
$port_already{$port->{internal_port}}++;
}
for my $port ( $base->list_ports ) {
my %port = %$port;
next if $port_already{$port->{internal_port}};
delete @port{'id','id_domain','public_port'};
$copy->expose(%port);
}
}
sub _post_pause {
......@@ -2506,7 +2525,7 @@ sub _post_shutdown {
id_domain => $self->id
,id_vm => $self->_vm->id
, uid => $arg{user}->id
, at => time+$timeout
, at => time+$timeout
);
}
if ($self->is_volatile) {
......@@ -3150,12 +3169,14 @@ sub _post_start {
my $set_time = delete $arg{set_time};
$set_time = 1 if !defined $set_time;
$self->_data('status','active') if $self->is_active();
if ( $self->is_active() ) {
$self->_data('status','active');
}
my $sth = $$CONNECTOR->dbh->prepare(
"UPDATE domains set start_time=? "
"UPDATE domains set start_time=?,is_compacted=? "
." WHERE id=?"
);
$sth->execute(time, $self->id);
$sth->execute(time, 0, $self->id);
$sth->finish;
$self->_data('internal_id',$self->internal_id);
......@@ -3648,7 +3669,7 @@ sub get_controller {
my $sub = $self->get_controller_by_name($name);
# my $sub = $GET_CONTROLLER_SUB{$name};
die "I can't get controller $name for domain ".$self->name
if !$sub;
......@@ -3994,9 +4015,9 @@ sub rsync($self, @args) {
next if _check_stat($file, $vm_local, $node);
my $msg = $self->_msg_log_rsync($file, $node, "rsync", $request);
$request->status("syncing") if $request;
$request->status("syncing") if $request;
$request->error("Syncing $file") if $request;
$request->error($msg) if $request && $DEBUG_RSYNC;
$request->error($msg) if $request && $DEBUG_RSYNC;