Commit 6f1c6bb5 authored by Francesc Guasch's avatar Francesc Guasch Committed by Fernando Verdugo
Browse files

Feature #973 cd (#980)

* wip(frontend): allow create cdrom disk devices

issue #973

* wip(volumes): store order number of volume

So we can sort them for change or removal

issue #973

* wip(backend): allow cdrom volumes

also store order and do not remove cdrom on machine removal

issue #973

* test(backend): test CD rom and boot order

Changed all the test with disk devices involved because
now CDs are a special case of disks.

issue #973

* feature(frontend): manage disk devices

Add, remove and change disk and CD settings

issue #973

* feature(backend): manage disk devices

Allow manage CDs and other disk devices including boot order

issue #973
parent 11cd218d
......@@ -2806,7 +2806,7 @@ sub _cmd_refresh_machine($self, $request) {
my $id_domain = $request->args('id_domain');
my $user = Ravada::Auth::SQL->search_by_id($request->args('uid'));
my $domain = Ravada::Domain->open($id_domain);
my $domain = Ravada::Domain->open($id_domain) or confess "Error: domain $id_domain not found";
$domain->list_volumes_info();
$domain->info($user);
......
......@@ -518,11 +518,18 @@ sub _around_remove_volume {
return $ok;
}
sub _around_list_volumes_info($orig, $self) {
sub _around_list_volumes_info($orig, $self, $attribute=undef, $value=undef) {
confess "Error: value must be supplied for filter attribute"
if defined $attribute && !defined $value;
return $self->$orig() if ref($self) =~ /^Ravada::Front/i;
return $self->$orig($attribute, $value) if ref($self) =~ /^Ravada::Front/i;
my @volumes = $self->$orig();
my @volumes = $self->$orig($attribute => $value);
#TODO make these atomic
my $sth = $$CONNECTOR->dbh->prepare("DELETE FROM volumes WHERE id_domain=?");
$sth->execute($self->id);
$sth->finish;
for my $vol (@volumes) {
$self->cache_volume_info(%$vol);
......@@ -1296,6 +1303,7 @@ sub _after_remove_domain {
sub _remove_all_volumes($self) {
for my $vol (@{$self->{_volumes}}) {
next if $vol =~ /iso$/;
$self->remove_volume($vol);
}
}
......@@ -1702,8 +1710,8 @@ sub _copy_clone($self, %args) {
,id_owner => $user->id
,@copy_arg
);
my @volumes = $self->list_volumes_info;
my @copy_volumes = $copy->list_volumes_info;
my @volumes = $self->list_volumes_info(device => 'disk');
my @copy_volumes = $copy->list_volumes_info(device => 'disk');
my %volumes = map { $_->{target} => $_->{file} } @volumes;
my %copy_volumes = map { $_->{target} => $_->{file} } @copy_volumes;
......@@ -3367,14 +3375,13 @@ sub set_ldap_access($self, $id_access, $allowed, $last) {
sub _get_volume_info($self, $name) {
my $sth = $$CONNECTOR->dbh->prepare(
"SELECT * from volumes "
." WHERE name=?"
." WHERE name=? "
." AND id_domain=? "
." ORDER by n_order"
);
$sth->execute($name);
$sth->execute($name, $self->id);
my $row = $sth->fetchrow_hashref();
confess "Error: volume $name belongs to domain $row->{id_domain}. "
."This is domain ".$self->id
if defined $row->{id_domain} && $self->id != $row->{id_domain};
return if !$row || !keys %$row;
if ( $row->{info} ) {
$row->{info} = decode_json($row->{info})
......@@ -3384,31 +3391,37 @@ sub _get_volume_info($self, $name) {
sub cache_volume_info($self, %info) {
my $name = delete $info{name} or confess "No name in info ".Dumper(\%info);
confess if $name eq 'tst_request_30_hardware_01';
my $row = $self->_get_volume_info($name);
if (!$row) {
my $file = $info{file} or
confess "Error: Missing file field ".Dumper(\%info);
my $file = (delete $info{file} or '');
confess "Error: Missing n_order field ".Dumper(\%info) if !exists $info{n_order};
my $n_order = delete $info{n_order};
eval {
my $sth = $$CONNECTOR->dbh->prepare(
"INSERT INTO volumes (id_domain, name, file, info) "
."VALUES(?,?,?,?)"
"INSERT INTO volumes (id_domain, name, file, n_order, info) "
."VALUES(?,?,?,?,?)"
);
$sth->execute($self->id
,$name
,$file
,$n_order
,encode_json(\%info));
};
confess "$name / $n_order \n".$@ if $@;
return;
}
for (keys %{$row->{info}}) {
$info{$_} = $row->{info}->{$_} if !exists $info{$_};
}
my $file = ($info{file} or $row->{file});
my $file = (delete $info{file} or $row->{file});
my $n_order = (delete $info{n_order} or $row->{n_order});
confess "Error: Missing file field ".Dumper(\%info, $row)
if !defined $file || !length($file);
my $sth = $$CONNECTOR->dbh->prepare(
"UPDATE volumes set info=?, name=?,file=?,id_domain=? WHERE id=?"
"UPDATE volumes set info=?, name=?,file=?,id_domain=?,n_order=? WHERE id=?"
);
$sth->execute(encode_json(\%info), $name, $file, $self->id, $row->{id});
$sth->execute(encode_json(\%info), $name, $file, $self->id, $n_order, $row->{id});
}
1;
......@@ -15,7 +15,6 @@ use File::Copy;
use File::Path qw(make_path);
use Hash::Util qw(lock_keys lock_hash);
use IPC::Run3 qw(run3);
use JSON::XS;
use Moose;
use Sys::Virt::Stream;
use Sys::Virt::Domain;
......@@ -121,6 +120,7 @@ sub list_disks {
for my $child ($disk->childNodes) {
if ($child->nodeName eq 'source') {
my $file = $child->getAttribute('file');
next if $file =~ /\.iso$/;
push @disks,($file);
}
}
......@@ -174,7 +174,8 @@ sub remove_disks {
confess $@ if $@;
$self->_vm->connect();
for my $file ($self->list_disks) {
for my $file ($self->list_disks( device => 'disk')) {
confess $file if $file =~ /iso$/;
if (! -e $file ) {
warn "WARNING: $file already removed for ".$self->name."\n"
if $0 !~ /.t$/;
......@@ -250,7 +251,9 @@ sub remove {
my @volumes;
if (!$self->is_removed ) {
@volumes = $self->list_disks();
for my $vol ( $self->list_volumes_info ) {
push @volumes,($vol->{file}) if $vol->{device} eq 'file';
}
}
if (!$self->is_removed && $self->domain && $self->domain->is_active) {
......@@ -302,40 +305,49 @@ sub _remove_file_image {
}
}
sub _disk_device {
my $self = shift;
my $with_info = shift;
sub _disk_device($self, $with_info=undef, $attribute=undef, $value=undef) {
my $doc = XML::LibXML->load_xml(string
=> $self->xml_description(Sys::Virt::Domain::XML_INACTIVE))
or die "ERROR: $!\n";
my @img;
my $list_disks = '';
my $n_order = 0;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') ne 'disk';
$list_disks .= $disk->toString();
my ($file,$target, $bus);
for my $child ($disk->childNodes) {
if ($child->nodeName eq 'source') {
$file = $child->getAttribute('file');
}
if ($child->nodeName eq 'target') {
$target = $child->getAttribute('dev');
$bus = $child->getAttribute('bus');
my ($source_node) = $disk->findnodes('source');
my $file;
$file = $source_node->getAttribute('file') if $source_node;
my ($target_node) = $disk->findnodes('target');
my $device = $disk->getAttribute('device');
my $target = $target_node->getAttribute('dev');
my $bus = $target_node->getAttribute('bus');
my ($boot_node) = $disk->findnodes('boot');
my $info = {};
$info = $self->_volume_info($file) if $file && $device eq 'disk';
$info->{device} = $device;
if (!$info->{name} ) {
if ($file) {
($info->{name}) = $file =~ m{.*/(.*)};
} else {
$info->{name} = $target."-".$info->{device};
}
}
$info->{target} = $target;
$info->{driver} = $bus;
$info->{n_order} = $n_order++;
$info->{boot} = $boot_node->getAttribute('order') if $boot_node;
next if defined $attribute
&& (!exists $info->{$attribute}
|| $info->{$attribute} ne $value);
if (!$with_info) {
push @img,($file);
push @img,($file) if $file;
next;
}
my $info = $self->_volume_info($file);
$info->{target} = $target;
$info->{driver} = $bus;
push @img,$info;
}
return @img;
......@@ -356,7 +368,10 @@ sub _volume_info($self, $file, $refresh=0) {
return $self->_volume_info($file, ++$refresh);
}
confess "Error: Volume $file not found" if !$vol;
if (!$vol) {
warn "Error: Volume $file not found";
return;
}
my $info = $vol->get_info;
$info->{file} = $file;
......@@ -375,8 +390,6 @@ sub _disk_devices_xml {
my @devices;
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') ne 'disk';
my $is_disk = 0;
for my $child ($disk->childNodes) {
$is_disk++ if $child->nodeName eq 'source';
......@@ -405,7 +418,7 @@ sub _create_qcow_base {
my @base_img;
for my $vol_data ( $self->list_volumes_info()) {
for my $vol_data ( $self->list_volumes_info( device => 'disk')) {
my ($file_img,$target) = ($vol_data->{file}, $vol_data->{target});
my $base_img = $file_img;
......@@ -883,6 +896,8 @@ sub add_volume {
my %args = @_;
my $bus = (delete $args{driver} or 'virtio');
my $boot = (delete $args{boot} or undef);
my $device = (delete $args{device} or 'disk');
my %valid_arg = map { $_ => 1 } ( qw( driver name size vm xml swap target file allocation));
for my $arg_name (keys %args) {
......@@ -917,7 +932,7 @@ sub add_volume {
my $driver_type = 'qcow2';
my $cache = 'default';
if ( $args{swap} ) {
if ( $args{swap} || $device eq 'cdrom' ) {
$cache = 'none';
$driver_type = 'raw';
}
......@@ -927,37 +942,125 @@ sub add_volume {
,file => $path
,type => $driver_type
,cache => $cache
,device => $device
,target => $target_dev
);
eval { $self->domain->attach_device($xml_device,Sys::Virt::Domain::DEVICE_MODIFY_CONFIG) };
die $@."\n".$self->domain->get_xml_description if$@;
die $@ if $@;
$self->_set_boot_order($path, $boot) if $boot;
return $path;
}
sub _set_boot_hd($self, $value) {
my $doc;
if ($value ) {
$doc = $self->_remove_boot_order() if $value;
} else {
$doc = XML::LibXML->load_xml(string => $self->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE));
}
my ($os) = $doc->findnodes('/domain/os');
my ($boot) = $os->findnodes('boot');
if (!$value) {
$os->removeChild($boot) or die "Error removing ".$boot->toString();
} else {
if (!$boot) {
$boot = $os->addNewChild(undef,'boot');
}
$boot->setAttribute(dev => 'hd');
}
my $new_domain = $self->_vm->vm->define_domain($doc->toString);
$self->domain($new_domain);
};
sub _remove_boot_order($self, $index=undef) {
return $self->_cmd_boot_order(0,$index,0);
}
sub _set_boot_order($self, $index, $order) {
my $doc = $self->_cmd_boot_order(1,$index, $order);
my ($os) = $doc->findnodes('/domain/os');
my ($boot) = $os->findnodes('boot');
$os->removeChild($boot) if $boot;
my $new_domain = $self->_vm->vm->define_domain($doc->toString);
$self->domain($new_domain);
}
sub _cmd_boot_order($self, $set, $index=undef, $order=1) {
my $doc = XML::LibXML->load_xml(string => $self->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE));
my $count = 0;
# if index is not numeric is the file, search the real index
$index = $self->_search_volume_index($index) if defined $index && $index !~ /^\d+$/;
for my $device ($doc->findnodes('/domain/devices/disk')) {
my ($boot) = $device->findnodes('boot');
if ( defined $index && $count++ != $index) {
next if !$set || !$boot;
my $this_order = $boot->getAttribute('order');
next if $this_order < $order;
$boot->setAttribute( order => $this_order+1);
warn "[$count] $this_order -> ".($this_order + 1);
next;
}
if (!$set) {
next if !$boot;
$device->removeChild($boot);
} else {
$boot = $device->addNewChild(undef,'boot') if !$boot;
$boot->setAttribute( order => $order );
}
}
return $doc;
}
sub _search_volume_index($self, $file) {
my $doc = XML::LibXML->load_xml(string => $self->domain->get_xml_description(Sys::Virt::Domain::XML_INACTIVE));
my $index = 0;
for my $device ($doc->findnodes('/domain/devices/disk')) {
my ($source) = $device->findnodes('source');
return $index if $source->getAttribute('file') eq $file;
$index++;
}
confess "I can't find file $file in ".$self->name;
}
sub _xml_new_device($self , %arg) {
my $bus = delete $arg{bus} or confess "Missing bus.";
my $file = delete $arg{file} or confess "Missing target.";
my $boot = delete $arg{boot};
my $device = delete $arg{device};
my $xml = <<EOT;
<disk type='file' device='disk'>
<disk type='file' device='$device'>
<driver name='qemu' type='$arg{type}' cache='$arg{cache}'/>
<source file='$file'/>
<backingStore/>
<target bus='$bus' dev='$arg{target}'/>
<address type=''/>
<boot/>
</disk>
EOT
my $device=XML::LibXML->load_xml(string => $xml);
my ($address) = $device->findnodes('/disk/address') or die "No address in ".$device->toString();
my $xml_device=XML::LibXML->load_xml(string => $xml);
my ($address) = $xml_device->findnodes('/disk/address') or die "No address in ".$xml_device->toString();
my $doc = XML::LibXML->load_xml(string => $self->xml_description);
$self->_change_xml_address($doc, $address, $bus);
return $device->toString();
my ($boot_xml) = $xml_device->findnodes('/disk/boot');
if ($boot) {
$boot_xml->setAttribute( order => $boot );
} else {
my ($disk) = $xml_device->findnodes('/disk');
$disk->removeChild($boot_xml) or die "I can't remove boot node from disk";
}
return $xml_device->toString();
}
sub _new_target_dev {
......@@ -971,10 +1074,6 @@ sub _new_target_dev {
my $dev='vd';
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') ne 'disk'
&& $disk->getAttribute('device') ne 'cdrom';
for my $child ($disk->childNodes) {
if ($child->nodeName eq 'target') {
# die $child->toString();
......@@ -1069,7 +1168,7 @@ For KVM it reads from the XML definition of the domain.
sub list_volumes {
my $self = shift;
return $self->disk_device();
return $self->disk_device(0,@_);
}
=head2 list_volumes_info
......@@ -1083,7 +1182,7 @@ For KVM it reads from the XML definition of the domain.
sub list_volumes_info {
my $self = shift;
return $self->disk_device("info");
return $self->disk_device("info",@_);
}
=head2 screenshot
......@@ -1511,7 +1610,7 @@ sub clean_swap_volumes {
my $self = shift;
return if !$self->is_local;
for my $file ($self->list_volumes) {
next if $file !~ /\.SWAP\.\w+/;
next if !$file || $file !~ /\.SWAP\.\w+/;
next if ! -e $file;
my $base = $self->_find_base($file) or next;
......@@ -1796,24 +1895,26 @@ sub remove_controller($self, $name, $index=0) {
return $ret;
}
sub _remove_device($self, $index, $device, $attribute_name, $attribute_value) {
sub _remove_device($self, $index, $device, $attribute_name=undef, $attribute_value=undef) {
my $doc = XML::LibXML->load_xml(string => $self->xml_description_inactive);
my ($devices) = $doc->findnodes('/domain/devices');
my $ind=0;
for my $controller ($devices->findnodes($device)) {
if ($controller->getAttribute($attribute_name) eq $attribute_value){
if( $ind==$index ){
$devices->removeChild($controller);
$self->_vm->connect if !$self->_vm->vm;
my $new_domain = $self->_vm->vm->define_domain($doc->toString);
$self->domain($new_domain);
return;
}
$ind++;
next if defined $attribute_name
&& $controller->getAttribute($attribute_name) ne $attribute_value;
if( $ind++==$index ){
$devices->removeChild($controller);
$self->_vm->connect if !$self->_vm->vm;
my $new_domain = $self->_vm->vm->define_domain($doc->toString);
$self->domain($new_domain);
return;
}
}
die "ERROR: $device $attribute_name=$attribute_value ".($index+1)
my $msg = "";
$msg = " $attribute_name=$attribute_value " if defined $attribute_name;
confess "ERROR: $device $msg $index"
." not removed, only ".($ind)." found\n";
}
......@@ -1822,10 +1923,19 @@ sub _remove_controller_usb($self, $index) {
}
sub _remove_controller_disk($self, $index) {
my @volumes = $self->list_volumes();
$self->_remove_device($index,'disk', device => 'disk');
my @volumes = $self->list_volumes_info();
confess "Error: domain ".$self->name
." trying to remove $index"
." has only ".scalar(@volumes)
if $index >= scalar(@volumes);
confess "Error: undefined volume $index ".Dumper(\@volumes)
if !defined $volumes[$index];
$self->remove_volume( $volumes[$index]);
$self->_remove_device($index,'disk');
my $file = $volumes[$index]->{file};
$self->remove_volume( $file ) if $file && $file !~ /\.iso$/;
$self->info(Ravada::Utils::user_daemon);
}
......@@ -1942,8 +2052,10 @@ sub _change_hardware_disk($self, $index, $data) {
die "Error: Volume file $file not found in ".$self->_vm->name if !$volume;
my $driver = delete $data->{driver};
my $boot = delete $data->{boot};
$self->_change_hardware_disk_bus($index, $driver) if $driver;
$self->_set_boot_order($index, $boot) if $boot;
my $capacity = delete $data->{'capacity'};
if ($capacity) {
......@@ -1966,7 +2078,6 @@ sub _change_hardware_disk_bus($self, $index, $bus) {
my $doc = XML::LibXML->load_xml(string => $self->xml_description);
for my $disk ($doc->findnodes('/domain/devices/disk')) {
next if $disk->getAttribute('device') ne 'disk';
next if $count++ != $index;
my ($target) = $disk->findnodes('target') or die "No target";
......
......@@ -112,6 +112,23 @@ sub is_paused {
return $self->_value('is_paused');
}
sub _check_value_disk($self, $value) {
return if !exists $value->{device};
my %target;
my %file;
confess "Not hash ".ref($value)."\n".Dumper($value) if ref($value) ne 'HASH';
for my $device (@{$value->{device}}) {
confess "Duplicated target ".Dumper($value)
if $target{$device->{target}}++;
confess "Duplicated file" .Dumper($value)
if $file{$device->{file}}++;
}
}
sub _store {
my $self = shift;
......@@ -119,6 +136,8 @@ sub _store {
my ($var, $value) = @_;
$self->_check_value_disk($value) if $var eq 'hardware';
my $data = $self->_load();
$data->{$var} = $value;
......@@ -211,7 +230,9 @@ sub start {
sub prepare_base {
my $self = shift;
for my $file_qcow ($self->list_volumes) {;
for my $volume ($self->list_volumes_info) {;
next if $volume->{device} ne 'disk';
my $file_qcow = $volume->{file};
my $file_base = $file_qcow.".qcow";
if ( $file_qcow =~ /.SWAP.img$/ ) {
......@@ -243,8 +264,11 @@ sub _vol_remove {
sub remove_disks {
my $self = shift;
my @files = $self->list_disks;
for my $file (@files) {
my @files = $self->list_volumes_info;
for my $vol (@files) {
my $file = $vol->{file};
my $device = $vol->{device};
next if $device eq 'cdrom';
$self->_vol_remove($file);
}
......@@ -269,12 +293,17 @@ sub add_volume {
my %args = @_;
my $device = ( delete $args{device} or 'disk' );
my $suffix = ".img";
$suffix = '.SWAP.img' if $args{swap};
$args{name} = Ravada::Utils::random_name(4) if !$args{name};
$args{file} = $self->_config_dir."/".$self->name.".$args{name}$suffix"
if !$args{file};
if ( !$args{file} ) {
my $vol_name = ($args{name} or Ravada::Utils::random_name(4) );
$args{file} = $self->_config_dir."/".$vol_name.".$suffix"
}
($args{name}) = $args{file} =~ m{.*/(.*)};
confess "Volume path must be absolute , it is '$args{file}'"
if $args{file} !~ m{^/};
......@@ -283,7 +312,7 @@ sub add_volume {
$args{capacity} = 1024 if !exists $args{capacity};
my %valid_arg = map { $_ => 1 } ( qw( name capacity file vm type swap target allocation
driver
driver boot
));
for my $arg_name (keys %args) {