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

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

parents fd63ae7e d850e25e
......@@ -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)
......
......@@ -1262,6 +1262,7 @@ 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');
$self->_upgrade_table('domains','screenshot','BLOB');
$self->_upgrade_table('domains_network','allowed','int not null default 1');
$self->_upgrade_table('iptables','id_vm','int DEFAULT NULL');
......@@ -2250,7 +2251,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)
......@@ -2286,7 +2287,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 "
......@@ -2487,14 +2489,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 {
......@@ -2599,8 +2598,7 @@ sub _wait_pids {
for my $type ( keys %{$self->{pids}} ) {
for my $pid ( keys %{$self->{pids}->{$type}}) {
my $kid = waitpid($pid , WNOHANG);
last if $kid <= 0 ;
push @done, ($kid);
push @done, ($pid) if $kid == $pid || $kid == -1;
}
}
return if !@done;
......
......@@ -1312,6 +1312,7 @@ sub info($self, $user) {
,pool_clones => $self->pool_clones
,is_pool => $self->is_pool
,comment => $self->_data('comment')
,screenshot => $self->_data('screenshot')
};
if ($is_active) {
eval {
......@@ -1487,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();
......@@ -1517,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;
}
sub _remove_access_attributes_db($self) {
return if !$self->{_data}->{id};
......@@ -1777,6 +1787,8 @@ sub _convert_png {
$in->Scale(width => 250, height => 188);
$in->Write("png24:$file_out");
my @blobs = $in->ImageToBlob(magick => 'png');
return $blobs[0];
chmod 0755,$file_out or die "$! chmod 0755 $file_out";
}
......@@ -2548,7 +2560,7 @@ sub list_ports($self) {
for my $data (@ports_base) {
next if exists $clone_port{$data->{internal_port}};
unlock_hash(%$data);
$data->{public_port} = $self->_vm->_new_free_port();
$data->{public_port} = $self->_vm->_new_free_port() if $self->_vm;
lock_hash(%$data);
push @list,($data);
}
......
......@@ -15,6 +15,7 @@ use File::Copy;
use File::Path qw(make_path);
use Hash::Util qw(lock_keys lock_hash);
use IPC::Run3 qw(run3);
use MIME::Base64;
use Moose;
use Sys::Virt::Stream;
use Sys::Virt::Domain;
......@@ -1213,13 +1214,7 @@ sub handler {
return $n;
}
sub screenshot {
my $self = shift;
my $file = (shift or $self->_file_screenshot);
my ($path) = $file =~ m{(.*)/};
make_path($path) if ! -e $path;
sub screenshot($self) {
$self->domain($self->_vm->vm->get_domain_by_name($self->name));
my $stream = $self->{_vm}->vm->new_stream();
......@@ -1229,7 +1224,9 @@ sub screenshot {
my $file_tmp = "/var/tmp/$$.tmp";
$stream->finish;
$self->_convert_png($file_tmp,$file);
my $file = "$file_tmp.png";
my $blob_file = $self->_convert_png($file_tmp,$file);
$self->_data(screenshot => encode_base64($blob_file));
unlink $file_tmp or warn "$! removing $file_tmp";
}
......
......@@ -13,6 +13,8 @@ use Hash::Util qw(lock_keys);
use IPC::Run3 qw(run3);
use Moose;
use YAML qw(Load Dump LoadFile DumpFile);
use Image::Magick;
use MIME::Base64;
use Ravada::Volume;
......@@ -450,13 +452,13 @@ sub list_volumes_info($self, $attribute=undef, $value=undef) {
sub screenshot {
my $self = shift;
my $file = (shift or $self->_file_screenshot);
my @cmd =($CONVERT,'-size', '400x300', 'xc:white'
,$file
);
my ($in,$out,$err);
run3(\@cmd, \$in, \$out, \$err);
my $DPI = 300; # 600;
my $image = Image::Magick->new(density => $DPI,width=>100, height=>100);
$image = Image::Magick->new;
$image->Set(size=>'100x100');
$image->ReadImage('canvas:white');
$image->Set('pixel[49,49]'=>'red');
$self->_data(screenshot => encode_base64($image));
}
sub _file_screenshot {
......
......@@ -132,7 +132,7 @@ sub list_machines_user {
my $user = shift;
my $sth = $CONNECTOR->dbh->prepare(
"SELECT id,name,is_public, file_screenshot"
"SELECT id,name,is_public, screenshot"
." FROM domains "
." WHERE is_base=1"
." ORDER BY name "
......@@ -169,7 +169,7 @@ sub list_machines_user {
);
}
$base{name_clone} = $clone->name;
$base{screenshot} = ( $clone->_data('file_screenshot')
$base{screenshot} = ( $clone->_data('screenshot')
or $base{screenshot});
$base{is_active} = $clone->is_active;
$base{id_clone} = $clone->id;
......
......@@ -1272,7 +1272,7 @@ sub create_iptables_chain($self, $chain, $jchain='INPUT') {
}
sub iptables($self, @args) {
my @cmd = ('/sbin/iptables');
my @cmd = ('/sbin/iptables','-w');
for ( ;; ) {
my $key = shift @args or last;
my $field = "-$key";
......
......@@ -956,7 +956,7 @@ post '/request/(:name)/' => sub {
,uid => $USER->id
,%$args
);
return $c->render(json => { ok => 1 });
return $c->render(json => { ok => 1, request => $req });
};
get '/request/(:id).(:type)' => sub {
......@@ -1173,17 +1173,19 @@ sub user_settings {
get '/img/screenshots/:file' => sub {
my $c = shift;
my $file = $c->param('file');
my $path = $DOCUMENT_ROOT."/".$c->req->url->to_abs->path;
my ($id_domain) =$path =~ m{/(\d+)\..+$};
my $domain = $RAVADA->search_domain_by_id($id_domain);
my ($id_domain ) =$path =~ m{/(\d+)\..+$};
my $image = new Image::Magick;
my $sshot = $image->BlobToImage($domain->get_info()->{screenshot});
if (!$id_domain) {
warn"ERROR : no id domain in $path";
return $c->reply->not_found;
}
if ($USER && !$USER->is_admin) {
my $domain = $RAVADA->search_domain_by_id($id_domain);
#my $domain = $RAVADA->search_domain_by_id($id_domain);
return $c->reply->not_found if !$domain;
unless ($domain->is_base && $domain->is_public) {
return access_denied($c) if $USER->id != $domain->id_owner;
......@@ -1305,7 +1307,7 @@ sub login {
my @languages = I18N::LangTags::implicate_supers(
I18N::LangTags::Detect::detect()
);
my $header = $c->req->headers->header('accept-language');
my $header = ( $c->req->headers->header('accept-language') or '');
my @languages2 = map {s/^(.*?)[;-].*/$1/; $_ } split /,/,$header;
Ravada::Request->post_login(
......@@ -1719,7 +1721,8 @@ sub init {
$home->detect();
if (exists $ENV{MORBO_VERBOSE}
|| (exists $ENV{MOJO_MODE} && $ENV{MOJO_MODE} =~ /devel/i )) {
|| (exists $ENV{MOJO_MODE} && defined $ENV{MOJO_MODE}
&& $ENV{MOJO_MODE} =~ /devel/i )) {
return if -e $home->rel_file("public");
}
app->static->paths->[0] = ($CONFIG_FRONT->{dir}->{public}
......
......@@ -21,6 +21,7 @@ CREATE TABLE `domains` (
, `info` varchar(255) default NULL
, `internal_id` varchar(64) DEFAULT NULL
, `needs_resetart`int not null default 0
, `screenshot` BLOB
, UNIQUE (`id_base`,`name`)
, UNIQUE (`name`)
);
......@@ -153,6 +153,24 @@ sub test_start {
}
sub test_screenshot_db {
my $vm_name = shift;
my $domain_name = shift;
my $domain = $RAVADA->search_domain($domain_name);
$domain->start($USER) if !$domain->is_active();
return if !$domain->can_screenshot();
sleep 2;
$domain->screenshot();
$domain->shutdown(user => $USER, timeout => 1);
my $sth = connector->dbh->prepare("SELECT screenshot FROM domains WHERE id=?");
$sth->execute($domain->id);
my @fields = $sth->fetchrow;
ok($fields[0]);
}
sub test_screenshot {
my $vm_name = shift;
my $domain_name = shift;
......@@ -247,8 +265,7 @@ for my $vm_name (qw(KVM Void)) {
my $domain_name = $domain->name;
$domain = undef;
test_screenshot($vm_name, $domain_name);
test_screenshot_file($vm_name, $domain_name);
test_screenshot_db($vm_name, $domain_name);
};
}
clean();
......
......@@ -251,6 +251,8 @@ sub test_user_bind {
is($mcnulty->{_auth}, 'bind');
test_uid_cn($user, $with_posix_group);
unlink $file_config_bind;
$ravada = Ravada->new(config => $file_config
......@@ -438,43 +440,56 @@ sub test_posix_group {
}
sub test_uid_cn($user, $with_posix_group) {
my $password = 'jameson';
sub _replace_field($entry, $field, $with_posix_group) {
my $old_value = $entry->get_value($field);
die "Error: No $field found in LDAP entry in ".$entry->get_value('cn')
if !$old_value;
my $new_value = new_domain_name();
Ravada::Auth::LDAP::init();
my $ldap = Ravada::Auth::LDAP::_init_ldap_admin();
my $login_ok;
$entry->replace($field => $new_value);
my $mesg = $entry->update($ldap);
confess $mesg->code." ".$mesg->error if $mesg->code && $mesg->code;
for my $field ( qw(uid cn) ) {
diag("Testing login with $field");
_add_to_posix_group($new_value, $with_posix_group);
my $entry = $user->{_ldap_entry};
my $old_value = $entry->get_value($field);
die "Error: No $field found in LDAP entry in ".Dummper($user)
if !$old_value;
return ($old_value, $new_value);
}
eval { $login_ok = Ravada::Auth::login($old_value, $password) };
is($@,'',$old_value);
ok($login_ok, $old_value);
sub test_uid_cn($user, $with_posix_group) {
Ravada::Auth::LDAP::init();
my $ldap = Ravada::Auth::LDAP::_init_ldap_admin();
my $entry = $user->{_ldap_entry};
next if $field eq 'cn';
my $field = 'uid';
my %data = (
cn => $entry->get_value('cn')
,$field => $entry->get_value($field)
my $new_value = new_domain_name();
diag("Testing login with $field $new_value , posix_group=$with_posix_group");
);
$entry->replace($field => $new_value);
my $mesg = $entry->update($ldap);
die $mesg->code." ".$mesg->error if $mesg->code && $mesg->code;
test_login_fields(\%data);
my ($old_value, $new_value) = _replace_field($entry, $field, $with_posix_group);
_add_to_posix_group($new_value, $with_posix_group);
$data{$field} = $new_value;
test_login_fields(\%data);
eval { $login_ok = Ravada::Auth::login($new_value, $password) };
is($@,''," $field: $new_value") or exit;
ok($login_ok, $new_value);
$entry->replace($field => $old_value);
$entry->update($ldap);
}
$entry->replace($field => $old_value);
$entry->update($ldap);
sub test_login_fields($data) {
my $password = 'jameson';
my $login_ok;
for my $field ( sort keys %$data ) {
my $value = $data->{$field};
eval { $login_ok = Ravada::Auth::login($value, $password) };
is($@,''," $field: $value");
ok($login_ok, $value);
}
}
SKIP: {
......@@ -517,7 +532,6 @@ SKIP: {
test_user_bind($user, $fly_config, $with_posix_group);
test_uid_cn($user, $with_posix_group);
remove_users();
};
......
......@@ -57,6 +57,8 @@ create_domain
local_ips
delete_request
remove_old_domains_req
);
our $DEFAULT_CONFIG = "t/etc/ravada.conf";
......@@ -361,6 +363,33 @@ sub remote_config_nodes {
return $conf;
}
sub remove_old_domains_req() {
my $base_name = base_domain_name();
my $machines = rvd_front->list_machines(user_admin);
for my $machine ( @$machines) {
my $domain = Ravada::Front::Domain->open($machine->{id});
next if $domain->name !~ /^$base_name/;
my $n_clones = scalar($domain->clones);
my $req_clone;
for my $clone ($domain->clones) {
$req_clone = Ravada::Request->remove_domain(
name => $clone->{name}
,uid => user_admin->id
);
}
wait_request(debug => 1, background => 1, check_error => 0, timeout => 60+2*$n_clones);
my @after_req = ();
@after_req = ( after_request => $req_clone->id ) if $req_clone;
my $req = Ravada::Request->remove_domain(
name => $machine->{name}
,uid => user_admin->id
);
}
wait_request(debug => 1, background => 1, timeout => 120);
}
sub _remove_old_domains_vm($vm_name) {
confess "Undefined vm_name" if !defined $vm_name;
......@@ -685,6 +714,7 @@ sub wait_request {
$post = '' if !defined $post;
if ( $done_all ) {
for my $req (@$request) {
$req = Ravada::Request->open($req) if !ref($req);
next if $skip{$req->command};
if ($req->status ne 'done') {
$done_all = 0;
......
......@@ -16,7 +16,7 @@ my $SECONDS_TIMEOUT = 15;
my $t;
my $URL_LOGOUT;
my $URL_LOGOUT = '/logout';
my ($USERNAME, $PASSWORD);
my $SCRIPT = path(__FILE__)->dirname->sibling('../rvd_front.pl');
......@@ -27,20 +27,24 @@ sub remove_machines {
my $t0 = time;
for my $name ( @_ ) {
my $domain = rvd_front->search_domain($name) or next;
my $n_clones = scalar($domain->clones);
my $req_clone;
for my $clone ($domain->clones) {
my $req = Ravada::Request->remove_domain(
$req_clone = Ravada::Request->remove_domain(
name => $clone->{name}
,uid => user_admin->id
);
}
_wait_request(debug => 1, background => 1, check_error => 1);
_wait_request(debug => 1, background => 1, check_error => 0, timeout => 60+2*$n_clones);
my @after_req = ();
@after_req = ( after_request => $req_clone->id ) if $req_clone;
my $req = Ravada::Request->remove_domain(
name => $name
,uid => user_admin->id
);
}
_wait_request(debug => 1, background => 1);
_wait_request(debug => 1, background => 1, timeout => 120);
if ( time - $t0 > $SECONDS_TIMEOUT ) {
login();
}
......@@ -58,12 +62,7 @@ sub _wait_request(@args) {
sub login( $user=$USERNAME, $pass=$PASSWORD ) {
if ($URL_LOGOUT) {
$t->get_ok('/logout');
$URL_LOGOUT = $t->tx->req->url->to_abs;
} {
$t->ua->get($URL_LOGOUT);
}
$t->ua->get($URL_LOGOUT);
$t->post_ok('/' => form => {login => $user, password => $pass});
like($t->tx->res->code(),qr/^(200|302)$/);
......@@ -72,6 +71,51 @@ sub login( $user=$USERNAME, $pass=$PASSWORD ) {
exit if !$t->success;
}
sub test_many_clones($base) {
login();
my $n_clones = 30;
$n_clones = 100 if $base->type =~ /Void/i;
$t->post_ok('/machine/copy' => json => {id_base => $base->id, copy_number => $n_clones});
like($t->tx->res->code(),qr/^(200|302)$/) or die $t->tx->res->body->to_string;
my $response = $t->tx->res->json();
ok(exists $response->{request}) or return;
wait_request(request => $response->{request}, background => 1);
login();
$t->post_ok('/request/start_clones' => json =>
{ id_domain => $base->id
,remote_ip => '1.2.3.4'
}
);
like($t->tx->res->code(),qr/^(200|302)$/) or die $t->tx->res->body->to_string;
$response = $t->tx->res->json();
ok(exists $response->{request}) and do {
wait_request(request => $response->{request}, background => 1);
};
for my $clone ( $base->clones ) {
my $req = Ravada::Request->remove_domain(
name => $clone->{name}
,uid => user_admin->id
);
}
}
sub _init_mojo_client {
return if $USERNAME;
$t->get_ok('/')->status_is(200)->content_like(qr/name="login"/);
my $user_admin = user_admin();
my $pass = "$$ $$";
$USERNAME = $user_admin->name;
$PASSWORD = $pass;
login($user_admin->name, $pass);
$t->get_ok('/')->status_is(200)->content_like(qr/choose a machine/i);
}
########################################################################################
......@@ -79,20 +123,11 @@ init('/etc/ravada.conf',0);
my $connector = rvd_back->connector;
like($connector->{driver} , qr/mysql/i) or BAIL_OUT;
remove_old_domains_req();
$t = Test::Mojo->new($SCRIPT);
$t->ua->inactivity_timeout(300);
$t->get_ok('/')->status_is(200)->content_like(qr/name="login"/);
my $user_admin = user_admin();
my $pass = "$$ $$";
$USERNAME = $user_admin->name;
$PASSWORD = $pass;
login($user_admin->name, $pass);
$t->get_ok('/')->status_is(200)->content_like(qr/choose a machine/i);