Commit fcc81ee1 authored by Francesc Guasch's avatar Francesc Guasch
Browse files

[#33] Reading display ip from VM or main config

If the current VM has a host we get the IP from there.
Added display_ip configuration support.
parent 0ee78728
......@@ -93,28 +93,16 @@ sub _connect_dbh {
}
sub display_ip {
my $ip = $CONFIG->{display_ip};
return $ip if $ip;
=head2 display_ip
my $name = hostname() or die "CRITICAL: I can't find the hostname.\n";
$ip = inet_ntoa(inet_aton($name))
or die "CRITICAL: I can't find IP of $name in the DNS.\n";
Returns the default display IP read from the config file
if (!$ip || $ip =~ /^127./) {
#TODO Net:DNS
$ip= `host $name`;
chomp $ip;
$ip =~ s/.*?address (\d+)/$1/;
}
if ( !$ip || $ip =~ /^127./ || $ip !~ /^\d+\..*\.\d+$/) {
warn "WARNING: I can't find IP with hostname $name ( $ip )"
.", using localhost\n";
$ip='127.0.0.1';
}
return $ip;
=cut
sub display_ip {
my $ip = $CONFIG->{display_ip};
return $ip if $ip;
}
sub _init_config {
......@@ -829,6 +817,25 @@ sub _cmd_prepare_base {
}
sub _cmd_remove_base {
my $self = shift;
my $request = shift;
$request->status('working');
my $id_domain = $request->id_domain or confess "Missing request id_domain";
my $uid = $request->args('uid') or confess "Missing argument uid";
my $user = Ravada::Auth::SQL->search_by_id( $uid);
my $domain = $self->search_domain_by_id($id_domain);
die "Unknown domain id '$id_domain'\n" if !$domain;
$domain->remove_base($user);
}
sub _cmd_shutdown {
my $self = shift;
......@@ -880,6 +887,7 @@ sub _req_method {
,shutdown => \&_cmd_shutdown
,domdisplay => \&_cmd_domdisplay
,screenshot => \&_cmd_screenshot
,remove_base => \&_cmd_remove_base
,ping_backend => \&_cmd_ping_backend
,prepare_base => \&_cmd_prepare_base
,list_vm_types => \&_cmd_list_vm_types
......
......@@ -56,6 +56,13 @@ has 'storage' => (
,isa => 'Object'
,required => 0
);
has '_vm' => (
is => 'ro',
,isa => 'Object'
,required => 1
);
##################################################################################3
#
......@@ -88,6 +95,7 @@ before 'pause' => \&_allow_manage;
before 'resume' => \&_allow_manage;
before 'shutdown' => \&_allow_manage_args;
before 'remove_base' => \&_can_remove_base;
after 'remove_base' => \&_remove_base_db;
sub _preconditions{
......@@ -548,6 +556,11 @@ sub remove_base {
$self->storage_refresh() if $self->storage();
}
sub _can_remove_base {
_allow_manage(@_);
_check_has_clones(@_);
}
sub _remove_base_db {
my $self = shift;
......
......@@ -26,8 +26,8 @@ has 'storage' => (
has '_vm' => (
is => 'ro'
,isa => 'Sys::Virt'
,required => 0
,isa => 'Ravada::VM::KVM'
,required => 1
);
##################################################
......@@ -553,7 +553,7 @@ sub screenshot {
my $self = shift;
my $file = (shift or $self->_file_screenshot);
my $stream = $self->{_vm}->new_stream();
my $stream = $self->{_vm}->vm->new_stream();
my $mimetype = $self->domain->screenshot($stream,0);
......
......@@ -41,7 +41,7 @@ sub name {
sub display {
my $self = shift;
my $ip = (Ravada::display_ip() or '127.0.0.1');
my $ip = $self->_vm->ip();
return "void://$ip:0000/";
}
......
......@@ -33,6 +33,7 @@ our %VALID_ARG = (
,id_owner => 1
,id_template => 1
}
,remove_base => $args_prepare
,prepare_base => $args_prepare
,pause_domain => $args_manage
,resume_domain => $args_manage
......@@ -289,6 +290,37 @@ sub prepare_base {
}
=head2 remove_base
Returns a new request for making a base regular domain. It marks it
as 'non base' and removes the files.
It must have not clones. All clones must be removed before calling
this method.
my $req = Ravada::Request->remove_base( $name );
=cut
sub remove_base {
my $proto = shift;
my $class=ref($proto) || $proto;
my %args = @_;
confess "Missing uid" if !$args{uid};
my $args = _check_args('remove_base', @_);
my $self = {};
bless($self,$class);
return $self->_new_request(command => 'remove_base'
, id_domain => $args{id_domain}
, args => encode_json( $args ));
}
=head2 ping_backend
Returns wether the backend is alive or not
......
......@@ -5,13 +5,16 @@ package Ravada::VM;
use Carp qw(croak);
use Data::Dumper;
use Socket qw( inet_aton inet_ntoa );
use Moose::Role;
use Sys::Hostname;
requires 'connect';
# global DB Connection
our $CONNECTOR = \$Ravada::CONNECTOR;
our $CONFIG = \$Ravada::CONFIG;
# domain
requires 'create_domain';
......@@ -119,5 +122,41 @@ sub search_domain_by_id {
return $self->search_domain($name);
}
=head2 ip
Returns the external IP this for this VM
=cut
sub ip {
my $self = shift;
my $name = $self->host();
my $ip = inet_ntoa(inet_aton($name)) ;
return $ip if $ip && $ip !~ /^127\./;
$name = Ravada::display_ip();
if ($name) {
if ($name =~ /^\d+\.\d+\.\d+\.\d+$/) {
$ip = $name;
} else {
$ip = inet_ntoa(inet_aton($name));
}
}
return $ip if $ip && $ip !~ /^127\./;
$name = hostname();
$ip = `host $name`;
chomp $ip;
$ip =~ s/.*?address (\d+)/$1/;
return $ip if $ip && $ip !~ /^127\./;
warn "WARNING: I can't find the IP of host $name, using localhost."
." This virtual machine won't be available from the network.";
return '127.0.0.1';
}
1;
......@@ -10,8 +10,6 @@ use Hash::Util qw(lock_hash);
use IPC::Run3 qw(run3);
use LWP::UserAgent;
use Moose;
use Socket qw( inet_aton inet_ntoa );
use Sys::Hostname;
use Sys::Virt;
use URI;
use XML::LibXML;
......@@ -50,7 +48,6 @@ our $DIR_XML = "etc/xml";
our $DEFAULT_DIR_IMG;
our $XML = XML::LibXML->new();
our $IP = _init_ip();
#-----------
#
......@@ -181,7 +178,7 @@ sub search_domain {
domain => $dom
,storage => $self->storage_pool
,readonly => $self->readonly
,_vm => $self->vm
,_vm => $self
);
};
warn $@ if $@;
......@@ -209,6 +206,7 @@ sub list_domains {
eval { $domain = Ravada::Domain::KVM->new(
domain => $name
,storage => $self->storage_pool
,_vm => $self
);
$id = $domain->id();
};
......@@ -310,7 +308,7 @@ sub _domain_create_from_iso {
my $domain = Ravada::Domain::KVM->new(domain => $dom , storage => $self->storage_pool
, _vm => $self->vm
, _vm => $self
);
$domain->_insert_db(name => $args{name}, id_owner => $args{id_owner});
......@@ -397,14 +395,15 @@ sub _domain_create_from_base {
_xml_modify_disk($xml, \@device_disk);
$self->_xml_modify_mac($xml);
$self->_xml_modify_uuid($xml);
_xml_modify_spice_port($xml);
$self->_xml_modify_spice_port($xml);
_xml_modify_video($xml);
my $dom = $self->vm->define_domain($xml->toString());
$dom->create;
my $domain = Ravada::Domain::KVM->new(domain => $dom , storage => $self->storage_pool);
my $domain = Ravada::Domain::KVM->new(domain => $dom , storage => $self->storage_pool
, _vm => $self);
$domain->_insert_db(name => $args{name}, id_base => $base->id, id_owner => $args{id_owner});
return $domain;
......@@ -530,7 +529,7 @@ sub _define_xml {
$self->_xml_modify_mac($doc);
$self->_xml_modify_uuid($doc);
_xml_modify_spice_port($doc);
$self->_xml_modify_spice_port($doc);
_xml_modify_video($doc);
return $doc;
......@@ -560,13 +559,14 @@ sub _xml_modify_video {
}
sub _xml_modify_spice_port {
my $doc = shift;
my $self = shift;
my $doc = shift or confess "Missing XML doc";
my ($graph) = $doc->findnodes('/domain/devices/graphics')
or die "ERROR: I can't find graphic";
$graph->setAttribute(type => 'spice');
$graph->setAttribute(autoport => 'yes');
$graph->setAttribute(listen=> $IP );
$graph->setAttribute(listen=> $self->ip() );
my ($listen) = $doc->findnodes('/domain/devices/graphics/listen');
......@@ -575,7 +575,7 @@ sub _xml_modify_spice_port {
}
$listen->setAttribute(type => 'address');
$listen->setAttribute(address => $IP);
$listen->setAttribute(address => $self->ip());
}
......@@ -706,29 +706,4 @@ sub _xml_modify_mac {
$if_mac->setAttribute(address => $new_mac);
}
#############################################################################
#
# inits
#
sub _init_ip {
my $name = hostname() or die "CRITICAL: I can't find the hostname.\n";
my $ip = inet_ntoa(inet_aton($name))
or die "CRITICAL: I can't find IP of $name in the DNS.\n";
if (!$ip || $ip =~ /^127./) {
#TODO Net:DNS
$ip= `host $name`;
chomp $ip;
$ip =~ s/.*?address (\d+)/$1/;
}
if ( !$ip || $ip =~ /^127./ || $ip !~ /^\d+\..*\.\d+$/) {
warn "WARNING: I can't find IP with hostname $name ( $ip )"
.", using localhost\n";
$ip='127.0.0.1';
}
return $ip;
}
1;
......@@ -33,6 +33,7 @@ sub create_domain {
my $domain = Ravada::Domain::Void->new(name => $args{name}, domain => $args{name}
, id_owner => $args{id_owner}
, id_base => $args{id_base}
, _vm => $self
);
$domain->_insert_db(name => $args{name} , id_owner => $args{id_owner}
, id_base => $args{id_base} );
......@@ -81,6 +82,7 @@ sub search_domain {
my $domain = Ravada::Domain::Void->new(
domain => $name
,readonly => $self->readonly
,_vm => $self
);
my $id;
......
......@@ -187,6 +187,8 @@ sub test_unread_messages {
eval { $ravada = Ravada->new(connector => $test->connector) };
ok($ravada,"I can't launch a new Ravada");# or exit;
remove_old_domains();
remove_old_disks();
for my $vm_name ( qw(Void KVM)) {
my $vm;
......
......@@ -206,6 +206,64 @@ sub test_volumes {
}
sub check_files_exist {
my $vm_name = shift;
for my $file (@_) {
ok(-e $file
,"[$vm_name] File '$file' , expected exists , got ".(-e $file));
}
}
sub check_files_removed {
my $vm_name = shift;
for my $file (@_) {
ok(!-e $file
,"[$vm_name] File '$file' , expected removed, got ".(-e $file));
}
}
sub test_req_remove_base {
my ($vm_name, $domain_base, $domain_clone) = @_;
ok($domain_base->is_base,"[$vm_name] expecting domain ".$domain_base->id
." is base , got ".$domain_base->is_base) or return;
my @files_base = $domain_base->list_files_base();
ok(scalar @files_base,"Expecting files base, got none") or return;
my $req = Ravada::Request->remove_base(id_domain => $domain_base->id
, uid => $USER->id
);
ok($req->status eq 'requested');
$ravada->process_requests();
wait_request($req);
ok($req->status eq 'done', "Expected req->status 'done', got "
."'".$req->status."'");
ok($req->error =~ /has \d+ clones/i, "[$vm_name] Expected error 'has X clones'"
.", got : '".$req->error."'");
check_files_exist(@files_base);
$domain_clone->remove($USER);
check_files_exist(@files_base);
$req->status('requested');
$ravada->process_requests();
wait_request($req);
ok($req->status eq 'done', "[$vm_name] Expected req->status 'done', got "
."'".$req->status."'");
ok(!$req->error, "Expected error ''"
.", got : '".$req->error."'");
ok(!$domain_base->is_base());
check_files_removed(@files_base);
}
################################################
eval { $ravada = Ravada->new(connector => $test->connector) };
......@@ -226,11 +284,13 @@ for my $vm_name ( qw(Void KVM)) {
remove_old_domains();
remove_old_disks();
my $domain_base = test_req_create_domain($vm);
test_req_prepare_base($vm, $domain_base->name) if $domain_base;
my $domain_clone = test_req_create_from_base($vm, $domain_base) if $domain_base;
test_volumes($vm_name,$domain_base, $domain_clone) if $domain_base;
my $domain_base = test_req_create_domain($vm) or next;
test_req_prepare_base($vm, $domain_base->name);
my $domain_clone = test_req_create_from_base($vm, $domain_base)
or next;
test_volumes($vm_name,$domain_base, $domain_clone);
test_req_remove_base($vm_name, $domain_base, $domain_clone);
};
}
......
......@@ -81,9 +81,19 @@ sub test_display {
my ($ip) = $display =~ m{^\w+://(.*):\d+};
ok($ip,"Expecting an IP from $display, got none") or return;
ok($ip ne '127.0.0.1', "Expecting IP no '127.0.0.1', got '$ip'");
ok($ip ne '127.0.0.1', "[$vm_name] Expecting IP no '127.0.0.1', got '$ip'") or exit;
my $expected_ip = $RAVADA::CONFIG->{display_ip} or die "Missing display_ip in ravada.conf";
# only test this for Void, it will fail on real VMs
return if $vm_name ne 'Void';
$Ravada::CONFIG->{display_ip} = $DISPLAY_IP;
$display = $domain->display($USER);
($ip) = $display =~ m{^\w+://(.*):\d+};
my $expected_ip = Ravada::display_ip();
ok($expected_ip,"[$vm_name] Expecting display_ip '$DISPLAY_IP' , got none in config "
.Dumper($Ravada::CONFIG)) or exit;
ok($ip eq $expected_ip,"Expecting display IP '$expected_ip', got '$ip'");
......@@ -119,8 +129,6 @@ sub test_prepare_base {
my $name_clone = new_domain_name();
$RAVADA::CONFIG->{display_ip} = $DISPLAY_IP;
my $domain_clone = $RVD_BACK->create_domain(
name => $name_clone
,id_owner => $USER->id
......@@ -246,13 +254,54 @@ sub test_remove_base {
}
}
sub test_dont_remove_base_cloned {
my $vm_name = shift;
my $domain = test_create_domain($vm_name);
$domain->prepare_base($USER);
ok($domain->is_base,"[$vm_name] expecting domain is base, got "
.$domain->is_base);
my @files = $domain->list_files_base();
my $name_clone = new_domain_name();
my $clone = rvd_back()->create_domain( name => $name_clone
,id_owner => $USER->id
,id_base => $domain->id
,vm => $vm_name
);
eval {$domain->remove_base($USER)};
ok($@,"Expecting error removing base with clones, got '$@'");
ok($domain->is_base,"[$vm_name] expecting domain is base, got "
.$domain->is_base);
for my $file (@files) {
ok(-e $file,"[$vm_name] Expecting file base '$file' not removed" );
}
##################################################################3
# now we remove the clone, it should work
$clone->remove($USER);
eval {$domain->remove_base($USER)};
ok(!$@,"Expecting not error removing base with clones, got '$@'");
ok(!$domain->is_base,"[$vm_name] expecting domain is base, got "
.$domain->is_base);
for my $file (@files) {
ok(!-e $file,"[$vm_name] Expecting file base '$file' removed" );
}
}
#######################################################################33
remove_old_domains();
remove_old_disks();
for my $vm_name (@VMS) {
for my $vm_name (reverse sort @VMS) {
diag("Testing $vm_name VM");
my $CLASS= "Ravada::VM::$vm_name";
......@@ -275,6 +324,7 @@ for my $vm_name (@VMS) {
test_prepare_base($vm_name, $domain);
test_prepare_base_active($vm_name);
test_remove_base($vm_name);
test_dont_remove_base_cloned($vm_name);
}
}
......
......@@ -69,7 +69,7 @@ sub test_remove_domain {
ok(!$domain_missing,"Domain ".$domain->name." should be missing");
}
sub test_remove_base {
sub test_remove_domain_base {
my $vm_name = shift;
my $domain = test_create_domain($vm_name);
......@@ -82,6 +82,7 @@ sub test_remove_base {
}
sub test_dont_remove_father {
my $vm_name = shift;
......@@ -188,7 +189,7 @@ for my $vm_name (@VMS) {
skip $msg,10 if !$vm;
test_remove_domain($vm_name);
test_remove_base($vm_name);
test_remove_domain_base($vm_name);
test_dont_remove_father($vm_name);
}
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment