Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Projets publics
Ravada-Mirror
Commits
44e1c0be
Commit
44e1c0be
authored
Jan 19, 2018
by
Francesc Guasch
Browse files
[#202] cache active domains
parent
66a499a3
Changes
5
Hide whitespace changes
Inline
Side-by-side
lib/Ravada.pm
View file @
44e1c0be
...
...
@@ -717,6 +717,8 @@ sub _upgrade_tables {
$self
->
_upgrade_table
('
vms
','
public_ip
',"
varchar(128) DEFAULT NULL
");
$self
->
_upgrade_table
('
requests
','
at_time
','
int(11) DEFAULT NULL
');
$self
->
_upgrade_table
('
requests
','
pid
','
int(11) DEFAULT NULL
');
$self
->
_upgrade_table
('
requests
','
start_time
','
int(11) DEFAULT NULL
');
$self
->
_upgrade_table
('
iso_images
','
rename_file
','
varchar(80) DEFAULT NULL
');
$self
->
_clean_iso_mini
();
...
...
@@ -1044,7 +1046,12 @@ sub search_domain($self, $name, $import = 0) {
if
(
$id_vm
)
{
my
$vm
=
Ravada::
VM
->
open
(
$id_vm
);
return
$vm
->
search_domain
(
$name
);
if
(
!
$vm
->
is_active
)
{
warn
"
Don't search domain
$name
in inactive VM
"
.
$vm
->
name
;
$vm
->
disconnect
();
}
else
{
return
$vm
->
search_domain
(
$name
);
}
}
for
my
$vm
(
@
{
$self
->
vm
})
{
next
if
!
$vm
->
is_active
;
...
...
@@ -1349,6 +1356,7 @@ sub process_requests {
my
$short_commands
=
(
shift
or
0
);
$self
->
_wait_pids_nohang
();
$self
->
_kill_stale_process
();
my
$sth
=
$CONNECTOR
->
dbh
->
prepare
("
SELECT id,id_domain FROM requests
"
.
"
WHERE
"
...
...
@@ -1371,7 +1379,8 @@ sub process_requests {
||
(
!
$long_commands
&&
$LONG_COMMAND
{
$req
->
command
})
)
{
warn
"
[
$debug_type
,
$long_commands
,
$short_commands
] $$ skipping request
"
.
$req
->
command
if
$debug
||
$DEBUG
;
.
$req
->
command
if
$debug
||
$DEBUG
;
next
;
}
next
if
$req
->
command
!~
/shutdown/i
...
...
@@ -1385,14 +1394,7 @@ sub process_requests {
$n_retry
=
0
if
!
$n_retry
;
my
$err
=
$self
->
_execute
(
$req
,
$dont_fork
);
$req
->
error
(
$err
)
if
$err
;
if
(
$err
&&
$err
=~
/libvirt error code: 38/
)
{
if
(
$n_retry
<
3
)
{
warn
$req
->
id
.
"
"
.
$req
->
command
.
"
to retry
"
if
$DEBUG
;
$req
->
status
("
retry
"
.++
$n_retry
)
}
else
{
$req
->
status
("
done
");
}
}
$req
->
status
("
done
");
next
if
!
$DEBUG
&&
!
$debug
;
sleep
1
;
...
...
@@ -1433,6 +1435,24 @@ sub process_all_requests {
}
sub
_kill_stale_process
($self) {
my
$sth
=
$CONNECTOR
->
dbh
->
prepare
(
"
SELECT pid,command,start_time
"
.
"
FROM requests
"
.
"
WHERE start_time<?
"
.
"
AND command = 'refresh_vms'
"
.
"
AND status <> 'done'
"
.
"
AND pid IS NOT NULL
"
);
$sth
->
execute
(
time
-
60
);
while
(
my
(
$pid
,
$command
,
$start_time
)
=
$sth
->
fetchrow
)
{
warn
"
Killing
$command
stale for
"
.
time
-
$start_time
.
"
seconds
\n
";
kill
(
15
,
$pid
);
}
$sth
->
finish
;
}
sub
_domain_working
{
my
$self
=
shift
;
my
(
$id_domain
,
$id_request
)
=
@_
;
...
...
@@ -1503,6 +1523,8 @@ sub _execute {
confess
"
Unknown command
"
.
$request
->
command
if
!
$sub
;
$request
->
pid
(
$$
);
$request
->
start_time
(
time
);
$request
->
error
('');
if
(
$dont_fork
||
!
$CAN_FORK
||
!
$LONG_COMMAND
{
$request
->
command
})
{
...
...
@@ -1518,11 +1540,13 @@ sub _execute {
return
if
$self
->
_wait_children
(
$request
);
$request
->
status
('
working
');
warn
$request
->
command
.
"
forking
";
my
$pid
=
fork
();
die
"
I can't fork
"
if
!
defined
$pid
;
if
(
$pid
==
0
)
{
$self
->
_do_execute_command
(
$sub
,
$request
)
$self
->
_do_execute_command
(
$sub
,
$request
)
;
}
else
{
$request
->
pid
(
$pid
);
$self
->
_add_pid
(
$pid
,
$request
->
id
);
}
# $self->_connect_vm_kvm();
...
...
@@ -1978,6 +2002,61 @@ sub _cmd_refresh_storage($self, $request) {
$vm
->
refresh_storage
();
}
sub
_cmd_refresh_vms
($self, $request) {
my
(
$active_domain
,
$active_vm
)
=
$self
->
_refresh_active_domains
(
$request
);
$self
->
_refresh_down_domains
(
$active_domain
,
$active_vm
);
}
sub
_refresh_active_domains
($self, $request) {
my
$id_domain
=
$request
->
defined_arg
('
id_domain
');
my
%active_domain
;
my
%active_vm
;
for
my
$vm
(
$self
->
list_vms
)
{
warn
$vm
->
name
.
"
"
.
$vm
->
host
.
"
\n
";
if
(
!
$vm
->
is_active
)
{
warn
"
\t
down
\n
";
$active_vm
{
$vm
->
id
}
=
0
;
$vm
->
disconnect
();
next
;
}
$active_vm
{
$vm
->
id
}
=
1
;
if
(
$id_domain
)
{
my
$domain
=
$vm
->
search_domain_by_id
(
$id_domain
)
or
next
;
my
$is_active
=
$domain
->
is_active
();
$domain
->
_set_data
(
is_active
=>
$is_active
);
$active_domain
{
$domain
->
id
}
=
$is_active
;
}
else
{
for
my
$domain
(
$vm
->
list_domains
(
active
=>
1
))
{
my
$is_active
=
$domain
->
is_active
;
$domain
->
_set_data
(
is_active
=>
$is_active
);
$active_domain
{
$domain
->
id
}
=
$is_active
;
}
}
warn
"
\t
checked
\n
";
}
return
\
%active_domain
,
\
%active_vm
;
}
sub
_refresh_down_domains
($self, $active_domain, $active_vm) {
my
$sth
=
$CONNECTOR
->
dbh
->
prepare
(
"
SELECT id, name, id_vm FROM domains WHERE is_active=1
"
);
warn
"
refresh down domains
\n
";
$sth
->
execute
();
while
(
my
(
$id_domain
,
$name
,
$id_vm
)
=
$sth
->
fetchrow
)
{
warn
"
checking if domain
$name
is still active
\n
";
next
if
exists
$active_domain
->
{
$id_domain
};
my
$domain
=
Ravada::
Domain
->
open
(
$id_domain
);
if
(
!
$active_vm
->
{
$id_vm
})
{
$domain
->
_set_data
(
is_active
=>
0
);
}
else
{
$domain
->
_set_data
(
is_active
=>
$domain
->
is_active
);
}
}
}
sub
_cmd_set_base_vm
{
my
$self
=
shift
;
my
$request
=
shift
;
...
...
@@ -2029,6 +2108,7 @@ sub _req_method {
,
list_vm_types
=>
\
&_cmd_list_vm_types
,
force_shutdown
=>
\
&_cmd_force_shutdown
,
refresh_storage
=>
\
&_cmd_refresh_storage
,
refresh_vms
=>
\
&_cmd_refresh_vms
);
return
$methods
{
$cmd
};
...
...
lib/Ravada/Domain.pm
View file @
44e1c0be
...
...
@@ -204,7 +204,8 @@ sub BUILD {
my
$self
=
shift
;
$self
->
is_known
();
$self
->
_check_clean_shutdown
();
eval
{
$self
->
_check_clean_shutdown
()
};
# warn $@ if $@;
}
sub
_check_clean_shutdown
($self) {
...
...
@@ -291,8 +292,9 @@ sub _start_preconditions{
return
if
$self
->
_search_already_started
();
# if it is a clone ( it is not a base )
if
(
$self
->
id_base
)
{
$self
->
_set_last_vm
(
1
)
or
$self
->
_balance_vm
();
$self
->
rsync
()
if
!
$self
->
_vm
->
readonly
&&
$self
->
_vm
->
host
ne
'
localhost
';
# $self->_set_last_vm(1)
$self
->
_balance_vm
();
$self
->
rsync
()
if
!
$self
->
_vm
->
readonly
&&
!
$self
->
_vm
->
is_local
;
}
}
...
...
@@ -312,6 +314,7 @@ sub _search_already_started($self) {
$self
->
_set_vm
(
$vm
,'
force
');
$self
->
_update_id_vm
();
$started
{
$vm
->
id
}
++
;
$domain
->
_data
(
is_active
=>
1
)
if
$domain
->
is_active
;
}
}
confess
"
ERROR: Domain started in
"
.
Dumper
(
\
%started
)
...
...
@@ -341,7 +344,7 @@ sub _balance_vm($self) {
my
$vm_free
=
Ravada::
VM
->
open
(
$id
);
$self
->
migrate
(
$vm_free
);
$self
->
migrate
(
$vm_free
)
if
!
$vm_free
->
is_local
;
return
$id
;
}
}
...
...
@@ -1296,6 +1299,7 @@ sub _remove_iptables {
my
%rule
;
for
my
$row
(
$self
->
_active_iptables
(
$args
->
{
user
}))
{
my
(
$id
,
$id_vm
,
$iptables
)
=
@$row
;
next
if
!
$id_vm
;
push
@
{
$rule
{
$id_vm
}},[
$id
,
$iptables
];
}
for
my
$id_vm
(
keys
%rule
)
{
...
...
@@ -1348,6 +1352,7 @@ sub _post_start {
}
else
{
%arg
=
@_
;
}
$self
->
_set_data
(
is_active
=>
1
);
$self
->
_add_iptable
(
@
_
);
$self
->
_update_id_vm
();
...
...
@@ -1360,7 +1365,6 @@ sub _post_start {
);
}
$self
->
_set_data
(
is_active
=>
1
);
}
sub
_update_id_vm
($self) {
...
...
@@ -1652,6 +1656,7 @@ sub run_timeout {
sub
_set_data
($self, $field, $value=undef) {
if
(
defined
$value
)
{
warn
$self
->
name
.
"
$field
=
$value
\n
";
my
$sth
=
$$CONNECTOR
->
dbh
->
prepare
("
UPDATE domains set
$field
=?
"
.
"
WHERE id=?
");
$sth
->
execute
(
$value
,
$self
->
id
);
...
...
lib/Ravada/VM.pm
View file @
44e1c0be
...
...
@@ -227,6 +227,9 @@ sub _pre_create_domain {
}
sub
_connect_rex
($self) {
confess
"
Don't connect to local rex
"
if
$self
->
is_local
;
return
if
!
$self
->
ping
();
my
@pwd
=
getpwuid
(
$>
);
...
...
@@ -241,9 +244,10 @@ sub _connect_rex($self) {
return
$self
->
{
_rex_connection
}
if
$self
->
{
_rex_connection
}
->
{
conn
}
->
{
connected
}
}
cluck
"
connecting to
"
.
$self
->
host
;
my
$connection
;
eval
{
Rex::Commands::
timeout
(
60
);
Rex::Commands::
max_connect_retries
(
3
);
$connection
=
Rex::
connect
(
server
=>
$self
->
host
,
user
=>
"
root
",
...
...
@@ -644,8 +648,15 @@ sub ping($self) {
}
sub
is_active
($self) {
return
1
if
$self
->
is_local
&&
$self
->
vm
;
return
0
if
$self
->
is_local
&&
!
$self
->
vm
;
if
(
$self
->
is_local
)
{
my
$active
=
0
;
$active
=
1
if
$self
->
vm
;
# store it anyway for the frontend
$self
->
_cached_active
(
$active
);
$self
->
_cached_active_time
(
time
);
return
$active
;
}
return
$self
->
_cached_active
if
time
-
$self
->
_cached_active_time
<
5
;
my
$ret
=
0
;
...
...
lib/Ravada/VM/KVM.pm
View file @
44e1c0be
...
...
@@ -74,7 +74,7 @@ chomp $WGET;
our
$CACHE_DOWNLOAD
=
1
;
our
$
_CREATED_DEFAULT_STORAGE
=
0
;
our
%
_CREATED_DEFAULT_STORAGE
=
()
;
##########################################################################
...
...
@@ -119,11 +119,11 @@ sub _connect {
die
$@
if
$@
&&
$@
!~
/libvirt error code: 38/
;
return
if
!
$vm
;
}
if
(
!
$vm
->
list_storage_pools
&&
!
$_CREATED_DEFAULT_STORAGE
)
{
warn
"
WARNING: No storage pools creating default
\n
";
if
(
!
$vm
->
list_storage_pools
&&
!
$_CREATED_DEFAULT_STORAGE
{
$self
->
host
}
)
{
warn
"
WARNING: No storage pools creating default
\n
";
$self
->
_create_default_pool
(
$vm
);
$_CREATED_DEFAULT_STORAGE
{
$self
->
host
}
++
;
}
$_CREATED_DEFAULT_STORAGE
++
;
$self
->
_check_networks
(
$vm
);
return
$vm
;
}
...
...
@@ -498,7 +498,12 @@ sub list_domains {
confess
"
Missing vm
"
if
!
$self
->
vm
;
my
@list
;
my
@domains
=
$self
->
vm
->
list_all_domains
();
my
@domains
;
if
(
$active
)
{
@domains
=
$self
->
vm
->
list_domains
();
}
else
{
@domains
=
$self
->
vm
->
list_all_domains
();
}
for
my
$name
(
@domains
)
{
my
$domain
;
my
$id
;
...
...
@@ -507,9 +512,9 @@ sub list_domains {
,
_vm
=>
$self
);
next
if
!
$domain
->
is_known
();
next
if
$active
&&
!
$domain
->
is_active
;
#
next if $active && !$domain->is_active;
$id
=
$domain
->
id
();
warn
$@
if
$@
&&
$@
!~
/No DB info/i
;
#
warn $@ if $@ && $@ !~ /No DB info/i;
push
@list
,(
$domain
)
if
$domain
&&
$id
;
}
return
@list
;
...
...
templates/main/vm_base.html.ep
View file @
44e1c0be
...
...
@@ -9,16 +9,24 @@
<div class="form-group">
has clones = <%= $domain->has_clones %><br/>
<form class="form-inline" action="<%= $action %>" method="post">
% for my $node (@$nodes) {
% my $local = ($node->{hostname} eq 'localhost' || $node->{hostname} eq '127.0.0.1');
<div class="row">
<div class="col-md-1">
% my $node_disabled = $domain->is_locked
% || $domain->has_clones
% || !$node->{is_active}
% || 0;
% my $node_disabled_msg = '';
% if ( $domain->is_locked) {
% $node_disabled_msg = "Domain ".$domain->name." is locked";
% }
% if ($domain->has_clones && $local) {
% $node_disabled_msg = "Domain has ".$domain->has_clones." clones in local node";
% }
% if ( !$node->{is_active} ) {
% $node_disabled_msg = "Node inactive";
% }
% my $node_disabled = 0;
% $node_disabled = 1 if $node_disabled_msg;
<input type="checkbox"
ng-disabled="<%= $node_disabled %>"
% if ($domain->base_in_vm($node->{id})) {
...
...
@@ -31,12 +39,7 @@
<label class="control-label" for="<%= $node->{id}%>"><%= $node->{name} %></label>
</div>
<div class="col-md-5">
% if ($domain->base_in_vm($node->{id}) && $domain->has_clones) {
Base can't be removed because it has clones
% }
% if (!$node->{is_active}) {
Node inactive <%= $node->{is_active} %>
% }
node disabled = <%= $node_disabled_msg %>
<br/>
<pre><%= Dumper($node) %></pre>
</div>
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment