Commit 6309185f authored by Francesc Guasch's avatar Francesc Guasch Committed by GitHub
Browse files

Release 0.6 (#1241)

parent 547750ae
......@@ -3,27 +3,5 @@
**Implemented enhancements:**
- Pools of virtual machines [\#1115]
- Run Ravada on Ubuntu Eoan [\#1177]
- Test mojo app [\#1137]
- Logout timeout on start machine too quick [\#1119]
- Do not remove the CD from the clones [\#1116]
- Pools of virtual machines [\#1115]
- Multiple copies of machines [\#1091]
- Frontend javascript and CSS from behind Firewall [\#993]
- Improve network ports management [\#265]
**Refactor**
- Refactor disk volumes management [\#1127]
**Bugfixes**
- Slow response with non-shared nodes [\#1188]
- Slides inputs in new machine are not right [\#1154]
- Some pages are displayed raw [\#1138]
- copy with pool fails [\#1131]
- Change current memory fails [\#1123]
- Access option missing in settings machine [\#1098]
- Improve languages detection support [\#1096]
- utf8mb3 character set is not supported [\#492]
......@@ -28,14 +28,6 @@ mentor first timers.
If this is something you think you can fix, then
[fork Ravada](https://help.github.com/articles/fork-a-repo)
and create a branch with a descriptive name. We prepend the issue number to
the branch so it is easier to follow.
A good branch name would be (where issue #77 is the one you're working on):
```sh
git checkout -b fix/77_start_machine
```
## 4. Code Style
......@@ -172,25 +164,15 @@ After working on your changes you need to Push it (upload) your newly created br
Pull requests or PR are proposed changes to a repository submitted by a user and accepted or rejected by a repository's collaborators.
When your changes are done, you should switch back to your master branch and make sure it's
up to date with Ravada's master branch:
```sh
git remote add upstream git@github.com:UPC/ravada.git
git checkout master
git pull --rebase origin master
```
Then update your feature branch from your local copy of master, and push it!
Send your changes to github *pushing* them up:
```sh
git checkout 325_boost_performance
git rebase master
git push --set-upstream origin 325_boost_performance
git push
```
Finally, go to our GitHub repository and
[create a Pull Request](https://github.com/UPC/ravada/pulls)
Finally, go to your GitHub repository and
[create a Pull Request](https://github.com/pulls)
### 10.1 How to Write a Title for a Pull Request
......@@ -211,9 +193,9 @@ To learn more about rebasing in Git, there are a lot of
but here's the suggested workflow:
```sh
git checkout 325_boost_performance
git pull --rebase origin master
git push --force-with-lease origin 325_boost_performance
git remote add upstream https://github.com/UPC/ravada.git
git fetch upstream
git rebase upstream/develop
```
### 10.3 Merging a PR (maintainers only)
......
......@@ -47,6 +47,7 @@ my $LIST;
my $HIBERNATE_DOMAIN;
my $START_DOMAIN;
my $SHUTDOWN_DOMAIN;
my $REMOVE_DOMAIN;
my $REBASE;
my $RUN_REQUEST;
......@@ -80,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"
......@@ -106,6 +108,7 @@ 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
......@@ -443,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;
......@@ -607,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)
......
......@@ -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-ssh2-perl, bridge-utils, libencode-locale-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-ssh2-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
......@@ -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-ssh2-perl, bridge-utils, libencode-locale-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-ssh2-perl, bridge-utils, libencode-locale-perl, libpbkdf2-tiny-perl
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
......@@ -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-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, libpbkdf2-tiny-perl
Description: Remote Virtual Desktops Manager
Ravada is a software that allows the user to connect to a
remote virtual desktop.
......@@ -2,6 +2,7 @@
hypnotoad => {
pid_file => '/var/run/ravada/rvd_front.pid'
,listen => ['http://*:8081']
,proxy => 1
}
,dir => {
templates => '/usr/share/ravada/templates'
......
......@@ -3,7 +3,7 @@ package Ravada;
use warnings;
use strict;
our $VERSION = '0.5.1';
our $VERSION = '0.6.0';
use Carp qw(carp croak);
use Data::Dumper;
......@@ -15,8 +15,9 @@ use Moose;
use POSIX qw(WNOHANG);
use Time::HiRes qw(gettimeofday tv_interval);
use YAML;
use MIME::Base64;
use Socket qw( inet_aton inet_ntoa );
use Image::Magick::Q16;
no warnings "experimental::signatures";
use feature qw(signatures);
......@@ -160,7 +161,7 @@ sub _init_user_daemon {
sub _update_user_grants {
my $self = shift;
$self->_init_user_daemon();
my $sth = $CONNECTOR->dbh->prepare("SELECT id FROM users");
my $sth = $CONNECTOR->dbh->prepare("SELECT id FROM users WHERE is_temporary=0");
my $id;
$sth->execute;
$sth->bind_columns(\$id);
......@@ -168,7 +169,13 @@ sub _update_user_grants {
my $user = Ravada::Auth::SQL->search_by_id($id);
next if $user->name() eq $USER_DAEMON_NAME;
next if $user->grants();
my %grants = $user->grants();
for my $key (keys %grants) {
delete $grants{$key} if !defined $grants{$key};
}
next if keys %grants;
$USER_DAEMON->grant_user_permissions($user);
$USER_DAEMON->grant_admin_permissions($user) if $user->is_admin;
}
......@@ -449,7 +456,28 @@ sub _update_isos {
,xml_volume => 'jessie-volume.xml'
,min_disk_size => '10'
}
,kali_64 => {
name => 'Kali Linux 2020'
,description => 'Kali Linux 2020 64 Bits'
,arch => 'amd64'
,xml => 'jessie-amd64.xml'
,xml_volume => 'jessie-volume.xml'
,url => 'https://cdimage.kali.org/kali-2020.\d+/'
,file_re => 'kali-linux-2020.\d+-installer-amd64.iso'
,sha256_url => '$url/SHA256SUMS'
,min_disk_size => '10'
}
,kali_64_netinst => {
name => 'Kali Linux 2020 (NetInstaller)'
,description => 'Kali Linux 2020 64 Bits (light NetInstall)'
,arch => 'amd64'
,xml => 'jessie-amd64.xml'
,xml_volume => 'jessie-volume.xml'
,url => 'https://cdimage.kali.org/kali-2020.\d+/'
,file_re => 'kali-linux-2020.\d+-installer-netinst-amd64.iso'
,sha256_url => '$url/SHA256SUMS'
,min_disk_size => '10'
}
,windows_7 => {
name => 'Windows 7'
,description => 'Windows 7 64 bits. Requires an user provided ISO image.'
......@@ -526,7 +554,7 @@ sub _scheduled_fedora_releases($self,$data) {
name => 'Fedora '.$release
,description => "RedHat Fedora $release Workstation 64 bits"
,url => 'http://ftp.halifax.rwth-aachen.de/fedora/linux/releases/'.$release
.'/Workstation/x86_64/iso/Fedora-Workstation-netinst-x86_64-'.$release
.'/Workstation/x86_64/iso/Fedora-Workstation-.*-x86_64-'.$release
.'-.*\.iso'
,arch => 'amd64'
,xml => 'xenial64-amd64.xml'
......@@ -990,7 +1018,7 @@ sub _null_grants($self) {
$sth->execute;
my ($count) = $sth->fetchrow;
exit if !$count && $self->{_null}++;
warn "No null grants found" if !$count && $self->{_null_grants}++;
return $count;
}
......@@ -1233,6 +1261,7 @@ sub _upgrade_tables {
$sth->execute;
}
$self->_upgrade_table('users','external_auth','char(32) DEFAULT NULL');
$self->_upgrade_table('users','date_created','timestamp DEFAULT CURRENT_TIMESTAMP');
$self->_upgrade_table('networks','requires_password','int(11)');
$self->_upgrade_table('networks','n_order','int(11) not null default 0');
......@@ -1262,6 +1291,13 @@ sub _upgrade_tables {
$self->_upgrade_table('domains','is_pool','int NOT NULL default 0');
$self->_upgrade_table('domains','needs_restart','int not null default 0');
if ($self->_upgrade_table('domains','screenshot','BLOB')) {
$self->_upgrade_screenshots();
}
$self->_upgrade_table('domains_network','allowed','int not null default 1');
$self->_upgrade_table('iptables','id_vm','int DEFAULT NULL');
......@@ -1426,6 +1462,12 @@ sub _check_config($config_orig = {} , $valid_config = \%VALID_CONFIG ) {
warn "Error: Unknown config entry \n".Dumper(\%config) if ! $0 =~ /\.t$/;
return 0;
}
warn "Warning: LDAP authentication with match is discouraged. Try bind.\n"
if exists $config_orig->{ldap}
&& exists $config_orig->{ldap}->{auth}
&& $config_orig->{ldap}->{auth} =~ /match/
&& $0 !~ /\.t$/;
return 1;
}
......@@ -1578,6 +1620,7 @@ sub create_domain {
my $start = $args{start};
my $id_base = $args{id_base};
my $data = delete $args{data};
my $id_owner = $args{id_owner} or confess "Error: missing id_owner ".Dumper(\%args);
_check_args(\%args,qw(iso_file id_base id_iso id_owner name active swap memory disk id_template start remote_ip request vm add_to_pool));
......@@ -1636,6 +1679,12 @@ sub create_domain {
die $error if $error && !$request;
$request->error($error) if $error;
}
Ravada::Request->add_hardware(
uid => $args{id_owner}
,id_domain => $domain->id
,name => 'disk'
,data => { size => $data, type => 'data' }
) if $domain && $data;
return $domain;
}
......@@ -2488,14 +2537,11 @@ sub _cmd_screenshot {
my $id_domain = $request->args('id_domain');
my $domain = $self->search_domain_by_id($id_domain);
my $bytes = 0;
if (!$domain->can_screenshot) {
die "I can't take a screenshot of the domain ".$domain->name;
} else {
$bytes = $domain->screenshot($request->args('filename'));
$bytes = $domain->screenshot($request->args('filename')) if !$bytes;
}
$request->error("No data received") if !$bytes;
$domain->screenshot();
}
}
sub _cmd_copy_screenshot {
......@@ -2508,16 +2554,33 @@ sub _cmd_copy_screenshot {
my $id_base = $domain->id_base;
my $base = $self->search_domain_by_id($id_base);
if (!$domain->file_screenshot) {
if (!$domain->screenshot) {
die "I don't have the screenshot of the domain ".$domain->name;
} else {
$base->_data(screenshot => $domain->_data('screenshot'));
}
}
my $base_screenshot = $domain->file_screenshot();
sub _upgrade_screenshots($self) {
$base_screenshot =~ s{(.*)/\d+\.(\w+)}{$1/$id_base.$2};
$base->_post_screenshot($base_screenshot);
my $sth = $CONNECTOR->dbh->prepare(
"SELECT id, name, file_screenshot FROM domains WHERE file_screenshot like '%' "
);
$sth->execute();
copy($domain->file_screenshot, $base_screenshot);
my $sth_update = $CONNECTOR->dbh->prepare(
"UPDATE domains set screenshot = ? WHERE id=?"
);
while ( my ($id, $name, $file_path)= $sth->fetchrow ) {
next if ! -e $file_path;
warn "INFO: converting screenshot from $name";
my $file= new Image::Magick::Q16;
$file->Read($file_path);
my @blobs = $file->ImageToBlob(magick => 'png');
eval {
$sth_update->execute(encode_base64($blobs[0]), $id);
};
warn $@;
}
}
......@@ -2647,6 +2710,11 @@ sub _cmd_remove {
$self->remove_domain(name => $request->args('name'), uid => $request->args('uid'));
}
sub _cmd_restore_domain($self,$request) {
my $domain = Ravada::Domain->open($request->args('id_domain'));
return $domain->restore(Ravada::Auth::SQL->search_by_id($request->args('uid')));
}
sub _cmd_pause {
my $self = shift;
my $request = shift;
......@@ -2706,7 +2774,8 @@ sub _cmd_open_iptables {
sub _cmd_clone($self, $request) {
return _req_clone_many($self, $request) if $request->defined_arg('number');
return _req_clone_many($self, $request) if $request->defined_arg('number')
&& $request->defined_arg('number') > 1;
my $domain = Ravada::Domain->open($request->args('id_domain'))
or confess "Error: Domain ".$request->args('id_domain')." not found";
......@@ -2717,7 +2786,7 @@ sub _cmd_clone($self, $request) {
my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'))
or die "Error: User missing, id: ".$request->args('uid');
$args->{user} = $user;
for (qw(id_domain uid at )) {
for (qw(id_domain uid at number )) {
delete $args->{$_};
}
......@@ -2737,6 +2806,15 @@ sub _req_clone_many($self, $request) {
my $domains = $self->list_domains_data();
my %domain_exists = map { $_->{name} => 1 } @$domains;
if (!$base->is_base) {
my $uid = $request->defined_arg('uid');
confess Dumper($request) if !$uid;
my $req_prepare = Ravada::Request->prepare_base(
id_domain => $base->id
, uid => $uid
);
$args->{after_request} = $req_prepare->id;
}
my @reqs;
for ( 1 .. $number ) {
my $n = $_;
......@@ -2801,7 +2879,7 @@ sub _cmd_dettach($self, $request) {
$domain->dettach($user);
}
sub _cmd_rebase_volumes($self, $request) {
sub _cmd_rebase($self, $request) {
my $domain = Ravada::Domain->open($request->id_domain);
my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
......@@ -2809,14 +2887,15 @@ sub _cmd_rebase_volumes($self, $request) {
if !$user->is_admin;
if ($domain->is_active) {
Ravada::Request->shutdown_domain(uid => $user->id, id_domain => $domain->id, timeout => 120);
$request->status("requested");
die "Error: domain ".$domain->name." is still active, shut it down to rebase\n"
my $req_shutdown = Ravada::Request->shutdown_domain(uid => $user->id, id_domain => $domain->id, timeout => 120);
$request->after_request($req_shutdown->id);
die "Warning: domain ".$domain->name." is up, retry.\n"
}
$request->status('working');
my $new_base = Ravada::Domain->open($request->args('id_base'));
$domain->rebase_volumes($new_base);
$domain->rebase($user, $new_base);
}
......@@ -2889,12 +2968,26 @@ sub _cmd_remove_base {
die "Unknown domain id '$id_domain'\n" if !$domain;
$domain->_vm->disconnect();
$self->_disconnect_vm();
$domain->remove_base($user);
}
sub _cmd_spinoff($self, $request) {
my $id_domain = $request->id_domain or confess "Missing request id_domain";
my $uid = $request->args('uid') or confess "Missing argument uid";
my $user = Ravada::Auth::SQL->search_by_id( $uid);
my $domain = $self->search_domain_by_id($id_domain);
die "Unknown domain id '$id_domain'\n" if !$domain;
$domain->spinoff();
}
sub _cmd_hybernate {
my $self = shift;
......@@ -2986,7 +3079,7 @@ sub _cmd_change_hardware {
$domain->change_hardware(
$request->args('hardware')
,$request->args('index')
,$request->defined_arg('index')
,$request->args('data')
);
}
......@@ -3171,24 +3264,6 @@ sub _cmd_refresh_vms($self, $request=undef) {
$self->_refresh_volatile_domains();
}
sub _cmd_change_max_memory($self, $request) {
my $uid = $request->args('uid');
my $id_domain = $request->args('id_domain');
my $memory = $request->args('ram');
my $domain = $self->search_domain_by_id($id_domain);
$domain->set_max_mem($memory);
}
sub _cmd_change_curr_memory($self, $request) {
my $uid = $request->args('uid');
my $id_domain = $request->args('id_domain');
my $memory = $request->args('ram');
my $domain = $self->search_domain_by_id($id_domain);
$domain->set_memory($memory);
}
sub _cmd_shutdown_node($self, $request) {
my $id_node = $request->args('id_node');
my $node = Ravada::VM->open($id_node);
......@@ -3405,15 +3480,19 @@ sub _remove_unnecessary_downs($self, $domain) {
sub _refresh_volatile_domains($self) {
my $sth = $CONNECTOR->dbh->prepare(
"SELECT id, name, id_vm FROM domains WHERE is_volatile=1"
"SELECT id, name, id_vm, id_owner FROM domains WHERE is_volatile=1"
);
$sth->execute();
while ( my ($id_domain, $name, $id_vm) = $sth->fetchrow ) {
while ( my ($id_domain, $name, $id_vm, $id_owner) = $sth->fetchrow ) {
my $domain = Ravada::Domain->open(id => $id_domain, _force => 1);
if ( !$domain || $domain->status eq 'down' || !$domain->is_active) {
if ($domain) {
$domain->_post_shutdown(user => $USER_DAEMON);
$domain->remove($USER_DAEMON);
} else {
my $sth= $CONNECTOR->dbh->prepare("DELETE FROM users WHERE id=?");
$sth->execute($id_owner);
$sth->finish;
}
my $sth_del = $CONNECTOR->dbh->prepare("DELETE FROM domains WHERE id=?");
$sth_del->execute($id_domain);
......@@ -3461,6 +3540,7 @@ sub _cmd_set_base_vm {
sub _cmd_cleanup($self, $request) {
$self->_clean_volatile_machines( request => $request);
$self->_clean_temporary_users( );
$self->_clean_requests('cleanup', $request);
$self->_clean_requests('cleanup', $request,'done');
$self->_clean_requests('enforce_limits', $request,'done');
......@@ -3479,6 +3559,7 @@ sub _req_method {
,pause => \&_cmd_pause
,create => \&_cmd_create
,remove => \&_cmd_remove
,restore_domain => \&_cmd_restore_domain
,resume => \&_cmd_resume
,dettach => \&_cmd_dettach
,cleanup => \&_cmd_cleanup
......@@ -3490,9 +3571,12 @@ sub _req_method {
,add_disk => \&_cmd_add_disk
,copy_screenshot => \&_cmd_copy_screenshot
,cmd_cleanup => \&_cmd_cleanup
,remove_base => \&_cmd_remove_base
,spinoff => \&_cmd_spinoff
,set_base_vm => \&_cmd_set_base_vm
,remove_base_vm => \&_cmd_set_base_vm
,refresh_vms => \&_cmd_refresh_vms
,ping_backend => \&_cmd_ping_backend
,prepare_base => \&_cmd_prepare_base
......@@ -3501,7 +3585,8 @@ 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
,rebase => \&_cmd_rebase
,refresh_storage => \&_cmd_refresh_storage
,refresh_machine => \&_cmd_refresh_machine
,domain_autostart=> \&_cmd_domain_autostart
......@@ -3509,8 +3594,6 @@ sub _req_method {
,add_hardware => \&_cmd_add_hardware
,remove_hardware => \&_cmd_remove_hardware
,change_hardware => \&_cmd_change_hardware
,change_max_memory => \&_cmd_change_max_memory
,change_curr_memory => \&_cmd_change_curr_memory
# Domain ports
,expose => \&_cmd_expose
......@@ -3694,6 +3777,26 @@ sub _enforce_limits_active($self, $request) {
}
}
sub _clean_temporary_users($self) {
my $sth_users = $CONNECTOR->dbh->prepare(
"SELECT u.id, d.id, u.date_created"
." FROM users u LEFT JOIN domains d "
." ON u.id = d.id_owner "
." 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);
}
}
sub _clean_volatile_machines($self, %args) {
my $request = delete $args{request};
......@@ -3708,8 +3811,13 @@ sub _clean_volatile_machines($self, %args) {
);
if ($domain_real) {
next if $domain_real->domain && $domain_real->is_active;
$domain_real->_post_shutdown();
$domain_real->remove($USER_DAEMON);
eval { $domain_real->_post_shutdown() };
warn $@ if $@;
eval { $domain_real->remove($USER_DAEMON) };
warn $@ if $@;
} elsif ($domain->{id_owner}) {
my $sth = $CONNECTOR->dbh->prepare("DELETE FROM users where id=?");
$sth->execute($domain->{id_owner});
}
$sth_remove->execute($domain->{id});
......
......@@ -13,7 +13,10 @@ use Authen::Passphrase;
use Authen::Passphrase::SaltedDigest;
use Carp qw(carp);
use Data::Dumper;
use Digest::SHA qw(sha1_hex);
use Digest::SHA qw(sha1_hex sha256_hex);
use Encode;
</