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
656de3dd
Commit
656de3dd
authored
Mar 01, 2017
by
root
Browse files
Merge branch 'swap' into rovello.2
parents
be1eaa13
fd4095c9
Changes
16
Hide whitespace changes
Inline
Side-by-side
README.md
View file @
656de3dd
...
...
@@ -12,14 +12,6 @@ Remote Access: [Spice](http://www.spice-space.org/)
Read
[
docs/INSTALL.md
](
https://github.com/frankiejol/ravada/blob/master/docs/INSTALL.md
)
## Run
### Development
To run it in development mode run those commands in two different terminals:
$ morbo ./rvd_front.pl
$ sudo ./bin/rvd_back.pl --debug
Connect to the server with a web browser at http://servername:3000/
### Production
...
...
docs/swap_partition.md
0 → 100644
View file @
656de3dd
Swap Partition
==============
Though installing the Operating System in a Virtual Machine may
be the same as in real machines, carefully planning the swap partition of the virtual machines
will save a lot of disk space. Follow those guidelines.
Swap Volume
-----------
Mark at the creation of the Virtual Machine that swap disk volume.
The desired max size must be declared there. That way a different
disk will be created with that purpose. This volume is different
than regular data disk volumes: it will be created only at the start
of the machine and it will be destroyed at shutdown. Also, this
volume won't keep incremental changes from the base, as data volumes do.
Partitioning
------------
Later on we will address particular considerations for swap space
in different operating systems. By now, keep in mind that the best
practice is to keep a disk volume
*only for swap*
.
Linux
-----
etc/xml/miniremix-volume.xml
0 → 100644
View file @
656de3dd
<volume
type=
'file'
>
<name>
__name__.img
</name>
<key>
/var/lib/libvirt/images/__name__.img
</key>
<source>
</source>
<capacity
unit=
'bytes'
>
10442450944
</capacity>
<allocation
unit=
'bytes'
>
5395775488
</allocation>
<target>
<path>
/var/lib/libvirt/images/__name__.img
</path>
<format
type=
'qcow2'
/>
<permissions>
<mode>
0600
</mode>
<owner>
0
</owner>
<group>
0
</group>
</permissions>
<timestamps>
<atime>
1461924534.956408726
</atime>
<mtime>
1461672183.623804946
</mtime>
<ctime>
1461672193.267892180
</ctime>
</timestamps>
</target>
</volume>
etc/xml/swap-volume.xml
0 → 100644
View file @
656de3dd
<volume
type=
'file'
>
<name>
__name__.img
</name>
<key>
/var/lib/libvirt/images/__name__.img
</key>
<source>
</source>
<capacity
unit=
'bytes'
>
10442450944
</capacity>
<allocation
unit=
'bytes'
>
5395775488
</allocation>
<target>
<path>
/var/lib/libvirt/images/__name__.img
</path>
<format
type=
'raw'
cache=
'none'
/>
<permissions>
<mode>
0600
</mode>
<owner>
0
</owner>
<group>
0
</group>
</permissions>
<timestamps>
<atime>
1461924534.956408726
</atime>
<mtime>
1461672183.623804946
</mtime>
<ctime>
1461672193.267892180
</ctime>
</timestamps>
</target>
</volume>
lib/Ravada/Domain.pm
View file @
656de3dd
...
...
@@ -99,7 +99,7 @@ before 'remove' => \&_pre_remove_domain;
before
'
prepare_base
'
=>
\
&_pre_prepare_base
;
after
'
prepare_base
'
=>
\
&_post_prepare_base
;
before
'
start
'
=>
\
&_start_preconditions
;
after
'
start
'
=>
\
&_post_start
;
...
...
@@ -132,7 +132,8 @@ sub _vm_disconnect {
}
sub
_start_preconditions
{
my
(
$self
)
=
@_
;
if
(
scalar
@
_
%
2
)
{
_allow_manage_args
(
@
_
);
}
else
{
...
...
@@ -143,6 +144,8 @@ sub _start_preconditions{
}
sub
_allow_manage_args
{
my
$self
=
shift
;
...
...
@@ -387,7 +390,7 @@ sub _select_domain_db {
sub
_prepare_base_db
{
my
$self
=
shift
;
my
$
file_img
=
shift
;
my
@
file_img
=
@_
;
if
(
!
$self
->
_select_domain_db
)
{
confess
"
CRITICAL: The data should be already inserted
";
...
...
@@ -398,7 +401,9 @@ sub _prepare_base_db {
.
"
(id_domain , file_base_img )
"
.
"
VALUES(?,?)
"
);
$sth
->
execute
(
$self
->
id
,
$file_img
);
for
my
$file_img
(
@file_img
)
{
$sth
->
execute
(
$self
->
id
,
$file_img
);
}
$sth
->
finish
;
$sth
=
$$CONNECTOR
->
dbh
->
prepare
(
...
...
@@ -749,7 +754,31 @@ sub _post_shutdown {
$self
->
_remove_temporary_machine
(
@
_
);
$self
->
_remove_iptables
(
@
_
);
$self
->
clean_swap_volumes
(
@
_
)
if
$self
->
id_base
();
}
=head2 add_volume_swap
Adds a swap volume to the virtual machine
Arguments:
size => $kb
name => $name (optional)
=cut
sub
add_volume_swap
{
my
$self
=
shift
;
my
%arg
=
@_
;
$arg
{
name
}
=
$self
->
name
if
!
$arg
{
name
};
$self
->
add_volume
(
%arg
,
swap
=>
1
);
}
sub
image_swap_suffix
{
return
"
.SWAP.img
";
}
sub
_remove_iptables
{
...
...
@@ -996,6 +1025,23 @@ sub is_public {
return
$self
->
_data
('
is_public
');
}
=head2 clean_swap_volumes
Check if the domain has swap volumes defined, and clean them
$domain->clean_swap_volumes();
=cut
sub
remove_swap_volumes
{
my
$self
=
shift
;
for
my
$file
(
$self
->
list_volumes
)
{
$self
->
clean_disk
(
$file
)
if
$file
=~
/.SWAP\.img$/
;
}
}
sub
_pre_rename
{
my
$self
=
shift
;
...
...
lib/Ravada/Domain/KVM.pm
View file @
656de3dd
...
...
@@ -184,7 +184,7 @@ sub _remove_file_image {
eval
{
$self
->
_vol_remove
(
$file
,
1
)
};
if
(
-
e
$file
)
{
eval
{
eval
{
unlink
$file
or
die
"
$!
$file
"
;
$self
->
storage
->
refresh
();
};
...
...
@@ -197,7 +197,7 @@ sub _remove_file_image {
sub
_disk_device
{
my
$self
=
shift
;
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
)
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
)
or
die
"
ERROR: $!
\n
";
my
@img
;
...
...
@@ -227,7 +227,7 @@ sub _disk_devices_xml {
my
$self
=
shift
;
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
)
->
get_xml_description
)
or
die
"
ERROR: $!
\n
";
my
@devices
;
...
...
@@ -261,41 +261,106 @@ sub disk_device {
sub
_create_qcow_base
{
my
$self
=
shift
;
my
@qcow_img
;
my
@base_img
;
my
$base_name
=
$self
->
name
;
for
my
$file_img
(
$self
->
list_volumes
())
{
confess
"
ERROR: missing
$file_img
"
if
!-
e
$file_img
;
my
$base_img
=
$file_img
;
my
@cmd
;
if
(
$base_img
=~
/\.SWAP\.img$/
)
{
$base_img
=~
s/(SWAP\.img$)/base.$1/
;
@cmd
=
_cmd_copy
(
$file_img
,
$base_img
);
}
else
{
$base_img
=~
s{\.\w+$}{\.ro.qcow2}
;
@cmd
=
_cmd_convert
(
$file_img
,
$base_img
);
}
push
@base_img
,(
$base_img
);
my
(
$in
,
$out
,
$err
);
run3
(
\
@cmd
,
\
$in
,
\
$out
,
\
$err
);
warn
$out
if
$out
;
warn
$err
if
$err
;
if
(
!
-
e
$base_img
)
{
warn
"
ERROR: Output file
$base_img
not created at
"
.
join
("
",
@cmd
);
exit
;
}
chmod
0555
,
$base_img
;
}
$self
->
_prepare_base_db
(
@base_img
);
return
@base_img
;
}
sub
_cmd_convert
{
my
(
$base_img
,
$qcow_img
)
=
@_
;
return
('
qemu-img
','
convert
',
'
-O
','
qcow2
',
$base_img
,
$qcow_img
);
}
sub
_cmd_copy
{
my
(
$base_img
,
$qcow_img
)
=
@_
;
return
('
cp
'
,
$base_img
,
$qcow_img
);
}
=pod
sub _create_swap_base {
my $self = shift;
my @swap_img;
my $base_name = $self->name;
for my $base_img ( $self->list_volumes()) {
next unless $base_img =~ 'SWAP';
confess "ERROR: missing $base_img"
if !-e $base_img;
my
$
qcow
_img
=
$base_img
;
$
qcow
_img
=~
s{\.\w+$}{\.ro.
qcow2
}
;
my $
swap
_img = $base_img;
$
swap
_img =~ s{\.\w+$}{\.ro.
img
};
push
@
qcow
_img
,(
$
qcow
_img
);
push @
swap
_img,($
swap
_img);
my @cmd = ('qemu-img','convert',
'
-O
','
qcow2
',
$base_img
,
$
qcow
_img
'-O','
raw
', $base_img
,$
swap
_img
);
my ($in, $out, $err);
run3(\@cmd,\$in,\$out,\$err);
warn
$out
if
$out
;
warn
$err
if
$err
;
warn $out if $out;
warn $err if $err;
if
(
!
-
e
$
qcow
_img
)
{
warn
"
ERROR: Output file
$
qcow
_img
not created at
"
.
join
("
",
@cmd
)
.
"
\n
";
if (! -e $
swap
_img) {
warn "ERROR: Output file $
swap
_img not created at ".join(" ",@cmd)."\n";
exit;
}
chmod
0555
,
$
qcow
_img
;
$self
->
_prepare_base_db
(
$
qcow
_img
);
chmod 0555,$
swap
_img;
$self->_prepare_base_db($
swap
_img);
}
return
@
qcow
_img
;
return @
swap
_img;
}
=cut
=head2 prepare_base
Prepares a base virtual machine with this domain disk
...
...
@@ -306,7 +371,9 @@ Prepares a base virtual machine with this domain disk
sub
prepare_base
{
my
$self
=
shift
;
return
$self
->
_create_qcow_base
();
# my @img = $self->_create_swap_base();
my
@img
=
$self
->
_create_qcow_base
();
return
@img
;
}
=head2 display
...
...
@@ -319,7 +386,7 @@ sub display {
my
$self
=
shift
;
my
$xml
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
);
my
(
$graph
)
=
$xml
->
findnodes
('
/domain/devices/graphics
')
my
(
$graph
)
=
$xml
->
findnodes
('
/domain/devices/graphics
')
or
die
"
ERROR: I can't find graphic
";
my
(
$type
)
=
$graph
->
getAttribute
('
type
');
...
...
@@ -380,7 +447,7 @@ sub shutdown {
sub
_do_shutdown
{
my
$self
=
shift
;
my
(
$timeout
,
$req
)
=
@_
;
$timeout
=
$TIMEOUT_SHUTDOWN
if
!
defined
$timeout
;
$self
->
domain
->
shutdown
();
...
...
@@ -447,14 +514,14 @@ sub is_paused {
my
$self
=
shift
;
my
(
$state
,
$reason
)
=
$self
->
domain
->
get_state
();
return
0
if
$state
==
1
;
#TODO, find out which one of those id "1" and remove it from this list
#
return
$state
&&
(
$state
==
Sys::Virt::Domain::
STATE_PAUSED_UNKNOWN
||
$state
==
Sys::Virt::Domain::
STATE_PAUSED_USER
return
$state
&&
(
$state
==
Sys::Virt::Domain::
STATE_PAUSED_UNKNOWN
||
$state
==
Sys::Virt::Domain::
STATE_PAUSED_USER
||
$state
==
Sys::Virt::Domain::
STATE_PAUSED_DUMP
||
$state
==
Sys::Virt::Domain::
STATE_PAUSED_FROM_SNAPSHOT
||
$state
==
Sys::Virt::Domain::
STATE_PAUSED_IOERROR
...
...
@@ -478,28 +545,43 @@ sub add_volume {
my
$self
=
shift
;
my
%args
=
@_
;
my
%valid_arg
=
map
{
$_
=>
1
}
(
qw( name size
path
vm xml)
);
my
%valid_arg
=
map
{
$_
=>
1
}
(
qw( name size vm xml
swap
)
);
for
my
$arg_name
(
keys
%args
)
{
confess
"
Unknown arg
$arg_name
"
if
!
$valid_arg
{
$arg_name
};
}
confess
"
Missing vm
"
if
!
$args
{
vm
};
# confess "Missing vm" if !$args{vm};
$args
{
vm
}
=
$self
->
_vm
if
!
$args
{
vm
};
confess
"
Missing name
"
if
!
$args
{
name
};
$args
{
xml
}
=
'
etc/xml/default-volume.xml
'
if
!
$args
{
xml
};
if
(
!
$args
{
xml
})
{
$args
{
xml
}
=
'
etc/xml/default-volume.xml
';
$args
{
xml
}
=
'
etc/xml/swap-volume.xml
'
if
$args
{
swap
};
}
my
$path
=
$args
{
vm
}
->
create_volume
(
$args
{
name
},
$args
{
xml
}
,(
$args
{
size
}
or
undef
));
my
$path
=
$args
{
vm
}
->
create_volume
(
name
=>
$args
{
name
}
,
xml
=>
$args
{
xml
}
,
swap
=>
(
$args
{
swap
}
or
0
)
,
size
=>
(
$args
{
size
}
or
undef
)
);
# TODO check if <target dev="/dev/vda" bus='virtio'/> widhout dev works it out
# change dev=vd* , slot=*
#
my
$target_dev
=
$self
->
_new_target_dev
();
my
$pci_slot
=
$self
->
_new_pci_slot
();
my
$driver_type
=
'
qcow2
';
my
$cache
=
'
default
';
if
(
$args
{
swap
}
)
{
$cache
=
'
none
';
$driver_type
=
'
raw
';
}
my
$xml_device
=
<<EOT;
<disk type='file' device='disk'>
<driver name='qemu' type='
qcow2
'/>
<driver name='qemu' type='
$driver_type' cache='$cache
'/>
<source file='$path'/>
<backingStore/>
<target bus='virtio' dev='$target_dev'/>
...
...
@@ -512,10 +594,12 @@ EOT
die
$@
.
"
\n
"
.
$self
->
domain
->
get_xml_description
if
$@
;
}
sub
_new_target_dev
{
my
$self
=
shift
;
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
)
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
)
or
die
"
ERROR: $!
\n
";
my
%target
;
...
...
@@ -542,7 +626,7 @@ sub _new_target_dev {
sub
_new_pci_slot
{
my
$self
=
shift
;
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
)
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
)
or
die
"
ERROR: $!
\n
";
my
%target
;
...
...
@@ -885,17 +969,19 @@ sub spinoff_volumes {
unlink
(
$volume_tmp
)
or
die
"
ERROR $! removing
$volume
.tmp
"
if
-
e
$volume_tmp
;
next
if
$volume
=~
/.SWAP.img$/
;
my
@cmd
=
('
qemu-img
'
,'
convert
'
,'
-O
','
qcow2
'
,
$volume
,
$volume_tmp
,'
convert
'
,'
-O
','
qcow2
'
,
$volume
,
$volume_tmp
);
my
(
$in
,
$out
,
$err
);
run3
(
\
@cmd
,
\
$in
,
\
$out
,
\
$err
);
warn
$out
if
$out
;
warn
$err
if
$err
;
die
"
ERROR: Output file
$volume_tmp
not created at
"
.
join
("
",
@cmd
)
.
"
\n
"
die
"
ERROR: Temporary output file
$volume_tmp
not created at
"
.
join
("
",
@cmd
)
.
"
\n
"
if
(
!
-
e
$volume_tmp
);
copy
(
$volume_tmp
,
$volume
)
or
die
"
$!
$volume_tmp
->
$volume
";
...
...
@@ -926,4 +1012,112 @@ sub _set_spice_ip {
}
}
sub
_hwaddr
{
my
$self
=
shift
;
my
$doc
=
XML::
LibXML
->
load_xml
(
string
=>
$self
->
domain
->
get_xml_description
);
my
@hwaddr
;
for
my
$mac
(
$doc
->
findnodes
("
/domain/devices/interface/mac
"))
{
push
@hwaddr
,(
$mac
->
getAttribute
('
address
'));
}
return
@hwaddr
;
}
sub
ip
{
my
$self
=
shift
;
my
@nics
=
$self
->
domain
->
get_interface_addresses
(
Sys::Virt::Domain::
INTERFACE_ADDRESSES_SRC_LEASE
);
return
if
!
@nics
;
return
$nics
[
0
]
->
{
addrs
}
->
[
0
]
->
{
addr
};
# search the leases tables, we may need it some day
# for my $mac ($self->_hwaddr) {
# warn $mac;
# for my $network ($self->_vm->vm->list_all_networks) {
# warn $network->get_name();
# my @leases = $network->get_dhcp_leases($mac);
# warn Dumper(\@leases);
# return $leases[0]->{ipaddr} if @leases;
#
# @leases = $network->get_dhcp_leases();
# warn Dumper(\@leases);
# }
# }
return
;
}
=head2 create_swap_disk
Create a swap disk image
If the file is already there, returns silently.
Argument: path
$domain->create_swap_disk($path);
=cut
sub
create_swap_disk
{
my
$self
=
shift
;
my
$path
=
shift
;
return
if
-
e
$path
;
my
(
$size
)
=
$path
=~
m{\.size(\d+)\.SWAP.img$}
;
$size
=
512
*
1024
*
1024
if
!
$size
;
my
$file
=
$self
->
_vm
->
create_volume
(
name
=>
$self
->
name
,
capacity
=>
$size
,
allocation
=>
int
(
$size
/
10
)
,
xml
=>
'
etc/xml/swap-volume.xml
'
,
path
=>
$path
);
if
(
!
-
e
$path
)
{
warn
"
ERROR: Output file
$path
not created at
";
exit
;
}
}
sub
_find_base
{
my
$self
=
shift
;
my
$file
=
shift
;
my
@cmd
=
(
'
qemu-img
','
info
',
$file
);
my
(
$in
,
$out
,
$err
);
run3
(
\
@cmd
,
\
$in
,
\
$out
,
\
$err
);
my
(
$base
)
=
$out
=~
m{^backing file: (.*)}mi
;
die
"
No base for
$file
in
$out
"
if
!
$base
;
return
$base
;
}
sub
clean_swap_volumes
{
my
$self
=
shift
;
for
my
$file
(
$self
->
list_volumes
)
{
next
if
$file
!~
/\.SWAP\.img/
;
my
$base
=
$self
->
_find_base
(
$file
)
or
next
;
my
@cmd
=
('
qemu-img
','
create
'
,'
-f
','
qcow2
'
,'
-b
',
$base
,
$file
);
my
(
$in
,
$out
,
$err
);
run3
(
\
@cmd
,
\
$in
,
\
$out
,
\
$err
);
}
}
sub
remove_disk
{
my
$self
=
shift
;
my
$path
=
shift
;
$self
->
_vol_remove
(
$path
);
}
1
;
lib/Ravada/Domain/Void.pm
View file @
656de3dd
...
...
@@ -19,6 +19,12 @@ has 'domain' => (
,
required
=>
1
);
has
'
_ip
'
=>
(
is
=>
'
rw
'
,
isa
=>
'
Str
'
,
default
=>
sub
{
return
'
1.1.1.
'
.
int
rand
(
255
)}
);
our
$DIR_TMP
=
"
/var/tmp/rvd_void
";
#######################################3
...
...
@@ -54,7 +60,7 @@ sub display {
my
$self
=
shift
;
my
$ip
=
$self
->
_vm
->
ip
();
return
"
void://
$ip
:0/
";
return
"
void://
$ip
:
599
0/
";
}
sub
is_active
{
...
...
@@ -136,12 +142,16 @@ sub prepare_base {
my
$self
=
shift
;
for
my
$file_qcow
(
$self
->
list_volumes
)
{;
$file_qcow
.=
"
.qcow
";
my
$file_base
=
$file_qcow
.
"
.qcow
";
open
my
$out
,'
>
',
$file_qcow
or
die
"
$!
$file_qcow
";
if
(
$file_qcow
=~
/.SWAP.img$/
)
{
$file_base
=
$file_qcow
;
$file_base
=~
s/(\.SWAP.img$)/base-$1/
;