Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Projets publics
Ravada-Mirror
Commits
c8bed2ba
Commit
c8bed2ba
authored
Aug 13, 2019
by
frankiejol
Browse files
Merge branch '949_fallback' of
https://github.com/UPC/ravada
into 949_fallback
parents
31d656cb
10889a38
Changes
27
Hide whitespace changes
Inline
Side-by-side
bin/rvd_back.pl
View file @
c8bed2ba
...
...
@@ -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
;
...
...
etc/repository/iso/ru/astra_orel_2.yml
0 → 100644
View file @
c8bed2ba
name
:
Astra Linux 2.12.13
description
:
Astra Linux Orel 2.12.13 64 bits
url
:
https://mirrors.edge.kernel.org/astra/current/orel/iso/
file_re
:
orel-2..*.iso
md5_url
:
$url/orel-2.*md5
arch
:
amd64
xml
:
bionic-amd64.xml
xml_volume
:
bionic64-volume.xml
min_disk_size
:
5
lib/Ravada.pm
View file @
c8bed2ba
...
...
@@ -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/Auth/LDAP.pm
View file @
c8bed2ba
...
...
@@ -51,7 +51,7 @@ Internal OO build
sub
BUILD
{
my
$self
=
shift
;
die
"
ERROR: Login failed
"
.
$self
->
name
die
"
ERROR: Login failed
'
"
.
$self
->
name
.
"
'
"
if
!
$self
->
login
;
return
$self
;
}
...
...
@@ -175,6 +175,7 @@ sub search_user {
_init_ldap_admin
();
return
search_user
(
name
=>
$username
,
base
=>
$base
,
field
=>
$field
,
retry
=>
++
$retry
,
typesonly
=>
$typesonly
...
...
@@ -186,8 +187,10 @@ sub search_user {
return
if
!
$mesg
->
count
();
my
@entries
=
$mesg
->
entries
;
# warn join ( "\n",map { $_->dn } @entries);
my
@entries
;
for
my
$entry
(
$mesg
->
entries
)
{
push
@entries
,(
$entry
)
if
$entry
->
get_value
(
$field
)
eq
$username
;
}
return
@entries
;
}
...
...
@@ -321,15 +324,29 @@ sub add_to_group {
sub
login
($self) {
my
$user_ok
;
my
$allowed
;
if
(
$$CONFIG
->
{
ldap
}
->
{
ravada_posix_group
})
{
$allowed
=
search_user
(
name
=>
$self
->
name
,
field
=>
'
memberUid
',
base
=>
$$CONFIG
->
{
ldap
}
->
{
ravada_posix_group
})
||
0
;
$self
->
{
_ldap_entry
}
=
$allowed
;
}
else
{
$allowed
=
1
;
my
$posix_group_name
=
$$CONFIG
->
{
ldap
}
->
{
ravada_posix_group
};
if
(
$posix_group_name
)
{
my
(
$posix_group
)
=
search_user
(
name
=>
$posix_group_name
,
field
=>
'
cn
'
,
base
=>
'
ou=groups,
'
.
_dc_base
()
);
if
(
!
$posix_group
)
{
warn
"
Warning: posix group
$posix_group_name
not found
";
return
;
}
my
@member
=
$posix_group
->
get_value
('
memberUid
');
my
$user_name
=
$self
->
name
;
my
(
$found
)
=
grep
/^$user_name$/
,
@member
;
if
(
!
$found
)
{
warn
"
Error:
$user_name
is not a member of posix group
$posix_group_name
\n
";
warn
Dumper
(
\
@member
)
if
$
Ravada::
DEBUG
;
return
;
}
$self
->
{
_ldap_entry
}
=
$posix_group
;
}
if
(
$allowed
)
{
$user_ok
=
$self
->
_login_bind
()
if
!
exists
$$CONFIG
->
{
ldap
}
->
{
auth
}
||
!
$$CONFIG
->
{
ldap
}
->
{
auth
}
...
...
@@ -339,9 +356,6 @@ sub login($self) {
$self
->
_check_user_profile
(
$self
->
name
)
if
$user_ok
;
$LDAP_ADMIN
->
unbind
if
$LDAP_ADMIN
&&
exists
$self
->
{
_auth
}
&&
$self
->
{
_auth
}
eq
'
bind
';
return
$user_ok
;
}
else
{
return
0
;
}
}
sub
_login_bind
{
...
...
lib/Ravada/Domain.pm
View file @
c8bed2ba
...
...
@@ -35,7 +35,7 @@ our $IPTABLES_CHAIN = 'RAVADA';
our
%PROPAGATE_FIELD
=
map
{
$_
=>
1
}
qw( run_timeout )
;
our
$TIME_CACHE_NETSTAT
=
1
0
;
# seconds to cache netstat data output
our
$TIME_CACHE_NETSTAT
=
6
0
;
# 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 @
c8bed2ba
...
...
@@ -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) {