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
821d7e8d
Unverified
Commit
821d7e8d
authored
Feb 23, 2021
by
Francesc Guasch
Committed by
GitHub
Feb 23, 2021
Browse files
Feature displays (#1501)
feat: displays
parent
c897ff84
Changes
54
Expand all
Hide whitespace changes
Inline
Side-by-side
lib/Ravada.pm
View file @
821d7e8d
...
...
@@ -642,6 +642,50 @@ sub _scheduled_fedora_releases($self,$data) {
}
}
sub
_add_domain_drivers_display
($self) {
my
%data
=
(
'
KVM
'
=>
[
'
spice
'
,'
vnc
'
,{
name
=>
'
x2go
',
data
=>
22
}
,{
name
=>
'
Windows RDP
',
value
=>
'
rdp
',
data
=>
356
}
]
,'
Void
'
=>
[
'
void
'
,'
spice
'
,{
name
=>
'
x2go
',
data
=>
22
}
,{
name
=>
'
Windows RDP
',
value
=>
'
rdp
'
,
data
=>
356
}
]
);
my
$id_type
=
Ravada::Utils::
max_id
(
$CONNECTOR
->
dbh
,
'
domain_drivers_types
')
+
1
;
my
$id_option
=
Ravada::Utils::
max_id
(
$CONNECTOR
->
dbh
,
'
domain_drivers_options
');
for
my
$vm
(
keys
%data
)
{
my
$type
=
{
id
=>
$id_type
,
name
=>
'
display
'
,
description
=>
'
Display
'
,
vm
=>
$vm
};
$self
->
_update_table
('
domain_drivers_types
','
name,vm
',
$type
)
and
do
{
for
my
$option
(
@
{
$data
{
$vm
}}
)
{
if
(
!
ref
(
$option
))
{
$option
=
{
name
=>
$option
,
value
=>
$option
};
}
$option
->
{
value
}
=
$option
->
{
name
}
if
!
exists
$option
->
{
value
};
$option
->
{
id_driver_type
}
=
$id_type
;
$option
->
{
id
}
=
++
$id_option
;
$self
->
_update_table
('
domain_drivers_options
','
id_driver_type,name
',
$option
)
}
$id_type
++
;
};
}
}
sub
_update_domain_drivers_types
($self) {
my
$data
=
{
...
...
@@ -685,6 +729,34 @@ sub _update_domain_drivers_types($self) {
};
$self
->
_update_table
('
domain_drivers_types
','
id
',
$data
);
my
$id
=
Ravada::Utils::
max_id
(
$CONNECTOR
->
dbh
,
'
domain_drivers_types
');
my
$id_option
=
Ravada::Utils::
max_id
(
$CONNECTOR
->
dbh
,
'
domain_drivers_options
');
my
$data_options
;
for
my
$item
(
keys
%$data
)
{
unlock_hash
(
%
{
$data
->
{
$item
}});
$data
->
{
$item
}
->
{
id
}
=
++
$id
;
$data
->
{
$item
}
->
{
vm
}
=
'
Void
';
next
if
$item
eq
'
disk
';
$id_option
++
;
$data_options
->
{"
$item
.on
"}
=
{
id
=>
$id_option
,
id_driver_type
=>
$id
,
name
=>
"
$item
.on
"
,
value
=>
"
compression=on
"
};
$id_option
++
;
$data_options
->
{"
$item
.off
"}
=
{
id
=>
$id_option
,
id_driver_type
=>
$id
,
name
=>
"
$item
.off
"
,
value
=>
"
compression=off
"
};
}
$self
->
_update_table
('
domain_drivers_types
','
name,vm
',
$data
)
and
$self
->
_update_table
('
domain_drivers_options
','
id_driver_type,name
',
$data_options
);
my
$sth
=
$CONNECTOR
->
dbh
->
prepare
(
"
UPDATE domain_drivers_types SET vm='KVM' WHERE vm='qemu'
"
...
...
@@ -873,18 +945,41 @@ sub _update_domain_drivers_options_disk($self) {
$self
->
_update_table
('
domain_drivers_options
','
id
',
\
%data
);
}
sub
_sth_search
($table, $field) {
my
$sth_search
;
if
(
$field
=~
/,/
)
{
my
$where
=
join
(
'
AND
',
map
{
"
$_
=?
"
}
split
/,/
,
$field
);
$sth_search
=
$CONNECTOR
->
dbh
->
prepare
("
SELECT id FROM
$table
WHERE
$where
");
}
else
{
$sth_search
=
$CONNECTOR
->
dbh
->
prepare
("
SELECT id FROM
$table
WHERE
$field
= ?
");
}
return
$sth_search
;
}
sub
_sth_values
($row, $field) {
lock_hash
(
%$row
);
my
@ret
;
for
my
$item
(
split
/,/
,
$field
)
{
push
@ret
,(
$row
->
{
$item
})
}
return
@ret
;
}
sub
_update_table
($self, $table, $field, $data, $verbose=0) {
my
(
$first
)
=
%$data
;
$data
=
{
entry
=>
$data
}
if
!
ref
(
$data
->
{
$first
});
my
$sth_search
=
$CONNECTOR
->
dbh
->
prepare
("
SELECT id FROM
$table
WHERE
$field
= ?
");
my
$changed
=
0
;
my
$sth_search
=
_sth_search
(
$table
,
$field
);
for
my
$name
(
sort
keys
%$data
)
{
my
$row
=
$data
->
{
$name
};
$sth_search
->
execute
(
$row
->
{
$field
}
);
$sth_search
->
execute
(
_sth_values
(
$row
,
$field
)
);
my
(
$id
)
=
$sth_search
->
fetchrow
;
if
(
$id
)
{
warn
("
INFO:
$table
:
$row
->{
$field
} already added.
\n
")
if
$verbose
;
next
;
}
warn
("
INFO: updating
$table
:
$row
->{
$field
}
\n
")
warn
("
INFO: updating
$table
:
"
.
Dumper
(
$data
->
{
$name
})
.
"
\n
")
if
!
$FIRST_TIME_RUN
&&
$
0
!~
/\.t$/
;
my
$sql
=
...
...
@@ -899,7 +994,9 @@ sub _update_table($self, $table, $field, $data, $verbose=0) {
my
$sth
=
$CONNECTOR
->
dbh
->
prepare
(
$sql
);
$sth
->
execute
(
map
{
$data
->
{
$name
}
->
{
$_
}
}
sort
keys
%
{
$data
->
{
$name
}});
$sth
->
finish
;
$changed
++
;
}
return
$changed
;
}
sub
_remove_old_isos
{
...
...
@@ -948,6 +1045,8 @@ sub _update_data {
$self
->
_update_domain_drivers_options_disk
();
$self
->
_update_old_qemus
();
$self
->
_add_domain_drivers_display
();
$self
->
_add_indexes
();
}
...
...
@@ -961,6 +1060,10 @@ sub _add_indexes_generic($self) {
"
index(date_changed)
"
,"
index(id_base):id_base_index
"
]
,
domain_displays
=>
[
"
unique(id_domain,n_order)
"
,"
unique(id_domain,driver)
"
]
,
requests
=>
[
"
index(status,at_time)
"
,"
index(id,date_changed,status,at_time)
"
...
...
@@ -1367,6 +1470,21 @@ sub _sql_create_tables($self) {
my
$created
=
0
;
my
$driver
=
lc
(
$CONNECTOR
->
dbh
->
{
Driver
}{
Name
});
my
%tables
=
(
domain_displays
=>
{
id
=>
'
integer NOT NULL PRIMARY KEY AUTO_INCREMENT
'
,
id_domain
=>
'
integer NOT NULL references domains(id)
'
,
port
=>
'
char(5) DEFAULT NULL
'
,
ip
=>
'
varchar(254)
'
,
listen_ip
=>
'
varchar(254)
'
,
driver
=>
'
char(40) not null
'
,
is_active
=>
'
integer NOT NULL default 0
'
,
is_builtin
=>
'
integer NOT NULL default 0
'
,
id_domain_port
=>
'
integer DEFAULT NULL
'
,
n_order
=>
'
integer NOT NULL
'
,
password
=>
'
char(32)
'
,
extra
=>
'
TEXT
'
}
,
settings
=>
{
id
=>
'
integer NOT NULL PRIMARY KEY AUTO_INCREMENT
'
,
id_parent
=>
'
INT NOT NULL
'
...
...
@@ -1601,7 +1719,7 @@ sub _upgrade_tables {
$self
->
_upgrade_table
('
domains
','
status
','
varchar(32) DEFAULT "shutdown"
');
$self
->
_upgrade_table
('
domains
','
display
','
text
');
$self
->
_upgrade_table
('
domains
','
display_file
','
text DEFAULT NULL
');
#
$self->_upgrade_table('domains','display_file','text DEFAULT NULL');
$self
->
_upgrade_table
('
domains
','
info
','
varchar(255) DEFAULT NULL
');
$self
->
_upgrade_table
('
domains
','
internal_id
','
varchar(64) DEFAULT NULL
');
$self
->
_upgrade_table
('
domains
','
id_vm
','
int default null
');
...
...
@@ -1638,9 +1756,11 @@ sub _upgrade_tables {
$self
->
_upgrade_table
('
grant_types
','
enabled
','
int not null default 1
');
$self
->
_upgrade_table
('
vms
','
mac
','
char(18)
');
$self
->
_upgrade_table
('
vms
','
tls
','
text
');
$self
->
_upgrade_table
('
volumes
','
name
','
char(200)
');
$self
->
_upgrade_table
('
domain_drivers_options
','
data
',
'
char(200)
');
$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
');
...
...
@@ -2086,8 +2206,7 @@ sub remove_domain {
warn
$@
if
$@
;
if
(
!
$domain
)
{
warn
"
Warning: I can't find domain '
$id
', maybe already removed.
";
$sth
=
$CONNECTOR
->
dbh
->
prepare
("
DELETE FROM domains where id=?
");
$sth
->
execute
(
$id
);
Ravada::Domain::
_remove_domain_data_db
(
$id
);
return
;
};
...
...
@@ -2585,6 +2704,7 @@ sub _kill_requests($self, @requests) {
}
sub
_process_sons
($self, $pid) {
return
if
!
defined
$pid
;
my
@process
;
my
$cmd
=
"
ps -eo 'ppid pid cmd'
";
...
...
@@ -2652,15 +2772,14 @@ sub _kill_stale_process($self) {
.
"
FROM requests
"
.
"
WHERE start_time<?
"
.
"
AND ( command = 'refresh_vms' or command = 'screenshot' or command = 'set_time'
"
.
"
OR command = 'open_exposed_ports'
"
.
"
OR command = 'open_exposed_ports'
OR command='remove'
"
.
"
)
"
.
"
AND status <> 'done'
"
.
"
AND pid IS NOT NULL
"
.
"
AND start_time IS NOT NULL
"
);
$sth
->
execute
(
time
-
$TIMEOUT_STALE_PROCESS
);
while
(
my
(
$id
,
$pid
,
$command
,
$start_time
)
=
$sth
->
fetchrow
)
{
if
(
$pid
==
$$
)
{
if
(
defined
$pid
&&
$pid
==
$$
)
{
warn
"
HOLY COW! I should kill pid
$pid
stale for
"
.
(
time
-
$start_time
)
.
"
seconds, but I won't because it is myself
";
my
$request
=
Ravada::
Request
->
open
(
$id
);
...
...
@@ -3330,26 +3449,25 @@ sub _cmd_start_clones {
my
$uid
=
$request
->
args
('
uid
');
my
$user
=
Ravada::Auth::
SQL
->
search_by_id
(
$uid
);
my
$sequential
=
$request
->
defined_arg
('
sequential
');
my
$sth
=
$CONNECTOR
->
dbh
->
prepare
(
"
SELECT id, name, is_base FROM domains WHERE id_base = ?
"
"
SELECT id, name, is_base FROM domains WHERE id_base = ?
AND is_base = 0 AND status <> 'active'
"
);
$sth
->
execute
(
$id_domain
);
my
$id_req
;
while
(
my
(
$id
,
$name
,
$is_base
)
=
$sth
->
fetchrow
)
{
if
(
$is_base
==
0
)
{
my
$domain2
;
my
$is_active
;
eval
{
$domain2
=
$self
->
search_domain_by_id
(
$id
);
$is_active
=
$domain2
->
is_active
;
};
warn
$@
if
$@
;
if
(
!
$is_active
)
{
my
@after_request
;
@after_request
=
(
after_request
=>
$id_req
)
if
$sequential
&&
$id_req
;
my
$req
=
Ravada::
Request
->
start_domain
(
uid
=>
$uid
,
name
=>
$name
,
remote_ip
=>
$remote_ip
);
}
}
,
id_domain
=>
$id
,
remote_ip
=>
$remote_ip
,
@after_request
);
$id_req
=
$req
->
id
;
}
}
...
...
@@ -4377,6 +4495,7 @@ sub _req_method {
,
expose
=>
\
&_cmd_expose
,
remove_expose
=>
\
&_cmd_remove_expose
,
open_exposed_ports
=>
\
&_cmd_open_exposed_ports
,
close_exposed_ports
=>
\
&_cmd_close_exposed_ports
# Virtual Managers or Nodes
,
shutdown_node
=>
\
&_cmd_shutdown_node
,
start_node
=>
\
&_cmd_start_node
...
...
@@ -4665,6 +4784,33 @@ sub _cmd_open_exposed_ports($self, $request) {
}
sub
_cmd_close_exposed_ports
($self, $request) {
my
$uid
=
$request
->
args
('
uid
');
my
$user
=
Ravada::Auth::
SQL
->
search_by_id
(
$uid
)
or
die
"
Error: user
$uid
not found
";
my
$domain
=
Ravada::
Domain
->
open
(
$request
->
id_domain
);
die
"
Error: user
"
.
$user
->
name
.
"
not authorized to delete iptables rule
"
unless
$user
->
is_admin
||
$domain
->
_data
('
id_owner
')
==
$uid
;
my
$port
=
$request
->
defined_arg
('
port
');
$domain
->
_close_exposed_port
(
$port
);
if
(
$request
->
defined_arg
('
clean
'))
{
my
$query
=
"
UPDATE domain_ports SET public_port=NULL
"
.
"
WHERE id_domain=?
";
$query
.=
"
AND internal_port=?
"
if
$port
;
my
$sth_update
=
$CONNECTOR
->
dbh
->
prepare
(
$query
);
if
(
$port
)
{
$sth_update
->
execute
(
$domain
->
id
,
$port
);
}
else
{
$sth_update
->
execute
(
$domain
->
id
);
}
}
}
=head2 set_debug_value
Sets debug global variable from setting
...
...
lib/Ravada/Auth/SQL.pm
View file @
821d7e8d
...
...
@@ -641,7 +641,13 @@ sub can_do_domain($self, $grant, $domain) {
return
1
if
$self
->
_domain_id_owner
(
$domain
)
==
$self
->
id
&&
$self
->
can_do
(
$grant
);
if
(
$self
->
can_do
("
${grant}
_clones
")
&&
$self
->
_domain_id_base
(
$domain
))
{
my
$base
=
Ravada::Front::
Domain
->
open
(
$self
->
_domain_id_base
(
$domain
));
my
$base
;
my
$id_base
=
$self
->
_domain_id_base
(
$domain
);
eval
{
$base
=
Ravada::Front::
Domain
->
open
(
$id_base
)
};
if
(
!
defined
$base
)
{
warn
"
Error: base
$id_base
from
$domain
not found
";
return
0
;
}
return
1
if
$base
->
id_owner
==
$self
->
id
;
}
return
0
;
...
...
lib/Ravada/Domain.pm
View file @
821d7e8d
This diff is collapsed.
Click to expand it.
lib/Ravada/Domain/KVM.pm
View file @
821d7e8d
...
...
@@ -72,16 +72,19 @@ our %GET_CONTROLLER_SUB = (
our
%SET_CONTROLLER_SUB
=
(
usb
=>
\
&_set_controller_usb
,
disk
=>
\
&_set_controller_disk
,
display
=>
\
&_set_controller_display
,
network
=>
\
&_set_controller_network
);
our
%REMOVE_CONTROLLER_SUB
=
(
usb
=>
\
&_remove_controller_usb
,
disk
=>
\
&_remove_controller_disk
,
display
=>
\
&_remove_controller_display
,
network
=>
\
&_remove_controller_network
);
our
%CHANGE_HARDWARE_SUB
=
(
disk
=>
\
&_change_hardware_disk
,
display
=>
\
&_change_hardware_display
,
vcpus
=>
\
&_change_hardware_vcpus
,
memory
=>
\
&_change_hardware_memory
,
network
=>
\
&_change_hardware_network
...
...
@@ -215,7 +218,7 @@ Cleanup operations executed before removing this domain
sub
pre_remove_domain
{
my
$self
=
shift
;
return
if
$self
->
is_removed
;
$self
->
xml_description
();
$self
->
xml_description
()
if
$self
->
is_known
()
;
$self
->
domain
->
managed_save_remove
()
if
$self
->
domain
->
has_managed_save_image
;
}
...
...
@@ -646,32 +649,109 @@ Returns the display information as a hashref. The display URI is in the display
sub
display_info
($self, $user) {
my
$xml
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
xml_description
);
my
(
$graph
)
=
$xml
->
findnodes
('
/domain/devices/graphics
')
or
die
"
ERROR: I can't find graphic
";
my
$xml
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
(
Sys::Virt::Domain::
XML_SECURE
));
my
@graph
=
$xml
->
findnodes
('
/domain/devices/graphics
')
or
return
;
my
@display
;
for
my
$graph
(
@graph
)
{
my
(
$type
)
=
$graph
->
getAttribute
('
type
');
if
(
$type
eq
'
spice
')
{
push
@display
,(
_display_info_spice
(
$graph
));
}
elsif
(
$type
eq
'
vnc
'
)
{
push
@display
,(
_display_info_vnc
(
$graph
));
}
}
return
$display
[
0
]
if
!
wantarray
;
return
@display
;
}
sub
_display_info_vnc
($graph) {
my
(
$type
)
=
$graph
->
getAttribute
('
type
');
my
(
$port
)
=
$graph
->
getAttribute
('
port
');
my
(
$tls_port
)
=
$graph
->
getAttribute
('
tlsPort
');
my
(
$address
)
=
$graph
->
getAttribute
('
listen
');
warn
"
ERROR: Machine
"
.
$self
->
name
.
"
is not active in node
"
.
$self
->
_vm
->
name
.
"
\n
"
if
!
$port
&&
!
$self
->
is_active
;
my
(
$password
)
=
$graph
->
getAttribute
('
passwd
');
my
%display
=
(
driver
=>
$type
,
port
=>
$port
,
ip
=>
$address
,
is_builtin
=>
1
);
$display
{
tls_port
}
=
$tls_port
if
defined
$tls_port
;
$display
{
password
}
=
$password
;
$port
=
''
if
!
defined
$port
;
for
my
$item
(
$graph
->
findnodes
("
*
"))
{
next
if
$item
->
getName
eq
'
listen
';
for
my
$attr
(
$item
->
getAttributes
())
{
my
$value
=
$attr
->
toString
();
$value
=~
s/^\s+//
;
$display
{
$item
->
getName
()}
=
$value
;
}
}
lock_hash
(
%display
);
return
\
%display
;
}
sub
_display_info_spice
($graph) {
my
(
$type
)
=
$graph
->
getAttribute
('
type
');
my
(
$port
)
=
$graph
->
getAttribute
('
port
');
my
(
$tls_port
)
=
$graph
->
getAttribute
('
tlsPort
');
my
(
$address
)
=
$graph
->
getAttribute
('
listen
');
my
(
$password
)
=
$graph
->
getAttribute
('
passwd
');
my
%display
=
(
type
=>
$type
driver
=>
$type
,
port
=>
$port
,
ip
=>
$address
,
tls_port
=>
$tls_port
,
is_builtin
=>
1
);
$display
{
tls_port
}
=
$tls_port
if
defined
$tls_port
;
$display
{
password
}
=
$password
;
$port
=
''
if
!
defined
$port
;
my
$display
=
$type
.
"
://
$address
:
$port
";
$display
{
display
}
=
$display
;
for
my
$item
(
$graph
->
findnodes
("
*
"))
{
next
if
$item
->
getName
eq
'
listen
';
for
my
$attr
(
$item
->
getAttributes
())
{
my
$value
=
$attr
->
toString
();
$value
=~
s/^\s+//
;
$display
{
$item
->
getName
()}
=
$value
;
}
}
lock_hash
(
%display
);
return
\
%display
;
}
sub
_has_builtin_display
($self) {
my
$xml
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
xml_description
());
my
(
$graph
)
=
$xml
->
findnodes
('
/domain/devices/graphics
');
return
1
if
$graph
;
return
0
;
}
sub
_is_display_builtin
($self, $index=undef, $data=undef) {
if
(
defined
$index
&&
$index
!~
/^\d+$/
)
{
return
1
if
$index
=~
/spice|vnc/i
;
return
0
;
}
return
1
if
defined
$data
&&
$data
->
{
driver
}
=~
/spice|vnc/i
;
my
$xml
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
xml_description
());
my
@graph
=
$xml
->
findnodes
('
/domain/devices/graphics
');
return
1
if
defined
$index
&&
exists
$graph
[
$index
];
return
0
;
}
=head2 is_active
Returns whether the domain is running or not
...
...
@@ -727,7 +807,7 @@ sub start {
$self
->
_check_qcow_format
(
$request
);
$self
->
_set_volumes_backing_store
();
$self
->
_detect_disks_driver
();
$self
->
_set_
spice
_ip
(
$set_password
,
$listen_ip
);
$self
->
_set_
displays
_ip
(
$set_password
,
$listen_ip
);
}
$self
->
status
('
starting
');
...
...
@@ -1673,6 +1753,10 @@ sub rename_volumes {
}
}
sub _set_displays_ip($self, $set_password, $ip=undef) {
return $self->_set_spice_ip($set_password, $ip);
}
sub _set_spice_ip($self, $set_password, $ip=undef) {
return if $self->is_hibernated() || $self->domain->is_active;
...
...
@@ -1840,6 +1924,18 @@ sub _set_driver_generic {
}
sub
_update_device_graphics
($self, $driver, $data) {
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
());
my
$path
=
"
/domain/devices/graphics
\
[
\@
type='
$driver
']
";
my
(
$device
)
=
$doc
->
findnodes
(
$path
);
die
"
$path
not found
"
.
$self
->
name
if
!
$device
;
my
$port
=
delete
$data
->
{
port
};
$device
->
setAttribute
(
port
=>
$port
);
$device
->
removeAttribute
('
autoport
');
$self
->
domain
->
update_device
(
$device
,
Sys::Virt::Domain::
DEVICE_MODIFY_LIVE
);
}
sub
_set_driver_generic_simple
($self, $xml_path, $value_str) {
my
%value
=
_text_to_hash
(
$value_str
);
...
...
@@ -1868,10 +1964,7 @@ sub _set_driver_generic_simple($self, $xml_path, $value_str) {
}
$self
->
_add_driver
(
$xml_path
,
\
%value
)
if
!
$found
;
return
if
!
$changed
;
$self
->
_vm
->
connect
if
!
$self
->
_vm
->
vm
;
my
$new_domain
=
$self
->
_vm
->
vm
->
define_domain
(
$doc
->
toString
);
$self
->
domain
(
$new_domain
);
$self
->
reload_config
(
$doc
)
if
$changed
;
}
...
...
@@ -1888,7 +1981,7 @@ sub _add_driver($self, $xml_path, $attributes=undef) {
confess
"
Expecting one parent, I don't know what to do with
"
.
scalar
@parent
if
scalar
@parent
>
1
;
@parent
=
add_driver
(
$self
,
$xml_parent
)
if
!
@parent
;
@parent
=
_
add_driver
(
$self
,
$xml_parent
)
if
!
@parent
;
my
$node
=
$parent
[
0
]
->
addNewChild
(
undef
,
$new_node
);
...
...
@@ -2002,8 +2095,8 @@ sub _set_controller_usb($self,$numero, $data={}) {
}
}
$numero
=
$count
+
1
if
!
defined
$numero
;
if
(
$numero
>
$count
)
{
my
$missing
=
$numero
-
$count
-
1
;
if
(
$numero
>
=
$count
)
{
my
$missing
=
$numero
-
$count
;
for
my
$i
(
0
..
$missing
)
{
my
$controller
=
$devices
->
addNewChild
(
undef
,"
redirdev
");
...
...
@@ -2038,6 +2131,94 @@ sub _set_controller_network($self, $number, $data) {
$self
->
domain
->
attach_device
(
$device
,
Sys::Virt::Domain::
DEVICE_MODIFY_CONFIG
);
}
sub
_set_controller_display_spice
($self, $number, $data) {
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
xml_description_inactive
);
for
my
$graphic
(
$doc
->
findnodes
("
/domain/devices/graphics
"))
{
next
if
$graphic
->
getAttribute
('
type
')
ne
'
spice
';
die
"
Changing
"
.
$graphic
->
toString
()
.
"
"
.
Dumper
(
$data
);
}
my
(
$devices
)
=
$doc
->
findnodes
("
/domain/devices
");
my
$graphic
=
$devices
->
addNewChild
(
undef
,'
graphics
');
$graphic
->
setAttribute
(
type
=>
'
spice
');
my
$port
=
(
delete
$data
->
{
port
}
or
'
auto
');
$graphic
->
setAttribute
(
port
=>
$port
)
if
$port
ne
'
auto
';
$graphic
->
setAttribute
(
autoport
=>
'
yes
')
if
$port
eq
'
auto
';
my
$ip
=
(
delete
$data
->
{
ip
}
or
$self
->
_vm
->
listen_ip
);
$graphic
->
setAttribute
(
listen
=>
$ip
);
my
$listen
=
$graphic
->
addNewChild
(
undef
,'
listen
');
$listen
->
setAttribute
(
type
=>
'
address
');
$listen
->
setAttribute
(
address
=>
$ip
);
my
%defaults
=
(
image
=>
"
compression=auto_glz
"
,
jpeg
=>
"
compression=auto
"
,
zlib
=>
"
compression=auto
"
,
playback
=>
"
compression=on
"
,
streaming
=>
"
mode=filter
"
);
for
my
$name
(
keys
%defaults
)
{
my
(
$attrib
,
$value
)
=
$defaults
{
$name
}
=~
m{(.*)=(.*)}
;
die
"
Error in
$defaults
{
$name
}
"
if
!
defined
$attrib
||
!
defined
$value
;
my
$item
=
$graphic
->
addNewChild
(
undef
,
$name
);
$item
->
setAttribute
(
$attrib
=>
$value
);
}
$self
->
reload_config
(
$doc
);
}
sub
_set_controller_display_vnc
($self, $number, $data) {
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
xml_description_inactive
);
for
my
$graphic
(
$doc
->
findnodes
("
/domain/devices/graphics
"))
{
next
if
$graphic
->
getAttribute
('
type
')
ne
'
vnc
';
die
"
Changing
"
.
$graphic
->
toString
()
.
"
"
.
Dumper
(
$data
);
}
my
(
$devices
)
=
$doc
->
findnodes
("
/domain/devices
");
my
$graphic
=
$devices
->
addNewChild
(
undef
,'
graphics
');
$graphic
->
setAttribute
(
type
=>
'
vnc
');
my
$port
=
(
delete
$data
->
{
port
}
or
'
auto
');
$graphic
->
setAttribute
(
port
=>
$port
)
if
$port
ne
'
auto
';
$graphic
->
setAttribute
(
autoport
=>
'
yes
')
if
$port
eq
'
auto
';
my
$ip
=
(
delete
$data
->
{
ip
}
or
$self
->
_vm
->
listen_ip
);
my
$listen
=
$graphic
->
addNewChild
(
undef
,'
listen
');