Commit 9ff8129a authored by Francesc Guasch's avatar Francesc Guasch
Browse files

Load valid VMs from config, even Void for testing

parent f681e844
...@@ -714,30 +714,40 @@ sub _init_config { ...@@ -714,30 +714,40 @@ sub _init_config {
$LIMIT_PROCESS = $CONFIG->{limit_process} $LIMIT_PROCESS = $CONFIG->{limit_process}
if $CONFIG->{limit_process} && $CONFIG->{limit_process}>1; if $CONFIG->{limit_process} && $CONFIG->{limit_process}>1;
# $CONNECTOR = ( $connector or _connect_dbh()); # $CONNECTOR = ( $connector or _connect_dbh());
_init_config_vm() if $CONFIG->{vm};
}
sub _init_config_vm {
%VALID_VM = ();
for my $vm ( @{$CONFIG->{vm}} ) {
eval { require "Ravada/VM/$vm.pm"; };
warn $@ if $@;
$VALID_VM{$vm}++ if !$@;
}
@Ravada::Front::VM_TYPES = keys %VALID_VM;
} }
sub _create_vm_kvm { sub _create_vm_kvm {
my $self = shift; my $self = shift;
return (undef, "KVM not installed") if !$VALID_VM{KVM}; die "KVM not installed" if !$VALID_VM{KVM};
my $cmd_qemu_img = `which qemu-img`; my $cmd_qemu_img = `which qemu-img`;
chomp $cmd_qemu_img; chomp $cmd_qemu_img;
return(undef,"ERROR: Missing qemu-img") if !$cmd_qemu_img; die "ERROR: Missing qemu-img" if !$cmd_qemu_img;
my $vm_kvm; my $vm_kvm;
eval { $vm_kvm = Ravada::VM::KVM->new( connector => ( $self->connector or $CONNECTOR )) }; $vm_kvm = Ravada::VM::KVM->new( connector => ( $self->connector or $CONNECTOR ));
my $err_kvm = $@;
my ($internal_vm , $storage); my ($internal_vm , $storage);
eval {
$storage = $vm_kvm->dir_img(); $storage = $vm_kvm->dir_img();
$internal_vm = $vm_kvm->vm; $internal_vm = $vm_kvm->vm;
}; $vm_kvm = undef if !$internal_vm || !$storage;
$vm_kvm = undef if $@ || !$internal_vm || !$storage;
$err_kvm .= ($@ or ''); return $vm_kvm;
return ($vm_kvm,$err_kvm);
} }
=head2 disconnect_vm =head2 disconnect_vm
...@@ -781,25 +791,39 @@ sub _connect_vm { ...@@ -781,25 +791,39 @@ sub _connect_vm {
} }
} }
sub _create_vm { sub _create_vm_lxc {
my $self = shift; my $self = shift;
my @vms = (); return Ravada::VM::LXC->new( connector => ( $self->connector or $CONNECTOR ));
}
my ($vm_kvm, $err_kvm) = $self->_create_vm_kvm(); sub _create_vm_void {
warn $err_kvm if $err_kvm && $0 !~ /\.t$/; my $self = shift;
my $err = $err_kvm; return Ravada::VM::Void->new( connector => ( $self->connector or $CONNECTOR ));
}
push @vms,($vm_kvm) if $vm_kvm; sub _create_vm {
my $self = shift;
my $vm_lxc; # TODO: add a _create_vm_default for VMs that just are created with ->new
if ($CAN_LXC) { # like Void or LXC
eval { $vm_lxc = Ravada::VM::LXC->new( connector => ( $self->connector or $CONNECTOR )) }; my %create = (
push @vms,($vm_lxc) if $vm_lxc; 'KVM' => \&_create_vm_kvm
my $err_lxc = $@; ,'LXC' => \&_create_vm_lxc
$err .= "\n$err_lxc" if $err_lxc; ,'Void' => \&_create_vm_void
);
my @vms = ();
my $err;
for my $vm_name (keys %VALID_VM) {
my $vm;
eval { $vm = $create{$vm_name}->($self) };
$err.= $@ if $@;
push @vms,($vm) if $vm;
} }
if (!@vms) { if (!@vms) {
warn "No VMs found: $err\n" if $self->warn_error; warn "No VMs found: $err\n" if $self->warn_error;
} }
......
...@@ -25,7 +25,7 @@ has 'vm' => ( ...@@ -25,7 +25,7 @@ has 'vm' => (
has 'type' => ( has 'type' => (
is => 'ro' is => 'ro'
,isa => 'Str' ,isa => 'Str'
,default => 'void' ,default => 'Void'
); );
########################################################################## ##########################################################################
......
...@@ -4,8 +4,15 @@ use strict; ...@@ -4,8 +4,15 @@ use strict;
use Test::More; use Test::More;
use Test::SQL::Data; use Test::SQL::Data;
my $test = Test::SQL::Data->new(); use lib 't/lib';
use Test::Ravada;
my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
use_ok('Ravada::VM'); use_ok('Ravada::VM');
init($test->connector, 't/etc/ravada_vm.conf');
ok(rvd_back);
done_testing(); done_testing();
use warnings;
use strict;
use Data::Dumper;
use Test::More;
use Test::SQL::Data;
use lib 't/lib';
use Test::Ravada;
my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
use_ok('Ravada::VM');
init($test->connector, 't/etc/ravada_vm_void.conf');
ok(rvd_back);
ok(rvd_back->search_vm('Void'));
my $vm = rvd_back->vm();
ok(scalar @$vm,"Expecting some VMs, got none");
ok(grep({$_->type eq 'Void' } @{$vm}),
"Expecting a VM type Void, got ".Dumper($vm));
my $vm_front = rvd_front->list_vm_types();
ok(scalar @$vm_front,"Expecting some VMs in front, got none");
ok(grep({$_ eq 'Void' } @{$vm_front}),
"Expecting a VM type Void in front, got ".Dumper($vm_front));
done_testing();
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