Skip to content

Commit

Permalink
Merge branch 'main' into release/1.4.0
Browse files Browse the repository at this point in the history
  • Loading branch information
frankiejol committed Mar 28, 2022
2 parents 8cfaef6 + eae3b39 commit 2085b2d
Show file tree
Hide file tree
Showing 20 changed files with 353 additions and 90 deletions.
62 changes: 44 additions & 18 deletions lib/Ravada.pm
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ use Ravada::VM::Void;
our %VALID_VM;
our %ERROR_VM;
our $TIMEOUT_STALE_PROCESS;
our $TIMEOUT_REFRESH_REQUESTS = 0;

eval {
require Ravada::VM::KVM and do {
Expand Down Expand Up @@ -212,10 +213,21 @@ sub _do_create_constraints($self) {
return;
}
$pid_file->touch;

my $dbh = $CONNECTOR->dbh;

my $known_constraints;

for my $constraint (@{$self->{_constraints}}) {
my ($name) = $constraint =~ /CONSTRAINT (\w+)\s/;
my ($table,$name) = $constraint =~ /ALTER TABLE (.*?) .*?CONSTRAINT (\w+)\s/i;
if ( !defined $table ) {
cluck "Warning: I can't find the table in this constraint: $constraint";
next;
}
if (!exists $known_constraints->{$table}) {
my $current = $self->_get_constraints($table);
$known_constraints->{$table} = $current;
}
next if exists $known_constraints->{$table}->{$name};

warn "INFO: creating constraint $name \n"
if $name && !$FIRST_TIME_RUN && $0 !~ /\.t$/;
Expand Down Expand Up @@ -1898,6 +1910,21 @@ sub _sql_create_tables($self) {
,extra => 'TEXT'
}
]
,[
domain_ports => {
id => 'integer NOT NULL PRIMARY KEY AUTO_INCREMENT'
,id_domain => 'integer NOT NULL references `domains` (`id`) ON DELETE CASCADE'
,'id_domain' => 'int(11) NOT NULL'
,'public_port' => 'int(11) DEFAULT NULL'
,'internal_port' => 'int(11) DEFAULT NULL'
,'name' => 'varchar(32) DEFAULT NULL'
,'restricted' => 'int(1) DEFAULT 0'
,'internal_ip' => 'char(200) DEFAULT NULL'
,'is_active' => 'int(1) DEFAULT 0'
,'is_secondary' => 'int(1) DEFAULT 0'
,'id_vm' => 'int(11) DEFAULT NULL'
}
]
,[
group_access => {
id => 'integer NOT NULL PRIMARY KEY AUTO_INCREMENT'
Expand Down Expand Up @@ -2020,6 +2047,7 @@ sub _sql_create_tables($self) {
}

my $sql = "CREATE TABLE $table ( $sql_fields )";

$CONNECTOR->dbh->do($sql);
$self->_create_constraints($table, @constraints);
$created++;
Expand Down Expand Up @@ -2093,6 +2121,7 @@ sub _create_constraints($self, $table, @constraints) {
$sql = "alter table $table add CONSTRAINT $name $sql";
# $CONNECTOR->dbh->do($sql);
push @{$self->{_constraints}},($sql);

}
}

Expand Down Expand Up @@ -2410,13 +2439,6 @@ sub _upgrade_tables {

$self->_upgrade_table('domain_drivers_options','data', 'char(200) ');

$self->_upgrade_table('domain_ports', 'id_domain','int NOT NULL references `domains` (`id`) ON DELETE CASCADE');
$self->_upgrade_table('domain_ports', 'internal_ip','char(200)');
$self->_upgrade_table('domain_ports', 'restricted','int(1) DEFAULT 0');
$self->_upgrade_table('domain_ports', 'is_active','int(1) DEFAULT 0');
$self->_upgrade_table('domain_ports', 'is_secondary','int(1) DEFAULT 0');
$self->_upgrade_table('domain_ports', 'id_vm','int DEFAULT NULL');

$self->_upgrade_table('messages','date_changed','timestamp DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP');

$self->_upgrade_table('grant_types', 'is_int', 'int DEFAULT 0');
Expand Down Expand Up @@ -3369,9 +3391,13 @@ sub process_requests {
." or priority"
if $request_type !~ /^(long|huge|priority|all)$/;

$self->_wait_pids();
$self->_kill_stale_process();
$self->_kill_dead_process();
if (time - $TIMEOUT_REFRESH_REQUESTS > 60) {
$TIMEOUT_REFRESH_REQUESTS = time;
$self->_wait_pids();
$self->_kill_stale_process();
$self->_kill_dead_process();
$self->_timeout_requests();
}

my $sth = $CONNECTOR->dbh->prepare("SELECT id,id_domain FROM requests "
." WHERE "
Expand All @@ -3397,7 +3423,7 @@ sub process_requests {

next if $duplicated{"id_req.$id_request"}++;
next if $req->command !~ /shutdown/i
&& $self->_domain_working($id_domain, $id_request);
&& $self->_domain_working($id_domain, $req);

my $domain = '';
$domain = $id_domain if $id_domain;
Expand Down Expand Up @@ -3437,7 +3463,6 @@ sub process_requests {

}

$self->_timeout_requests();
warn Dumper([map { $_->id." ".($_->pid or '')." ".$_->command." ".$_->status }
grep { $_->id } @reqs ])
if ($DEBUG || $debug ) && @reqs;
Expand Down Expand Up @@ -3617,12 +3642,11 @@ sub _kill_dead_process($self) {

sub _domain_working {
my $self = shift;
my ($id_domain, $id_request) = @_;
my ($id_domain, $req) = @_;

confess "Missing id_request" if !defined$id_request;
confess "Missing request" if !defined $req;

if (!$id_domain) {
my $req = Ravada::Request->open($id_request);
$id_domain = $req->defined_arg('id_base');
if (!$id_domain) {
my $domain_name = $req->defined_arg('name');
Expand All @@ -3644,7 +3668,7 @@ sub _domain_working {
." AND command NOT LIKE 'refresh_machine%' "
." )"
);
$sth->execute($id_request, $id_domain);
$sth->execute($req->id, $id_domain);
my ($id, $status) = $sth->fetchrow;
# warn "CHECKING DOMAIN WORKING "
# ."[$id_request] id_domain $id_domain working in request ".($id or '<NULL>')
Expand Down Expand Up @@ -5201,6 +5225,8 @@ sub _reopen_ports($self, $port) {
Ravada::Request->open_exposed_ports(
uid => Ravada::Utils::user_daemon->id
,id_domain => $id_domain
,_force => 1
, retry => 20
) if $domain->is_active;
}

Expand Down
16 changes: 12 additions & 4 deletions lib/Ravada/Domain.pm
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ Ravada::Domain - Domains ( Virtual Machines ) library for Ravada
=cut

use Carp qw(carp confess croak cluck);
use Carp qw(carp confess croak);
use Data::Dumper;
use File::Copy qw(copy move);
use File::Rsync;
Expand Down Expand Up @@ -358,7 +358,8 @@ sub _around_start($orig, $self, @arg) {
;# pool has asynchronous jobs running.
next if $error && ref($error) && $error->code == 1
&& $error !~ /internal error.*unexpected address/
&& $error !~ /process exited while connecting to monitor/;
&& $error !~ /process exited while connecting to monitor/
&& $error !~ /Could not run .*swtpm/i;

if ($error && $self->id_base && !$self->is_local && $self->_vm->enabled) {
$self->_request_set_base();
Expand Down Expand Up @@ -1427,6 +1428,8 @@ sub _fix_duplicate_display_port($self, $port) {
Ravada::Request->open_exposed_ports(
uid => Ravada::Utils::user_daemon->id
,id_domain => $id_domain
,retry => 20
,_force => 1
) if $is_active;
}

Expand Down Expand Up @@ -3353,9 +3356,12 @@ sub _open_exposed_port($self, $internal_port, $name, $restricted) {
my ($id_port, $public_port) = $sth->fetchrow();

my $internal_ip = $self->ip;
confess "Error: I can't get the internal IP of ".$self->name
die "Error: I can't get the internal IP of ".$self->name." ".($internal_ip or '<UNDEF>').". Retry."
if !$internal_ip || $internal_ip !~ /^(\d+\.\d+)/;

die "Error: No NAT ip in domain ".$self->name." found. Retry.\n"
if !$self->_vm->_is_ip_nat($internal_ip);

if ($public_port
&& ( $self->_used_ports_iptables($public_port, "$internal_ip:$internal_port")
|| $self->_used_port_displays($public_port,$id_port))
Expand Down Expand Up @@ -3892,6 +3898,8 @@ sub _check_port_conflicts($self) {
uid => Ravada::Utils::user_daemon->id
,id_domain => $id_domain
,after_request => $req_close->id
,retry => 20
,_force => 1
);
}
}
Expand Down Expand Up @@ -5467,7 +5475,7 @@ sub _get_display_port($self, $display) {
= grep { lc($_->{name}) eq lc($display->{driver}) || lc($_->{value}) eq lc($display->{driver})}
$driver->get_options;

confess "Error: unknown display driver $display->{driver}" if !$selected;
confess "Error: unknown display driver $display->{driver} ".Dumper([$driver->get_options]) if !$selected;

die "Error: display driver port not defined ".Dumper($selected)
unless defined $selected->{data};
Expand Down
20 changes: 17 additions & 3 deletions lib/Ravada/Domain/KVM.pm
Original file line number Diff line number Diff line change
Expand Up @@ -2533,9 +2533,23 @@ sub _check_uuid($self, $doc, $node) {

}

sub _check_machine($self,$doc) {
sub _check_machine($self,$doc, $node) {
my ($os_type) = $doc->findnodes('/domain/os/type');
$os_type->setAttribute( machine => 'pc');
my $machine = $os_type->getAttribute('machine');

my ($machine_bare) = $machine =~ /(.*)-\d+\.\d+$/;
my %machine_types = $node->list_machine_types;
my $new_machine = $machine;

my $arch = $os_type->getAttribute('arch');
for my $try ( @{$machine_types{$arch}} ) {
if ($try eq $machine) {
$new_machine = $try;
last;
}
$new_machine = $try if $try =~ /^$machine_bare/;
}
$os_type->setAttribute( machine => $new_machine);
}

sub migrate($self, $node, $request=undef) {
Expand All @@ -2551,7 +2565,7 @@ sub migrate($self, $node, $request=undef) {
my $xml = $self->domain->get_xml_description();

my $doc = XML::LibXML->load_xml(string => $xml);
$self->_check_machine($doc);
$self->_check_machine($doc, $node);
for ( ;; ) {
$self->_check_uuid($doc, $node);
eval { $dom = $node->vm->define_domain($doc->toString()) };
Expand Down
Loading

0 comments on commit 2085b2d

Please sign in to comment.