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
11cbec40
Commit
11cbec40
authored
Dec 27, 2021
by
Francesc Guasch
Browse files
Merge branch 'main' into develop
parents
c0c228a0
f3fece75
Changes
29
Hide whitespace changes
Inline
Side-by-side
.github/workflows/github-action-test.yml
View file @
11cbec40
...
...
@@ -15,6 +15,8 @@ jobs:
mysql root password
:
root
mysql user
:
'
rvd_user'
# Required if "mysql root password" is empty, default is empty. The superuser for the specified database. Can use secrets, too
mysql password
:
Pword12345*
-
name
:
Update packages
run
:
sudo apt update
-
name
:
Install auth packages
run
:
|
sudo apt-get -y install perl libtest-perl-critic-perl liblist-moreutils-perl libyaml-perl libipc-run3-perl libmojolicious-perl libmojolicious-plugin-i18n-perl libxml-libxml-perl libdbix-connector-perl libmoose-perl libproc-pid-file-perl libimage-magick-perl libdatetime-perl libdatetime-format-dateparse-perl libjson-xs-perl libauthen-passphrase-perl libpbkdf2-tiny-perl libfile-rsync-perl libmoosex-types-netaddr-ip-perl libnet-dns-perl libnet-openssh-perl libio-interface-perl libsys-virt-perl libdbd-sqlite3-perl liblocale-maketext-lexicon-perl qemu-utils make cpanminus libnet-ldap-perl
...
...
@@ -54,3 +56,5 @@ jobs:
run
:
sudo apt install libsys-statistics-linux-perl libtest-moose-more-perl
-
name
:
Test Auth
run
:
prove -lr t/40_auth_sql.t t/60_user_sql.t t/65_user_ldap.t t/66_group_ldap.t t/front/60_ldap.t t/front/70_ldap_access.t t/front/80_access.t t/user
-
name
:
Test Templates
run
:
prove -lr t/17_templates.t
CHANGELOG.md
View file @
11cbec40
...
...
@@ -2,21 +2,15 @@
**Implemented enhancements:**
-
Machine schedule reservation [
\#
1337]
-
Manage nodes and networks settings [
\#
1305]
-
User management part in ravada [
\#
1500]
-
Manage LDAP groups
-
Limit to start virtual machines [
\#
1490]
-
Add access filter to a machine with LDAP groups [
\#
1488]
-
Debian 11 (Bullesye) ISO support [
\#
1580]
**Refactor**
-
Confusing button placement in ports form [
\#
1469]
-
Clones number sequence coherency [
\#
1454]
-
Responsive grants form
-
Review Create Machine form [
\#
1639]
-
Translated using Weblate (Turkish)
-
Translated using Weblate (Chinese (Simplified))
-
Translated using Weblate (German)
-
Added a log file for backend [
\#
1530]
-
Improve description displayed when hovering over [
\#
1511]
**Bugfixes**
-
Linux Mint ISO Download fails [
\#
1576]
-
Machine in a node returns to KVMlocalhost when a machine option is modified [
\#
1440]
-
Can't create machine from Windows iso [#1657]
-
ISO file not showing in new machine form [#1660]
-
Fix private base [#1652]
CONTRIBUTING.md
View file @
11cbec40
...
...
@@ -83,6 +83,7 @@ Your options:
-
perf: A code change that improves performance.
-
refactor: A code change that neither fixes a bug or adds a feature.
-
style: Changes that do not affect the meaning of the code (white-space, formatting, missing semi-colons, etc).
-
wip: Work in Progress
-
test: Adding missing tests or correcting existing tests.
### 5.2 Header: Optional Scope
...
...
Makefile.PL
View file @
11cbec40
...
...
@@ -34,6 +34,7 @@ WriteMakefile(
},
BUILD_REQUIRES
=>
{
'Test::Perl::Critic'
=>
0
,'Test
::
Moose::More' => 0
},
test
=>
{
TESTS
=>
't/*.t t/*/*.t'
}
,
...
...
lib/Ravada.pm
View file @
11cbec40
...
...
@@ -3,7 +3,7 @@ package Ravada;
use
warnings
;
use
strict
;
our
$VERSION
=
'
1.1.
0
';
our
$VERSION
=
'
1.1.
2
';
use
Carp
qw(carp croak cluck)
;
use
Data::
Dumper
;
...
...
@@ -56,14 +56,19 @@ use feature qw(signatures);
our
%VALID_CONFIG
=
(
vm
=>
undef
,
warn_error
=>
undef
,
db
=>
{
user
=>
undef
,
password
=>
undef
,
hostname
=>
undef
,
host
=>
undef
}
,
db
=>
{
user
=>
undef
,
password
=>
undef
,
hostname
=>
undef
,
host
=>
undef
,
db
=>
undef
}
,
ldap
=>
{
admin_user
=>
{
dn
=>
undef
,
password
=>
undef
}
,
filter
=>
undef
,
base
=>
undef
,
auth
=>
undef
,
admin_group
=>
undef
,
ravada_posix_group
=>
undef
,
groups_base
=>
undef
,
field
=>
undef
,
server
=>
undef
,
port
=>
undef
}
,
log
=>
undef
);
=head1 NAME
...
...
@@ -716,6 +721,7 @@ sub _update_isos {
,
xml
=>
'
empty-i386.xml
'
,
xml_volume
=>
'
jessie-volume.xml
'
,
min_disk_size
=>
'
0
'
,
has_cd
=>
0
}
,
empty_64bits
=>
{
name
=>
'
Empty Machine 64 bits
'
...
...
@@ -723,6 +729,7 @@ sub _update_isos {
,
xml
=>
'
empty-amd64.xml
'
,
xml_volume
=>
'
jessie-volume.xml
'
,
min_disk_size
=>
'
0
'
,
has_cd
=>
0
}
);
$self
->
_scheduled_fedora_releases
(
\
%data
)
if
$
0
!~
/\.t$/
;
...
...
@@ -2332,6 +2339,7 @@ sub _upgrade_tables {
$self
->
_upgrade_table
('
iso_images
','
file_re
','
char(64)
');
$self
->
_upgrade_table
('
iso_images
','
device
','
varchar(255)
');
$self
->
_upgrade_table
('
iso_images
','
min_disk_size
','
int (11) DEFAULT NULL
');
$self
->
_upgrade_table
('
iso_images
','
has_cd
','
int (1) DEFAULT "1"
');
$self
->
_upgrade_table
('
users
','
language
','
char(40) DEFAULT NULL
');
if
(
$self
->
_upgrade_table
('
users
','
is_external
','
int(11) DEFAULT 0
'))
{
...
...
@@ -2492,7 +2500,8 @@ sub display_ip($self=undef, $new_ip=undef) {
$CONFIG
->
{
display_ip
}
=
$new_ip
;
}
}
my
$ip
=
$CONFIG
->
{
display_ip
};
my
$ip
;
$ip
=
$CONFIG
->
{
display_ip
}
if
exists
$CONFIG
->
{
display_ip
};
return
$ip
if
$ip
;
}
...
...
@@ -2533,6 +2542,7 @@ sub _init_config {
delete
$default_vms
{
Void
};
$CONFIG
->
{
vm
}
=
[
keys
%default_vms
];
}
# lock_hash(%$CONFIG);
# $CONNECTOR = ( $connector or _connect_dbh());
_init_config_vm
();
...
...
@@ -2582,19 +2592,19 @@ sub _create_vm_kvm {
return
$vm_kvm
;
}
sub
_check_config
($config_orig = {}
,
$valid_config
=
\
%VALID_CONFIG
)
{
sub
_check_config
($config_orig = {}
,
$valid_config
=
\
%VALID_CONFIG
,
$quiet
=
$
0
=~
/\.t$/
)
{
return
1
if
!
defined
$config_orig
;
my
%config
=
%$config_orig
;
for
my
$key
(
sort
keys
%$valid_config
)
{
if
(
$config
{
$key
}
&&
ref
(
$valid_config
->
{
$key
}))
{
my
$ok
=
_check_config
(
$config
{
$key
}
,
$valid_config
->
{
$key
}
);
my
$ok
=
_check_config
(
$config
{
$key
}
,
$valid_config
->
{
$key
}
,
$quiet
);
return
0
if
!
$ok
;
}
delete
$config
{
$key
};
}
if
(
keys
%config
)
{
warn
"
Error: Unknown config entry
\n
"
.
Dumper
(
\
%config
)
if
!
$
0
=~
/\.t$/
;
warn
"
Error: Unknown config entry
\n
"
.
Dumper
(
\
%config
)
if
!
$
quiet
;
return
0
;
}
warn
"
Warning: LDAP authentication with match is discouraged. Try bind.
\n
"
...
...
@@ -4596,9 +4606,6 @@ sub _cmd_set_driver {
sub
_cmd_refresh_storage
($self, $request=undef) {
if
(
$request
&&
(
my
$recent
=
$request
->
done_recently
(
60
)))
{
die
"
Command
"
.
$request
->
command
.
"
run recently by
"
.
$recent
->
id
.
"
\n
";
}
my
$vm
;
if
(
$request
&&
$request
->
defined_arg
('
id_vm
'))
{
$vm
=
Ravada::
VM
->
open
(
$request
->
defined_arg
('
id_vm
'));
...
...
lib/Ravada/Auth.pm
View file @
11cbec40
...
...
@@ -22,7 +22,7 @@ Initializes the submodules
sub
init
{
my
(
$config
,
$db_con
)
=
@_
;
if
(
$config
->
{
ldap
}
&&
(
!
defined
$LDAP_OK
||
$LDAP_OK
)
)
{
if
(
exists
$config
->
{
ldap
}
&&
$config
->
{
ldap
}
&&
(
!
defined
$LDAP_OK
||
$LDAP_OK
)
)
{
eval
{
$LDAP_OK
=
0
;
require
Ravada::Auth::
LDAP
;
...
...
@@ -34,7 +34,7 @@ sub init {
$LDAP_OK
=
0
;
}
if
(
$config
->
{
sso
}
&&
(
!
defined
$SSO_OK
||
$SSO_OK
)
)
{
if
(
exists
$config
->
{
sso
}
&&
$config
->
{
sso
}
&&
(
!
defined
$SSO_OK
||
$SSO_OK
)
)
{
eval
{
$SSO_OK
=
0
;
require
Ravada::Auth::
SSO
;
...
...
lib/Ravada/Auth/LDAP.pm
View file @
11cbec40
...
...
@@ -78,6 +78,9 @@ sub add_user($name, $password, $storage='rfc2307', $algorithm=undef ) {
_init_ldap_admin
();
my
$base
=
(
$$CONFIG
->
{
ldap
}
->
{
base
}
or
_dc_base
()
);
my
$field
=
(
$$CONFIG
->
{
ldap
}
->
{
field
}
or
"
cn
"
);
$name
=
escape_filter_value
(
$name
);
$password
=
escape_filter_value
(
$password
);
...
...
@@ -87,7 +90,7 @@ sub add_user($name, $password, $storage='rfc2307', $algorithm=undef ) {
my
%entry
=
(
cn
=>
$name
,
ui
d
=>
$name
,
$fiel
d
=>
$name
# , uidNumber => _new_uid()
# , gidNumber => $GID
,
objectClass
=>
[
@OBJECT_CLASS
]
...
...
@@ -96,11 +99,11 @@ sub add_user($name, $password, $storage='rfc2307', $algorithm=undef ) {
# , homeDirectory => "/home/$name"
,
userPassword
=>
_password_store
(
$password
,
$storage
,
$algorithm
)
);
my
$dn
=
"
cn
=
$name
,
"
.
_dc_
base
()
;
my
$dn
=
"
$field
=
$name
,
"
.
$
base
;
my
$mesg
=
$LDAP_ADMIN
->
add
(
$dn
,
attr
=>
[
%entry
]);
if
(
$mesg
->
code
)
{
die
"
Error
afegint
$name
to
$dn
"
.
$mesg
->
error
;
die
"
Error
creating
$dn
:
"
.
$mesg
->
error
;
}
}
...
...
@@ -156,8 +159,9 @@ sub _get_gid() {
add_group
('
users
');
(
$group_users
)
=
search_group
(
name
=>
'
users
');
confess
"
Error: I can create nor find LDAP group 'users'
"
if
!
$group_users
;
warn
"
Warning: group users has no gidNumber
"
.
Dumper
(
$group_users
)
if
!
$group_users
->
get_value
('
gidNumber
');
}
return
$group_users
->
get_value
('
gidNumber
');
return
(
$group_users
->
get_value
('
gidNumber
')
or
'
1000
')
;
}
sub
_new_uid
($ldap=_init_ldap_admin(), $base=_dc_base()) {
...
...
@@ -268,7 +272,7 @@ sub search_user {
my
$username
=
delete
$args
{
name
}
or
confess
"
Missing user name
";
my
$retry
=
(
delete
$args
{
retry
}
or
0
);
my
$field
=
(
delete
$args
{
field
}
or
$$CONFIG
->
{
ldap
}
->
{
field
}
or
'
uid
');
my
$field
=
(
delete
$args
{
field
}
or
$$CONFIG
->
{
ldap
}
->
{
field
}
or
'
cn
');
my
$ldap
=
(
delete
$args
{
ldap
}
or
_init_ldap_admin
());
my
$base
=
(
delete
$args
{
base
}
or
_dc_base
());
my
$typesonly
=
(
delete
$args
{
typesonly
}
or
0
);
...
...
@@ -303,7 +307,9 @@ sub search_user {
);
if
(
$retry
<=
3
&&
$mesg
->
code
&&
$mesg
->
code
!=
4
)
{
if
(
$retry
<=
3
&&
$mesg
->
code
&&
$mesg
->
code
!=
4
&&
$mesg
->
code
!=
32
)
{
warn
"
LDAP error
"
.
$mesg
->
code
.
"
"
.
$mesg
->
error
.
"
.
"
.
"
Retrying ! [
$retry
]
"
if
$retry
;
$LDAP_ADMIN
=
undef
;
...
...
@@ -336,9 +342,11 @@ Add a group to the LDAP
=cut
sub
add_group
($name, $base=_dc_base(), $class=['groupOfUniqueNames','nsMemberOf','posixGroup','top' ]) {
sub
add_group
($name, $base=undef, $class=['groupOfUniqueNames','nsMemberOf','posixGroup','top' ]) {
$base
=
(
$$CONFIG
->
{
ldap
}
->
{
groups_base
}
or
"
ou=groups,
"
.
_dc_base
())
if
!
defined
$base
;
my
$ldap
=
_init_ldap_admin
();
$base
=
_dc_base
()
if
!
defined
$base
;
$name
=
escape_filter_value
(
$name
);
my
$oc_posix_group
;
$oc_posix_group
=
grep
{
/^posixGroup$/
}
@$class
;
...
...
@@ -350,7 +358,7 @@ sub add_group($name, $base=_dc_base(), $class=['groupOfUniqueNames','nsMemberOf'
push
@attrs
,
(
gidNumber
=>
_search_new_gid
())
if
$oc_posix_group
;
my
@data
=
(
dn
=>
"
cn=
$name
,
ou=groups,
$base
"
dn
=>
"
cn=
$name
,
$base
"
,
cn
=>
$name
,
attrs
=>
\
@attrs
);
...
...
@@ -386,9 +394,8 @@ Removes the group from the LDAP directory. Use with caution
sub
remove_group
{
my
$name
=
shift
;
my
$base
=
shift
;
$base
=
"
ou=groups,
"
.
_dc_base
()
if
!
$base
;
my
$base
=
(
$$CONFIG
->
{
ldap
}
->
{
groups_base
}
or
"
ou=groups,
"
.
_dc_base
()
)
;
my
$entry
=
search_group
(
name
=>
$name
,
base
=>
$base
);
if
(
!
$entry
)
{
...
...
@@ -409,7 +416,7 @@ sub search_group {
my
%args
=
@_
;
my
$name
=
delete
$args
{
name
}
or
confess
"
Error: missing name
";
my
$base
=
(
delete
$args
{
base
}
or
"
ou=groups,
"
.
_dc_base
()
);
my
$base
=
(
delete
$args
{
base
}
or
$$CONFIG
->
{
ldap
}
->
{
groups_base
}
or
"
ou=groups,
"
.
_dc_base
()
);
my
$ldap
=
(
delete
$args
{
ldap
}
or
_init_ldap_admin
());
my
$retry
=
(
delete
$args
{
retry
}
or
0
);
...
...
@@ -438,7 +445,7 @@ sub search_group {
);
}
if
(
$retry
<=
3
&&
$mesg
->
code
){
if
(
$retry
<=
3
&&
$mesg
->
code
&&
$mesg
->
code
!=
32
){
warn
"
LDAP error
"
.
$mesg
->
code
.
"
"
.
$mesg
->
error
.
"
. [cn=
$name
]
"
.
"
Retrying ! [
$retry
]
"
if
$retry
;
$LDAP_ADMIN
=
undef
;
...
...
@@ -461,7 +468,8 @@ sub search_group {
=cut
sub
search_group_members
($cn, $retry = 0) {
my
$base
=
"
ou=groups,
"
.
_dc_base
();
my
$base
=
(
$$CONFIG
->
{
ldap
}
->
{
groups_base
}
or
"
ou=groups,
"
.
_dc_base
());
my
$ldap
=
_init_ldap_admin
();
my
$sizelimit
=
(
$$CONFIG
->
{
ldap
}
->
{
size_limit
}
or
1000
);
...
...
@@ -479,7 +487,7 @@ sub search_group_members($cn, $retry = 0) {
my
@entries
=
map
{
$_
->
get_value
('
cn
')
}
$mesg
->
entries
();
$mesg
=
$ldap
->
search
(
filter
=>
"
member=cn=
$cn
,
"
.
_dc_
base
()
filter
=>
"
member=cn=
$cn
,
"
.
$
base
,
base
=>
$base
,
sizelimit
=>
$sizelimit
);
...
...
@@ -574,7 +582,8 @@ sub remove_from_group {
=cut
sub
_search_posix_group
($self, $name) {
my
$base
=
'
ou=groups,
'
.
_dc_base
();
my
$base
=
(
$$CONFIG
->
{
ldap
}
->
{
groups_base
}
or
"
ou=groups,
"
.
_dc_base
());
my
$field
=
'
cn
';
if
(
$name
=~
/(.*?)=(.*)/
)
{
$field
=
$
1
;
...
...
@@ -902,7 +911,7 @@ sub _init_ldap_admin {
return
$LDAP_ADMIN
if
$LDAP_ADMIN
;
my
(
$dn
,
$pass
);
if
(
$$CONFIG
->
{
ldap
}
)
{
if
(
exists
$$CONFIG
->
{
ldap
}
&&
$$CONFIG
->
{
ldap
}
)
{
(
$dn
,
$pass
)
=
(
$$CONFIG
->
{
ldap
}
->
{
admin_user
}
->
{
dn
}
,
$$CONFIG
->
{
ldap
}
->
{
admin_user
}
->
{
password
});
}
else
{
...
...
lib/Ravada/Auth/User.pm
View file @
11cbec40
...
...
@@ -11,6 +11,7 @@ Ravada::Auth::User - User management and tools library for Ravada
use
Carp
qw(confess croak)
;
use
Data::
Dumper
;
use
Mojo::
JSON
qw(decode_json)
;
use
Moose::
Role
;
no
warnings
"
experimental::signatures
";
...
...
@@ -431,4 +432,37 @@ sub _load_allowed_groups($self) {
}
}
=head2 list_requests
List the requests for this user. It returns requests from the last hour
by default.
Arguments: optionally pass the date to start search for requests.
=cut
sub
list_requests
($self, $date_req=Ravada::Utils::date_now(3600)) {
my
$sth
=
$$CONNECTOR
->
dbh
->
prepare
("
SELECT id,args FROM requests WHERE date_req > ?
"
.
"
ORDER BY date_req DESC
");
my
(
$id
,
$args_json
);
$sth
->
execute
(
$date_req
);
$sth
->
bind_columns
(
\
(
$id
,
$args_json
));
my
@req
;
while
(
$sth
->
fetch
)
{
my
$args
=
decode_json
(
$args_json
);
next
if
!
length
$args
;
my
$uid
=
(
$args
->
{
uid
}
or
$args
->
{
id_owner
})
or
next
;
next
if
$uid
!=
$self
->
id
;
my
$req
=
Ravada::
Request
->
open
(
$id
);
push
@req
,
(
$req
);
}
return
@req
;
}
1
;
lib/Ravada/Front.pm
View file @
11cbec40
...
...
@@ -1250,6 +1250,10 @@ sub add_node($self,%arg) {
return
$req
->
id
;
}
sub
_cache_delete
($self, $key) {
delete
$self
->
{
cache
}
->
{
$key
};
}
sub
_cache_store
($self, $key, $value, $timeout=60) {
$self
->
{
cache
}
->
{
$key
}
=
[
$value
,
time
+
$timeout
];
}
...
...
lib/Ravada/Request.pm
View file @
11cbec40
...
...
@@ -222,6 +222,12 @@ our %COMMAND = (
);
lock_hash
%COMMAND
;
our
%CMD_VALIDATE
=
(
clone
=>
\
&_validate_clone
,
create
=>
\
&_validate_create_domain
,
create_domain
=>
\
&_validate_create_domain
);
sub
_init_connector
{
$CONNECTOR
=
\
$
Ravada::
CONNECTOR
;
$CONNECTOR
=
\
$
Ravada::Front::
CONNECTOR
if
!
$$CONNECTOR
;
...
...
@@ -747,11 +753,65 @@ sub _new_request {
my
$request
=
$self
->
open
(
$self
->
{
id
});
$request
->
status
('
requested
');
$request
->
_validate
();
$request
->
status
('
requested
')
if
$request
->
status
ne
'
done
';
return
$request
;
}
sub
_validate
($self) {
return
if
!
exists
$CMD_VALIDATE
{
$self
->
command
};
my
$method
=
$CMD_VALIDATE
{
$self
->
command
};
return
if
!
$method
;
$method
->
(
$self
);
}
sub
_validate_create_domain
($self) {
my
$base
;
my
$id_base
=
$self
->
defined_arg
('
id_base
');
my
$id_owner
=
$self
->
defined_arg
('
id_owner
')
or
confess
"
ERROR: Missing id_owner
";
my
$owner
=
Ravada::Auth::
SQL
->
search_by_id
(
$id_owner
)
or
confess
"
Unknown user id:
$id_owner
";
$self
->
_validate_clone
(
$id_base
,
$id_owner
)
if
$id_base
;
return
if
$owner
->
is_admin
||
$owner
->
can_create_machine
()
||
(
$id_base
&&
$owner
->
can_clone
);
return
$self
->
_status_error
("
done
","
Error: access denied to user
"
.
$owner
->
name
);
}
sub
_validate_clone
($
self
,
$
id_base
=
$
self
->
args
('
id_domain
')
, $uid=$self->args('uid')) {
my
$base
=
Ravada::Front::
Domain
->
open
(
$id_base
);
if
(
!
$uid
)
{
$self
->
status
('
done
');
$self
->
error
("
Error: missing uid
");
return
;
}
my
$user
=
Ravada::Auth::
SQL
->
search_by_id
(
$uid
);
if
(
!
$user
)
{
$self
->
status
('
done
');
$self
->
error
("
Error: user id='
$uid
' does not exist
");
return
;
}
return
if
$user
->
is_admin
;
return
if
$user
->
can_clone_all
;
return
$self
->
_status_error
('
done
'
,"
Error: user
"
.
$user
->
name
.
"
can not clone.
")
if
!
$user
->
can_clone
();
return
$self
->
_status_error
('
done
'
,"
Error:
"
.
$base
->
name
.
"
is not public.
")
if
!
$base
->
is_public
;
}
sub
_last_insert_id
{
_init_connector
();
return
Ravada::Utils::
last_insert_id
(
$$CONNECTOR
->
dbh
);
...
...
@@ -802,6 +862,11 @@ sub status {
return
$status
;
}
sub
_status_error
($self, $status, $error) {
$self
->
status
(
$status
);
return
$self
->
error
(
$error
);
}
=head2 at
Sets the time when the request will be scheduled
...
...
lib/Ravada/Utils.pm
View file @
11cbec40
...
...
@@ -4,6 +4,8 @@ use warnings;
use
strict
;
use
Carp
qw(confess)
;
no
warnings
"
experimental::signatures
";
use
feature
qw(signatures)
;
no
warnings
"
experimental::signatures
";
use
feature
qw(signatures)
;
...
...
@@ -19,12 +21,13 @@ our $USER_DAEMON_NAME = 'daemon';
=head2 now
Returns the current datetime
Returns the current datetime. Optionally you can pass seconds
to substract to the current time.
=cut
sub
now
{
my
@now
=
localtime
(
time
);
sub
now
($seconds=0)
{
my
@now
=
localtime
(
time
-
$seconds
);
$now
[
5
]
+=
1900
;
$now
[
4
]
++
;
for
(
0
..
4
)
{
...
...
@@ -34,6 +37,12 @@ sub now {
return
"
$now
[5]-
$now
[4]-
$now
[3]
$now
[2]:
$now
[1]:
$now
[0].0
";
}
sub
date_now
($seconds=0) {
my
$date
=
now
(
$seconds
);
$date
=~
s/\.\d+$//
;
return
$date
;
}
=head2 random_name
Returns a random name.
...
...
lib/Ravada/VM/KVM.pm
View file @
11cbec40
...
...
@@ -882,11 +882,12 @@ sub _domain_create_from_iso {
my
$device_cdrom
;
confess
"
Template
"
.
$iso
->
{
name
}
.
"
has no URL, iso_file argument required.
"
if
!
$iso
->
{
url
}
&&
!
$iso_file
&&
!
$iso
->
{
device
};
if
$iso
->
{
has_cd
}
&&
!
$iso
->
{
url
}
&&
!
$iso_file
&&
!
$iso
->
{
device
};
if
(
$iso_file
)
{
if
(
$iso_file
ne
"
<NONE>
")
{
if
(
defined
$iso_file
)
{
if
(
$iso_file
ne
"
<NONE>
"
||
$iso_file
)
{
$device_cdrom
=
$iso_file
;
}
}
...
...
@@ -915,7 +916,7 @@ sub _domain_create_from_iso {
my
$xml
=
$self
->
_define_xml
(
$args
{
name
}
,
"
$DIR_XML
/
$iso
->{xml}
");
if
(
$device_cdrom
)
{
if
(
$device_cdrom
&&
$device_cdrom
ne
'
<NONE>
'
)
{
_xml_modify_cdrom
(
$xml
,
$device_cdrom
);
}
else
{
_xml_remove_cdrom
(
$xml
);
...
...
public/js/admin.js
View file @
11cbec40
...
...
@@ -116,12 +116,11 @@ ravadaApp.directive("solShowMachine", swMach)
$scope
.
showMinSize
=
false
;
$scope
.
min_size
=
1
;
}
return
(
id
.
device
!=
null
)
?
id
.
device
:
"
<NONE>
"
;
return
(
id
.
device
!=
null
)
?
id
.
device
:
""
;
};
$scope
.
onIdIsoSelected
=
function
()
{
$scope
.
iso_file
=
$scope
.
change_iso
(
this
.
id_iso
)
$scope
.
id_file
=
(
$scope
.
iso_file
===
"
<NONE>
"
)
?
""
:
$scope
.
iso_file
;
};
$scope
.
validate_new_name
=
function
()
{
...
...
@@ -168,6 +167,25 @@ ravadaApp.directive("solShowMachine", swMach)
});
};
$scope
.
refresh_storage
=
function
()
{
$scope
.
refresh_working
=
true
;
$http
.
post
(
'
/request/refresh_storage/
'
,
JSON
.
stringify
({})
).
then
(
function
(
response
)
{
if
(
response
.
status
==
300
)
{
console
.
error
(
'
Response error
'
,
response
.
status
);
}
setTimeout
(
function
(){
$http
.
get
(
'
/iso_file.json
'
).
then
(
function
(
response
)
{
$scope
.
isos
=
response
.
data
;
$scope
.
refresh_working
=
false
;
});
},
3000
);
}
);
};
$http
.
get
(
'
/list_machines.json
'
).
then
(
function
(
response
)
{
$scope
.
base
=
response
.
data
;
});
...
...
public/js/ravada.js
View file @
11cbec40
...
...
@@ -626,7 +626,9 @@
return
;
}
}
item
.
remove
=
false
;
if
(
typeof
(
item
)
==
'
object
'
)
{
item
.
remove
=
false
;
}
$http
.
get
(
'
/machine/hardware/remove/
'
+
$scope
.
showmachine
.
id
+
'
/
'
+
hardware
+
'
/
'
+
index
).
then
(
function
(
response
)
{
});
...
...
script/rvd_back
View file @
11cbec40
...
...
@@ -226,6 +226,7 @@ sub do_start {
# Ravada::Request->enforce_limits();
#Ravada::Request->refresh_vms();
Ravada::
Request
->
refresh_storage
();
for
(;;)
{
my
$t0
=
time
;
$ravada
->
process_priority_requests
()
...
...
script/rvd_front
View file @
11cbec40
...
...
@@ -85,6 +85,7 @@ my $CONFIG_FRONT = plugin Config => { default => {
,file => $FILE_CONFIG
};
delete $CONFIG_FRONT->{login_custom} if $ENV{MOJO_MODE}
&&
$ENV{MOJO_MODE} eq 'development';
#####