Unverified Commit da8fd4ed authored by Francesc Guasch's avatar Francesc Guasch Committed by GitHub
Browse files

Feature #1011 net (#1055)

feature(KVM): manage network interfaces

* feature(frontend): get network interfaces
* feature(backend): manage KVM network interfaces
* feature(network): list network interfaces

* test(backend): test KVM network interfaces
* test(KVM): skip network bridge if not available
* test(network): test network bridge
* test(network): test list interfaces

* refactor(frontend): hide list requests and properly wait

issue #1011
parent 0c989fa6
......@@ -10,6 +10,7 @@ use Data::Dumper;
use DBIx::Connector;
use File::Copy;
use Hash::Util qw(lock_hash);
use JSON::XS;
use Moose;
use POSIX qw(WNOHANG);
use Time::HiRes qw(gettimeofday tv_interval);
......@@ -1156,6 +1157,7 @@ sub _upgrade_tables {
$self->_upgrade_table('requests','at_time','int(11) DEFAULT NULL');
$self->_upgrade_table('requests','pid','int(11) DEFAULT NULL');
$self->_upgrade_table('requests','start_time','int(11) DEFAULT NULL');
$self->_upgrade_table('requests','output','text DEFAULT NULL');
$self->_upgrade_table('requests','after_request','int(11) DEFAULT NULL');
$self->_upgrade_table('requests','at_time','int(11) DEFAULT NULL');
......@@ -2935,6 +2937,19 @@ sub _cmd_connect_node($self, $request) {
$node->connect() && $request->error("Connection OK");
}
sub _cmd_list_network_interfaces($self, $request) {
my $vm_type = $request->args('vm_type');
my $type = $request->defined_arg('type');
my @type;
@type = ( $type ) if $type;
my $vm = Ravada::VM->open( type => $vm_type );
my @ifs = $vm->list_network_interfaces( @type );
$request->output(encode_json(\@ifs));
}
sub _clean_requests($self, $command, $request=undef) {
my $query = "DELETE FROM requests "
." WHERE command=? "
......@@ -3176,6 +3191,9 @@ sub _req_method {
#users
,post_login => \&_cmd_post_login
#networks
,list_network_interfaces => \&_cmd_list_network_interfaces
);
return $methods{$cmd};
}
......
......@@ -65,18 +65,22 @@ our %SET_DRIVER_SUB = (
our %GET_CONTROLLER_SUB = (
usb => \&_get_controller_usb
,disk => \&_get_controller_disk
,network => \&_get_controller_network
);
our %SET_CONTROLLER_SUB = (
usb => \&_set_controller_usb
,disk => \&_set_controller_disk
,network => \&_set_controller_network
);
our %REMOVE_CONTROLLER_SUB = (
usb => \&_remove_controller_usb
,disk => \&_remove_controller_disk
,network => \&_remove_controller_network
);
our %CHANGE_HARDWARE_SUB = (
disk => \&_change_hardware_disk
,network => \&_change_hardware_network
);
##################################################
......@@ -1124,16 +1128,17 @@ sub _new_pci_slot{
for my $child ($disk->childNodes) {
if ($child->nodeName eq 'address') {
# die $child->toString();
$target{ $child->getAttribute('slot') }++
if $child->getAttribute('slot');
my $hex = $child->getAttribute('slot');
next if !defined $hex;
my $dec = hex($hex);
$target{$dec}++;
}
}
}
}
for ( 1 .. 99) {
$_ = "0$_" if length $_ < 2;
my $new = '0x'.$_;
return $new if !$target{$new};
for my $dec ( 1 .. 99) {
next if $target{$dec};
return sprintf("0x%X", $dec);
}
}
......@@ -1898,6 +1903,24 @@ sub _set_controller_disk($self, $number, $data) {
$self->add_volume(%$data);
}
sub _set_controller_network($self, $number, $data) {
my $driver = (delete $data->{driver} or 'virtio');
confess "Error: unkonwn fields in data ".Dumper($data) if keys %$data;
my $pci_slot = $self->_new_pci_slot();
my $device = "<interface type='network'>
<mac address='52:54:00:a7:49:71'/>
<source network='default'/>
<model type='$driver'/>
<address type='pci' domain='0x0000' bus='0x00' slot='$pci_slot' function='0x0'/>
</interface>";
$self->domain->attach_device($device, Sys::Virt::Domain::DEVICE_MODIFY_CONFIG);
}
sub remove_controller($self, $name, $index=0) {
my $sub = $REMOVE_CONTROLLER_SUB{$name};
......@@ -1917,7 +1940,7 @@ sub _remove_device($self, $index, $device, $attribute_name=undef, $attribute_val
my $ind=0;
for my $controller ($devices->findnodes($device)) {
next if defined $attribute_name
&& $controller->getAttribute($attribute_name) ne $attribute_value;
&& $controller->getAttribute($attribute_name) !~ $attribute_value;
if( $ind++==$index ){
$devices->removeChild($controller);
......@@ -1931,7 +1954,7 @@ sub _remove_device($self, $index, $device, $attribute_name=undef, $attribute_val
my $msg = "";
$msg = " $attribute_name=$attribute_value " if defined $attribute_name;
confess "ERROR: $device $msg $index"
." not removed, only ".($ind)." found\n";
." not removed, only ".($ind)." found in ".$self->name."\n";
}
sub _remove_controller_usb($self, $index) {
......@@ -1955,6 +1978,10 @@ sub _remove_controller_disk($self, $index) {
$self->info(Ravada::Utils::user_daemon);
}
sub _remove_controller_network($self, $index) {
$self->_remove_device($index,'interface', type => qr'(bridge|network)');
}
=head2 pre_remove
Code to run before removing the domain. It can be implemented in each domain.
......@@ -2152,6 +2179,59 @@ sub _change_hardware_disk_bus($self, $index, $bus) {
$self->_post_change_hardware($doc);
}
sub _change_hardware_network($self, $index, $data) {
my $doc = XML::LibXML->load_xml(string => $self->xml_description);
my $type = delete $data->{type};
my $driver = lc(delete $data->{driver} or '');
my $bridge = delete $data->{bridge};
my $network = delete $data->{network};
die "Error: Unknown arguments ".Dumper($data) if keys %$data;
$type = lc($type) if defined $type;
die "Error: Unknown type '$type' . Known: bridge, NAT"
if $type && $type !~ /^(bridge|nat)$/;
die "Error: Bridged type requires bridge ".Dumper($data)
if $type && $type eq 'bridge' && !$bridge;
die "Error: NAT type requires network ".Dumper($data)
if $type && $type eq 'nat' && !$network;
$type = 'network' if $type && $type eq 'nat';
my $count = 0;
my $changed = 0;
for my $interface ($doc->findnodes('/domain/devices/interface')) {
next if $interface->getAttribute('type') !~ /^(bridge|network)/;
next if $count++ != $index;
my ($model_xml) = $interface->findnodes('model') or die "No model";
my ($source_xml) = $interface->findnodes('source') or die "No source";
$source_xml->removeAttribute('bridge') if $network;
$source_xml->removeAttribute('network') if $bridge;
$interface->setAttribute(type => $type) if $type;
$model_xml->setAttribute(type => $driver) if $driver;
$source_xml->setAttribute(bridge => $bridge) if $bridge;
$source_xml->setAttribute(network=> $network) if $network;
$changed++;
}
die "Error: interface $index not found in ".$self->name if !$changed;
$self->_post_change_hardware($doc);
}
sub _post_change_hardware($self, $doc) {
my $new_domain = $self->_vm->vm->define_domain($doc->toString);
$self->domain($new_domain);
......
......@@ -12,6 +12,7 @@ Ravada::Front - Web Frontend library for Ravada
use Carp qw(carp);
use DateTime;
use Hash::Util qw(lock_hash);
use IPC::Run3 qw(run3);
use JSON::XS;
use Moose;
use Ravada;
......@@ -881,6 +882,7 @@ sub list_requests($self, $id_domain_req=undef, $seconds=60) {
|| $command eq 'screenshot'
|| $command eq 'connect_node'
|| $command eq 'post_login'
|| $command eq 'list_network_interfaces'
;
next if ( $command eq 'force_shutdown'
|| $command eq 'start'
......@@ -1069,6 +1071,35 @@ sub add_node($self,%arg) {
return $req->id;
}
sub list_network_interfaces($self, %args) {
my $vm_type = delete $args{vm_type}or confess "Error: missing vm_type";
my $type = delete $args{type} or confess "Error: missing type";
my $user = delete $args{user} or confess "Error: missing user";
my $timeout = delete $args{timeout};
$timeout = 60 if !defined $timeout;
confess "Error: Unknown args ".Dumper(\%args) if keys %args;
my $cache_key = "_interfaces_$type";
return $self->{$cache_key} if exists $self->{$cache_key};
my $req = Ravada::Request->list_network_interfaces(
vm_type => $vm_type
,type => $type
,uid => $user->id
);
if ( defined $timeout ) {
$self->wait_request($req, $timeout);
}
return [] if $req->status ne 'done';
my $interfaces = decode_json($req->output());
$self->{$cache_key} = $interfaces;
return $interfaces;
}
=head2 version
Returns the version of the main module
......
......@@ -12,6 +12,7 @@ use feature qw(signatures);
our %GET_CONTROLLER_SUB = (
usb => \&_get_controller_usb
,disk => \&_get_controller_disk
,network => \&_get_controller_network
);
our %GET_DRIVER_SUB = (
......@@ -56,6 +57,41 @@ sub _get_controller_disk($self) {
return $self->list_volumes_info();
}
sub _get_controller_network($self) {
$self->xml_description if !$self->readonly();
my $doc = XML::LibXML->load_xml(string => $self->_data_extra('xml'));
my @ret;
my $count = 0;
for my $interface ($doc->findnodes('/domain/devices/interface')) {
next if $interface->getAttribute('type') !~ /^(bridge|network)/;
my ($model) = $interface->findnodes('model') or die "No model";
my ($source) = $interface->findnodes('source') or die "No source";
my $type = 'NAT';
$type = 'bridge' if $source->getAttribute('bridge');
my ($address) = $interface->findnodes('address');
my $name = "en";
if ($address->getAttribute('type') eq 'pci') {
my $slot = $address->getAttribute('slot');
$name .="s".hex($slot);
} else {
$name .="o$count";
}
$count++;
push @ret,({
type => $type
,name => $name
,driver => $model->getAttribute('type')
,bridge => $source->getAttribute('bridge')
,network => $source->getAttribute('network')
});
}
return @ret;
}
=head2 get_driver
Gets the value of a driver
......
......@@ -29,7 +29,7 @@ Request a command to the ravada backend
=cut
our %FIELD = map { $_ => 1 } qw(error);
our %FIELD = map { $_ => 1 } qw(error output);
our %FIELD_RO = map { $_ => 1 } qw(id name);
our $args_manage = { name => 1 , uid => 1 };
......@@ -92,6 +92,9 @@ our %VALID_ARG = (
#users
,post_login => { user => 1, locale => 2 }
#networks
,list_network_interfaces => { uid => 1, vm_type => 1, type => 2 }
);
our %CMD_SEND_MESSAGE = map { $_ => 1 }
......@@ -543,6 +546,11 @@ sub domdisplay {
sub _new_request {
my $self = shift;
if (!ref($self)) {
my $class = $self;
$self = {};
bless ($self, $class);
}
my %args = @_;
$args{status} = 'requested';
......
......@@ -2247,6 +2247,75 @@ sub _fetch_dir_cert($self) {
close $in;
}
sub list_network_interfaces($self, $type) {
my $sub = {
nat => \&_list_nat_interfaces
,bridge => \&_list_bridges
};
my $cmd = $sub->{$type} or confess "Error: Unknown interface type $type";
return $cmd->($self);
}
sub _list_nat_interfaces($self) {
my ($in, $out, $err);
my @cmd = ( '/usr/bin/virsh','net-list');
run3(\@cmd, \$in, \$out, \$err);
my @lines = split /\n/,$out;
shift @lines;
shift @lines;
my @networks;
for (@lines) {
/\s*(.*?)\s+.*/;
push @networks,($1) if $1;
}
return @networks;
}
sub _get_nat_bridge($net) {
my ($in, $out, $err);
my @cmd = ( '/usr/bin/virsh','net-info', $net);
run3(\@cmd, \$in, \$out, \$err);
for my $line (split /\n/, $out) {
my ($bridge) = $line =~ /^Bridge:\s+(.*)/;
return $bridge if $bridge;
}
}
sub _list_qemu_bridges($self) {
my %bridge;
my @networks = $self->_list_nat_interfaces();
for my $net (@networks) {
my $nat_bridge = _get_nat_bridge($net);
$bridge{$nat_bridge}++;
}
return keys %bridge;
}
sub _list_bridges($self) {
my %qemu_bridge = map { $_ => 1 } $self->_list_qemu_bridges();
my @cmd = ( '/sbin/brctl','show');
my ($out,$err) = $self->run_command(@cmd);
die $err if $err;
my @lines = split /\n/,$out;
shift @lines;
my @networks;
for (@lines) {
my ($bridge, $interface) = /\s*(.*?)\s+.*\s(.*)/;
push @networks,($bridge) if $bridge && !$qemu_bridge{$bridge};
}
$self->{_bridges} = \@networks;
return @networks;
}
sub free_disk($self, $pool_name = undef ) {
my $pool;
if ($pool_name) {
......@@ -2257,4 +2326,5 @@ sub free_disk($self, $pool_name = undef ) {
my $info = $pool->get_info();
return $info->{available};
}
1;
......@@ -172,9 +172,24 @@
$scope.refresh_machine();
$scope.init_ldap_access();
$scope.list_ldap_attributes();
$scope.list_interfaces();
$scope.hardware_types = Object.keys(response.data.hardware);
});
};
$scope.list_interfaces = function() {
if (! $scope.network_nats) {
$http.get('/network/interfaces/'+$scope.showmachine.type+'/nat')
.then(function(response) {
$scope.network_nats = response.data;
});
}
if (! $scope.network_bridges ) {
$http.get('/network/interfaces/'+$scope.showmachine.type+'/bridge')
.then(function(response) {
$scope.network_bridges= response.data;
});
}
};
$scope.domain_remove = 0;
$scope.new_name_invalid = false;
$http.get('/pingbackend.json').then(function(response) {
......@@ -449,6 +464,28 @@
});
};
$scope.change_network = function(id_machine, index ) {
var new_settings ={
driver: $scope.showmachine.hardware.network[index].driver,
type: $scope.showmachine.hardware.network[index].type,
};
if ($scope.showmachine.hardware.network[index].type == 'NAT' ) {
new_settings.network=$scope.showmachine.hardware.network[index].network;
}
if ($scope.showmachine.hardware.network[index].type == 'bridge' ) {
new_settings.bridge=$scope.showmachine.hardware.network[index].bridge;
}
$http.post('/machine/hardware/change'
,JSON.stringify({
'id_domain': id_machine
,'hardware': 'network'
,'index': index
,'data': new_settings
})
).then(function(response) {
$scope.getReqs();
});
};
$scope.add_disk = {
device: 'disk',
driver: 'virtio',
......
......@@ -705,6 +705,21 @@ get '/machine/display-tls/(:id)-tls.vv' => sub {
return $c->render(data => $domain->display_file_tls($USER), format => 'vv');
};
# Network ##########################################################3
get '/network/interfaces/(:vm_type)/(:type)' => sub {
my $c = shift;
my $vm_type = $c->stash('vm_type');
my $type = $c->stash('type');
return $c->render( json => $RAVADA->list_network_interfaces(
user => $USER
,type => $type
,vm_type => $vm_type
)
);
};
# Users ##########################################################3
......
......@@ -4,6 +4,7 @@ use strict;
use Carp qw(carp confess cluck);
use Data::Dumper;
use POSIX qw(WNOHANG);
use Sys::Virt;
use Test::More;
use YAML qw(Dump);
......@@ -178,6 +179,7 @@ sub test_add_hardware_custom($domain, $hardware) {
disk => \&test_add_disk
,usb => sub {}
,mock => sub {}
,network => sub {}
);
my $exec = $sub{$hardware} or die "No custom add $hardware";
......@@ -194,6 +196,11 @@ sub test_remove_hardware {
$domain = Ravada::Domain->open($domain->id);
my @list_hardware1 = $domain->get_controller($hardware);
confess "Error: I can't remove $hardware $index, only ".scalar(@list_hardware1)
."\n"
.Dumper(\@list_hardware1)
if $index > scalar @list_hardware1;
my $req;
{
$req = Ravada::Request->remove_hardware(uid => $USER->id
......@@ -206,7 +213,7 @@ sub test_remove_hardware {
ok($req, 'Request');
rvd_back->_process_all_requests_dont_fork();
is($req->status(), 'done');
is($req->error(), '');
is($req->error(), '') or exit;
{
my $domain2 = Ravada::Domain->open($domain->id);
......@@ -229,7 +236,9 @@ sub test_remove_almost_all_hardware {
my $domain = shift;
my $hardware = shift;
my $total_hardware = $domain->get_controller($hardware);
#TODO test remove hardware out of bounds
my $total_hardware = scalar($domain->get_controller($hardware));
return if $total_hardware < 2;
for my $index ( reverse 1 .. $total_hardware-1) {
test_remove_hardware($vm, $domain, $hardware, $index);
$domain->list_volumes();
......@@ -370,9 +379,81 @@ sub test_change_disk($vm, $domain) {
test_change_disk_cdrom($vm, $domain);
}
sub test_change_network_bridge($vm, $domain, $index) {
SKIP: {
my @bridges = $vm->list_network_interfaces('bridge');
skip("No bridges found in this system",6) if !scalar @bridges;
my $info = $domain->info(user_admin);
is ($info->{hardware}->{network}->[$index]->{type}, 'NAT') or exit;
ok(scalar @bridges,"No network bridges defined in this host") or return;
diag("Testing network bridge ".$bridges[0]);
my $req = Ravada::Request->change_hardware(
id_domain => $domain->id
,hardware => 'network'
,index => $index
,data => { type => 'bridge', bridge => $bridges[0]}
,uid => user_admin->id
);
rvd_back->_process_requests_dont_fork();
is($req->status,'done');
is($req->error, '');
my $domain_f = Ravada::Front::Domain->open($domain->id);
$info = $domain_f->info(user_admin);
is ($info->{hardware}->{network}->[$index]->{type}, 'bridge', $domain->name) or exit;
is ($info->{hardware}->{network}->[$index]->{bridge}, $bridges[0] );
}
}
sub test_change_network_nat($vm, $domain, $index) {
my $info = $domain->info(user_admin);
my @nat = $vm->list_network_interfaces( 'nat');
ok(scalar @nat,"No NAT network defined in this host") or return;
diag("Testing network NAT ".$nat[0]);
my $req = Ravada::Request->change_hardware(
id_domain => $domain->id
,hardware => 'network'
,index => $index
,data => { type => 'NAT', network => $nat[0]}
,uid => user_admin->id
);
rvd_back->_process_requests_dont_fork();
is($req->status,'done');
is($req->error, '');
my $domain_f = Ravada::Front::Domain->open($domain->id);
$info = $domain_f->info(user_admin);
is ($info->{hardware}->{network}->[$index]->{type}, 'NAT');
is ($info->{hardware}->{network}->[$index]->{network}, $nat[0] );
}
sub test_change_network($vm, $domain) {
my $domain_f = Ravada::Front::Domain->open($domain->id);
my $info = $domain_f->info(user_admin);
my</