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

Feature #1115 pools (#1121) 

* feature(frontend): manage pools

issue #1115
parent 237142ee
Hide whitespace changes
Inline Side-by-side
bin/rvd_back.pl
View file @ 6f9f4f40
......@@ -173,6 +173,7 @@ sub do_start {
Ravada::Request->cleanup();
Ravada::Request->refresh_vms() if rand(5)<3;
Ravada::Request->enforce_limits() if rand(5)<2;
Ravada::Request->manage_pools() if rand(5)<2;
$t_refresh = time;
}
sleep 1 if time - $t0 <1;
......
lib/Ravada.pm
View file @ 6f9f4f40
......@@ -1285,9 +1285,14 @@ sub _upgrade_tables {
$self->_upgrade_table('domains','internal_id','varchar(64) DEFAULT NULL');
$self->_upgrade_table('domains','id_vm','int default null');
$self->_upgrade_table('domains','volatile_clones','int NOT NULL default 0');
$self->_upgrade_table('domains','comment',"varchar(80) DEFAULT ''");
$self->_upgrade_table('domains','client_status','varchar(32)');
$self->_upgrade_table('domains','client_status_time_checked','int NOT NULL default 0');
$self->_upgrade_table('domains','pools','int NOT NULL default 0');
$self->_upgrade_table('domains','pool_clones','int NOT NULL default 0');
$self->_upgrade_table('domains','pool_start','int NOT NULL default 0');
$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_network','allowed','int not null default 1');
......@@ -2127,7 +2132,7 @@ sub process_requests {
warn "req ".$req->id." , command: ".$req->command." , status: ".$req->status()
." , error: '".($req->error or 'NONE')."'\n" if $DEBUG || $VERBOSE;
sleep 1 if $DEBUG;
# sleep 1 if $DEBUG;
}
$sth->finish;
......@@ -2402,6 +2407,72 @@ sub _do_execute_command {
}
sub _cmd_manage_pools($self, $request) {
my @domains;
my $id_domain = $request->defined_arg('id_domain');
my $uid = $request->defined_arg('uid');
if (!$uid) {
$uid = Ravada::Utils::user_daemon->id;
$request->arg( uid => $uid );
}
confess if !defined $uid;
if ($id_domain) {
my $domain = Ravada::Domain->open($id_domain)
or die "Error: missing domain ".$id_domain;
push @domains,($domain);
} else {
push @domains, $self->list_domains;
}
for my $domain ( @domains ) {
next if !$domain->pools();
my @clone_pool = $domain->clones(is_pool => 1);
my $number = $domain->pool_clones() - scalar(@clone_pool);
if ($number > 0 ) {
$self->_pool_create_clones($domain, $number, $request);
}
my $count_active = 0;
for my $clone_data (@clone_pool) {
last if $count_active >= $domain->pool_start;
my $clone = Ravada::Domain->open($clone_data->{id});
# warn $clone->name."".($clone->client_status or '')." $count_active >= "
# .$domain->pool_start."\n";
if ( ! $clone->is_active ) {
Ravada::Request->start_domain(
uid => $uid
,id_domain => $clone->id
);
$count_active++;
} else {
$count_active++ if !$clone->client_status
|| $clone->client_status =~ /disconnected/i;
}
}
}
}
sub _pool_create_clones($self, $domain, $number, $request) {
my @arg_clone = ( no_pool => 1 );
$request->status("cloning $number");
if (!$domain->is_base) {
my @requests = $domain->list_requests();
return if grep { $_->command eq 'prepare_base' } @requests;
$request->status("preparing base");
my $req_base = Ravada::Request->prepare_base(
uid => $request->args('uid')
,id_domain => $domain->id
);
push @arg_clone, ( after_request => $req_base->id ) if $req_base;
}
Ravada::Request->clone(
uid => $request->args('uid')
,id_domain => $domain->id
,number => $number
,is_pool => 1
,start => 1
,@arg_clone
);
}
sub _cmd_screenshot {
my $self = shift;
my $request = shift;
......@@ -2449,6 +2520,17 @@ sub _cmd_create{
warn "$$ creating domain ".Dumper($request->args) if $DEBUG;
my $domain;
if ( $request->defined_arg('id_base') ) {
my $base = Ravada::Domain->open($request->args('id_base'));
if ( $base->pools && !$request->defined_arg('no_pools') ) {
$request->{args}->{id_domain} = delete $request->{args}->{id_base};
$request->{args}->{uid} = delete $request->{args}->{id_owner};
my $clone = $self->_cmd_clone($request);
$request->id_domain($clone->id);
return $clone;
}
}
$domain = $self->create_domain(request => $request);
my $msg = '';
......@@ -2597,21 +2679,67 @@ sub _cmd_open_iptables {
}
sub _cmd_clone($self, $request) {
my $number = $request->defined_arg('number');
my $no_pool = $request->defined_arg('no_pool');
return _req_clone_many($self, $request) if $number;
my $domain = Ravada::Domain->open($request->args('id_domain'))
or confess "Error: Domain ".$request->args('id_domain')." not found";
my @args = ( request => $request);
push @args, ( memory => $request->args('memory'))
if $request->defined_arg('memory');
my $args = $request->args();
$args->{request} = $request;
my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'))
or die "Error: User missing, id: ".$request->args('uid');
push @args,(user => $user);
$domain->clone(
name => $request->args('name')
,@args
$args->{user} = $user;
for (qw(id_domain uid at )) {
delete $args->{$_};
}
my $name = ( $request->defined_arg('name') or $domain->name."-".$user->name );
if ( $domain->pools && !$no_pool ) {
my $clone = $domain->_search_pool_clone($user);
my $remote_ip = $request->defined_arg('remote_ip');
my $start = $request->defined_arg('start');
if ($start || $clone->is_active) {
$clone->start(user => $user, remote_ip => $remote_ip);
$clone->_data('client_status', 'connecting ...');
$clone->_data('client_status_time_checked',time);
Ravada::Request->manage_pools( uid => Ravada::Utils::user_daemon->id);
}
return $clone;
}
my $clone = $domain->clone(
name => $name
,%$args
);
}
sub _req_clone_many($self, $request) {
my $args = $request->args();
my $id_domain = $args->{id_domain};
my $base = Ravada::Domain->open($id_domain);
my $number = ( delete $args->{number} or 1 );
my $domains = $self->list_domains_data();
my %domain_exists = map { $_->{name} => 1 } @$domains;
my @reqs;
for ( 1 .. $number ) {
my $n = $_;
my $name;
for ( ;; ) {
while (length($n) < length($number)) { $n = "0".$n };
$name = $base->name."-".$n;
last if !$domain_exists{$name}++;
$n++;
}
$args->{name} = $name;
my $req2 = Ravada::Request->clone( %$args );
push @reqs, ( $req2 );
}
return @reqs;
}
sub _cmd_start {
......@@ -2632,7 +2760,16 @@ sub _cmd_start {
$self->_remove_unnecessary_downs($domain);
$domain->start(user => $user, remote_ip => $request->args('remote_ip'));
my @args = ( user => $user );
push @args, ( remote_ip => $request->defined_arg('remote_ip') )
if $request->defined_arg('remote_ip');
$domain->start(@args);
Ravada::Request->manage_pools(
uid => Ravada::Utils::user_daemon->id
) if $domain->is_pool && $request->defined_arg('remote_ip');
my $msg = 'Domain '
."<a href=\"/machine/view/".$domain->id.".html\">"
.$domain->name."</a>"
......@@ -3372,6 +3509,8 @@ sub _req_method {
#isos
,list_isos => \&_cmd_list_isos
,manage_pools => \&_cmd_manage_pools
);
return $methods{$cmd};
}
......@@ -3518,6 +3657,14 @@ sub _enforce_limits_active($self, $request) {
for my $request ($domain->list_requests) {
next DOMAIN if $request->command =~ /shutdown/;
}
if ($domain->is_pool) {
$domain->id_owner(Ravada::Utils::user_daemon->id);
$domain->_data(comment => '');
Ravada::Request->shutdown(user => Ravada::Utils::user_daemon->id
,id_domain => $domain->id
);
return;
}
if ($domain->can_hybernate && !$domain->is_volatile) {
$domain->hybernate($USER_DAEMON);
} else {
......
lib/Ravada/Domain.pm
View file @ 6f9f4f40
......@@ -35,7 +35,7 @@ our $IPTABLES_CHAIN = 'RAVADA';
our %PROPAGATE_FIELD = map { $_ => 1} qw( run_timeout );
our $TIME_CACHE_NETSTAT = 10; # seconds to cache netstat data output
our $TIME_CACHE_NETSTAT = 60; # seconds to cache netstat data output
_init_connector();
......@@ -883,6 +883,20 @@ sub id($self) {
##################################################################################
sub _execute_request($self, $field, $value) {
my %req = (
pools => 'manage_pools'
,pool_start => 'manage_pools'
,pool_clones => 'manage_pools'
);
my $exec = $req{$field} or return;
Ravada::Request->_new_request(
command => $exec
,args => { id_domain => $self->id , uid => Ravada::Utils::user_daemon->id }
);
}
sub _data($self, $field, $value=undef, $table='domains') {
_init_connector();
......@@ -908,6 +922,7 @@ sub _data($self, $field, $value=undef, $table='domains') {
$sth->finish;
$self->{$data}->{$field} = $value;
$self->_propagate_data($field,$value) if $PROPAGATE_FIELD{$field};
$self->_execute_request($field,$value);
}
return $self->{$data}->{$field} if exists $self->{$data}->{$field};
......@@ -1243,6 +1258,11 @@ sub info($self, $user) {
,has_clones => ( $self->has_clones or undef)
,needs_restart => ( $self->needs_restart or 0)
,type => $self->type
,pools => $self->pools
,pool_start => $self->pool_start
,pool_clones => $self->pool_clones
,is_pool => $self->is_pool
,comment => $self->_data('comment')
};
if ($is_active) {
eval {
......@@ -1597,17 +1617,25 @@ Returns a list of clones from this virtual machine
my @clones = $domain->clones
=cut
sub clones {
my $self = shift;
sub clones($self, %filter) {
_init_connector();
my $sth = $$CONNECTOR->dbh->prepare("SELECT id, id_vm, name FROM domains "
." WHERE id_base = ? AND (is_base=NULL OR is_base=0)");
$sth->execute($self->id);
my $query =
"SELECT id, id_vm, name, id_owner, status, client_status, is_pool"
." FROM domains "
." WHERE id_base = ? AND (is_base=NULL OR is_base=0)";
my @values = ($self->id);
if (keys %filter) {
$query .= "AND ( ".join(" AND ",map { "$_ = ?" } sort keys %filter)." )";
push @values,map {$filter{$_} } sort keys %filter;
}
my $sth = $$CONNECTOR->dbh->prepare($query);
$sth->execute(@values);
my @clones;
while (my $row = $sth->fetchrow_hashref) {
# TODO: open the domain, now it returns only the id
lock_hash(%$row);
push @clones , $row;
}
return @clones;
......@@ -1790,6 +1818,9 @@ sub clone {
my $remote_ip = delete $args{remote_ip};
my $request = delete $args{request};
my $memory = delete $args{memory};
my $start = delete $args{start};
my $is_pool = delete $args{is_pool};
my $no_pool = delete $args{no_pool};
confess "ERROR: Unknown args ".join(",",sort keys %args)
if keys %args;
......@@ -1802,6 +1833,7 @@ sub clone {
}
my @args_copy = ();
push @args_copy, ( start => $start ) if $start;
push @args_copy, ( memory => $memory ) if $memory;
push @args_copy, ( request => $request ) if $request;
push @args_copy, ( remote_ip => $remote_ip) if $remote_ip;
......@@ -1820,6 +1852,7 @@ sub clone {
,id_owner => $uid
,@args_copy
);
$clone->is_pool(1) if $is_pool;
return $clone;
}
......@@ -2473,13 +2506,20 @@ sub _post_start {
$self->get_info();
# get the display so it is stored for front access
if ($self->is_active) {
if ($self->is_active && $arg{remote_ip}) {
$self->_data('client_status', $arg{remote_ip});
$self->_data('client_status_time_checked', time );
$self->display($arg{user});
$self->display_file($arg{user});
$self->info($arg{user});
}
$self->open_exposed_ports();
Ravada::Request->enforce_limits(at => time + 60);
Ravada::Request->manage_pools(
uid => Ravada::Utils::user_daemon->id
) if $self->is_pool;
$self->post_resume_aux;
}
......@@ -2619,6 +2659,7 @@ sub open_iptables {
delete $args{uid};
$self->_data('client_status','connecting...');
$self->_data('client_status_time_checked', time );
$self->_remove_iptables();
if ( !$self->is_active ) {
......@@ -2631,6 +2672,9 @@ sub open_iptables {
die $@ if $@ && $@ !~ /already running/i;
} else {
Ravada::Request->enforce_limits( at => time + 60);
Ravada::Request->manage_pools(
uid => Ravada::Utils::user_daemon->id
)if $self->is_pool;
}
$self->_add_iptable(%args);
......@@ -3480,6 +3524,9 @@ sub _pre_clone($self,%args) {
confess "ERROR: Missing user owner of new domain" if !$user;
for (qw(is_pool start no_pool)) {
delete $args{$_};
}
confess "ERROR: Unknown arguments ".join(",",sort keys %args) if keys %args;
}
......@@ -3584,6 +3631,81 @@ sub is_local($self) {
return $self->_vm->is_local();
}
=head2 pools
Enables or disables pools of clones for this virtual machine
=cut
sub pools($self,$value=undef) {
return $self->_data('pools',$value);
}
=head2 pool_clones
Number of clones of this virtual machine that belong to the pool
=cut
sub pool_clones($self,$value=undef) {
return $self->_data('pool_clones',$value);
}
=head2 pool_start
Number of clones of this virtual machine that are pre-started
=cut
sub pool_start($self,$value=undef) {
return $self->_data('pool_start',$value);
}
sub is_pool($self, $value=undef) {
return $self->_data(is_pool => $value);
}
sub _search_pool_clone($self, $user) {
confess "Error: ".$self->name." is not a base"
if !$self->is_base;
confess "Error: ".$self->name." is not pooled"
if !$self->pools;
my ($clone_down, $clone_free_up, $clone_free_down);
for my $current ( $self->clones) {
if ( $current->{id_owner} == $user->id
&& $current->{status} =~ /^(active|hibernated)$/) {
my $clone = Ravada::Domain->open($current->{id});
$clone->_data( comment => $user->name );
return $clone;
}
if ( $current->{id_owner} == $user->id ) {
$clone_down = $current;
} elsif ($current->{is_pool}) {
my $clone = Ravada::Domain->open($current->{id});
if(!$clone->client_status || $clone->client_status eq 'disconnected') {
if ( $clone->status =~ /^(active|hibernated)$/ ) {
$clone_free_up = $current;
} else {
$clone_free_down = $current;
}
}
}
}
my $clone_data = ($clone_down or $clone_free_up or $clone_free_down);
die "Error: no free clones in pool for ".$self->name
if !$clone_data;
my $clone = Ravada::Domain->open($clone_data->{id});
$clone->id_owner($user->id);
$clone->_data( comment => $user->name );
return $clone;
}
=head2 internal_id
Returns the internal id of this domain as found in its Virtual Manager connection
......@@ -3664,8 +3786,6 @@ you find suitable.
sub client_status($self, $force=0) {
return if !$self->is_active;
return if !$self->remote_ip;
return $self->_data('client_status') if $self->readonly;
......@@ -3673,8 +3793,12 @@ sub client_status($self, $force=0) {
if ( $time_checked < $TIME_CACHE_NETSTAT && !$force ) {
return $self->_data('client_status');
}
my $status = $self->_client_connection_status( $force );
my $status = '';
if ( !$self->is_active || !$self->remote_ip ) {
$status = '';
} else {
$status = $self->_client_connection_status( $force );
}
$self->_data('client_status', $status);
$self->_data('client_status_time_checked', time );
......@@ -3686,9 +3810,8 @@ sub _run_netstat($self, $force=undef) {
&& ( time - $self->_vm->{_netstat_time} < $TIME_CACHE_NETSTAT+1 ) ) {
return $self->_vm->{_netstat};
}
my @cmd = ("netstat", "-tan");
my ($in, $out, $err);
run3(\@cmd, \$in, \$out, \$err);
my @cmd = ("/bin/netstat", "-tan");
my ( $out, $err) = $self->_vm->run_command(@cmd);
$self->_vm->{_netstat} = $out;
$self->_vm->{_netstat_time} = time;
......@@ -3696,8 +3819,6 @@ sub _run_netstat($self, $force=undef) {
}
sub _client_connection_status($self, $force=undef) {
#TODO: this should be run in the VM
# in develop release VM->run_command does exists
my $display = $self->display(Ravada::Utils::user_daemon());
my ($ip, $port) = $display =~ m{\w+://(.*):(\d+)};
die "No ip in $display" if !$ip;
......
lib/Ravada/Front.pm
View file @ 6f9f4f40
......@@ -79,6 +79,7 @@ sub BUILD {
Ravada::_init_config($self->config()) if $self->config;
Ravada::Auth::init($Ravada::CONFIG);
$CONNECTOR->dbh();
@VM_TYPES = @{$Ravada::CONFIG->{vm}};
}
=head2 list_bases
......@@ -252,6 +253,7 @@ sub list_domains($self, %args) {
my $query = "SELECT d.name, d.id, id_base, is_base, id_vm, status, is_public "
." ,vms.name as node , is_volatile, client_status, id_owner "
." ,comment, is_pool"
." FROM domains d LEFT JOIN vms "
." ON d.id_vm = vms.id ";
......
lib/Ravada/Request.pm
View file @ 6f9f4f40
......@@ -29,6 +29,7 @@ Request a command to the ravada backend
=cut
my $COUNT = 0;
our %FIELD = map { $_ => 1 } qw(error output);
our %FIELD_RO = map { $_ => 1 } qw(id name);
......@@ -65,7 +66,7 @@ our %VALID_ARG = (
,screenshot_domain => { id_domain => 1, filename => 2 }
,domain_autostart => { id_domain => 1 , uid => 1, value => 2 }
,copy_screenshot => { id_domain => 1, filename => 2 }
,start_domain => {%$args_manage, remote_ip => 1, name => 2, id_domain => 2 }
,start_domain => {%$args_manage, remote_ip => 2, name => 2, id_domain => 2 }
,start_clones => { id_domain => 1, uid => 1, remote_ip => 1 }
,rename_domain => { uid => 1, name => 1, id_domain => 1}
,dettach => { uid => 1, id_domain => 1 }
......@@ -75,7 +76,10 @@ our %VALID_ARG = (
,refresh_storage => { id_vm => 2 }
,set_base_vm=> {uid => 1, id_vm=> 1, id_domain => 1, value => 2 }
,cleanup => { }
,clone => { uid => 1, id_domain => 1, name => 1, memory => 2 }
,clone => { uid => 1, id_domain => 1, name => 2, memory => 2, number => 2, is_pool => 2
,start => 2, no_pool => 2
,remote_ip => 2
}
,change_owner => {uid => 1, id_domain => 1}
,add_hardware => {uid => 1, id_domain => 1, name => 1, number => 2, data => 2 }
,remove_hardware => {uid => 1, id_domain => 1, name => 1, index => 1}
......@@ -104,6 +108,7 @@ our %VALID_ARG = (
#isos
,list_isos => { vm_type => 1 }
,manage_pools => { uid => 2, id_domain => 2 }
,ping_backend => {}
);
......@@ -473,6 +478,32 @@ sub new_request($self, $command, @args) {
);
}
sub _duplicated_request($command, $args) {
return if !$args;
my $args_d = decode_json($args);
delete $args_d->{uid};
my $sth = $$CONNECTOR->dbh->prepare(
"SELECT id,args FROM requests WHERE status='requested'"
." AND command=?"
);
$sth->execute($command);
while (my ($id,$args_found) = $sth->fetchrow) {
my $args_found_d = decode_json($args_found);
delete $args_found_d->{uid};
next if join(".",sort keys %$args_d) ne join(".",sort keys %$args_found_d);
my $args_d_s = join(".",map { $args_d->{$_} } sort keys %$args_d);
my $args_found_s = join(".",map {$args_found_d->{$_} } sort keys %$args_found_d);
next if $args_d_s ne $args_found_s;
warn "$id\n$args_d_s\n$args_found_s\n"
if $command eq 'clone' && $args =~ /a-1/;
return $id;
}
return 0;
}
sub _new_request {
my $self = shift;
if ( !ref($self) ) {
......@@ -506,6 +537,13 @@ sub _new_request {
$args{args} = encode_json($args{args});
}
_init_connector() if !$CONNECTOR || !$$CONNECTOR;
if ($args{command} =~ /^(clone|manage_pools)$/) {
if ( _duplicated_request($args{command}, $args{args})
|| ( $args{command} ne 'clone' && done_recently(undef, 60, $args{command}))) {
warn "Warning: duplicated request for $args{command} $args{args}";
return;