Commit 6e26da26 authored by Francesc Guasch's avatar Francesc Guasch
Browse files

feat(machines): remove and list permissions

List machines available to remove by the user.
Check if an user is allowed to remove or
manage a machine.

closes #700
parent d40c11fc
......@@ -347,7 +347,7 @@ sub is_operator {
|| $self->can_shutdown_clone()
# || $self->can_hibernate_clone()
|| $self->can_change_settings_clones()
# || $self->can_remove_clone()
|| $self->can_remove_clone()
|| $self->can_remove_clone_all()
|| $self->can_create_base()
|| $self->can_create_machine();
......@@ -383,6 +383,11 @@ sub can_list_clones {
}
sub can_list_clones_from_own_base($self) {
return 1 if $self->can_remove_clone || $self->can_remove_clone_all;
return 0;
}
=head2 can_list_machines
......@@ -392,7 +397,7 @@ Returns true if the user can list all the virtual machines at the web frontend
sub can_list_machines {
my $self = shift;
return 1 if $self->is_admin() || $self->can_remove_clone_all;
return 1 if $self->is_admin() || $self->can_remove_all;
return 0;
}
......@@ -764,6 +769,22 @@ sub can_change_settings($self, $id_domain=undef) {
return 0;
}
sub can_manage_machine($self, $domain) {
$domain = Ravada::Front::Domain->open($domain) if !ref $domain;
return 1 if $self->can_change_settings
&& $domain->id_owner == $self->id;
return 1 if $self->can_remove_clone_all
&& $domain->id_base;
if ( $self->can_remove_clone && $domain->id_base ) {
my $base = Ravada::Front::Domain->open($domain->id_base);
return 1 if $base->id_owner == $self->id;
}
return 0;
}
sub can_remove_clones($self, $id_domain) {
my $domain = Ravada::Front::Domain->open($id_domain);
......@@ -798,6 +819,7 @@ sub grants($self) {
return %{$self->{_grant}};
}
sub AUTOLOAD($self) {
my $name = $AUTOLOAD;
......
......@@ -76,11 +76,15 @@ Returns a list of the base domains as a listref
=cut
sub list_bases {
my $self = shift;
my $sth = $CONNECTOR->dbh->prepare("SELECT name, id, is_base FROM domains where is_base=1");
$sth->execute();
sub list_bases($self, %args) {
$args{is_base} = 1;
my $query = "SELECT name, id, is_base FROM domains "
._where(%args)
." ORDER BY name";
my $sth = $CONNECTOR->dbh->prepare($query);
$sth->execute(map { $args{$_} } sort keys %args);
my @bases = ();
while ( my $row = $sth->fetchrow_hashref) {
my $domain;
......@@ -160,6 +164,28 @@ sub list_machines_user {
return \@list;
}
sub list_machines($self, $user) {
return $self->list_domains() if $user->can_list_machines;
if ($user->can_remove_clone()) {
my $machines = $self->list_bases( id_owner => $user->id );
for my $base (@$machines) {
push @$machines,@{$self->list_domains( id_base => $base->{id} )};
}
return $machines;
}
if ($user->can_remove_clone_all()) {
my $machines = $self->list_bases( );
for my $base (@$machines) {
push @$machines,@{$self->list_domains( id_base => $base->{id} )};
}
return $machines;
}
return $self->list_clones() if $user->can_list_clones;
return [];
}
=pod
sub search_clone_data {
......@@ -190,16 +216,12 @@ sub list_domains {
my %args = @_;
my $query = "SELECT name, id, id_base, is_base, is_public, is_volatile, client_status"
." FROM domains ";
." FROM domains "
._where(%args)
." ORDER BY name";
my $where = '';
for my $field ( sort keys %args ) {
$where .= " AND " if $where;
$where .= " $field=?"
}
$where = "WHERE $where" if $where;
my $sth = $CONNECTOR->dbh->prepare("$query $where ORDER BY name");
my $sth = $CONNECTOR->dbh->prepare($query);
$sth->execute(map { $args{$_} } sort keys %args);
my @domains = ();
......@@ -234,6 +256,15 @@ sub list_domains {
return \@domains;
}
sub _where(%args) {
my $where = '';
for my $field ( sort keys %args ) {
$where .= " AND " if $where;
$where .= " $field=?"
}
$where = "WHERE $where" if $where;
return $where;
}
=head2 list_clones
Returns a list of the domains that are clones as a listref
......
......@@ -285,22 +285,17 @@ get '/list_machines.json' => sub {
my $c = shift;
return access_denied($c) unless _logged_in($c)
&& ( $USER->can_list_own_machines()
|| $USER->is_admin()
&& (
$USER->can_list_machines
|| $USER->can_list_own_machines()
|| $USER->can_list_clones()
|| $USER->can_list_clones_from_own_base()
);
my @args;
if ( !$USER->can_list_machines ) {
my $domains = $RAVADA->list_domains( id_owner => $USER->id );
for my $domain ( @$domains ) {
next if !$domain->{id_base};
my $base = $RAVADA->list_domains( id => $domain->{id_base} );
push @$domains, (@$base);
}
return $c->render( json => $domains );
}
return $c->render( json => $RAVADA->list_domains ) if $USER->can_list_machines;
return $c->render( json => $RAVADA->list_machines($USER) );
return $c->render( json => $RAVADA->list_domains );
};
get '/list_bases_anonymous.json' => sub {
......@@ -389,7 +384,7 @@ get '/machine/shutdown/(:id).(:type)' => sub {
any '/machine/remove/(:id).(:type)' => sub {
my $c = shift;
return access_denied($c) if (!$USER -> can_remove());
return access_denied($c) if !$USER->can_remove_machine($c->stash('id'));
return remove_machine($c);
};
......@@ -1422,7 +1417,7 @@ sub settings_machine {
my $c = shift;
my ($domain) = _search_requested_machine($c);
return access_denied($c) if !$domain;
return access_denied($c) if !$USER->can_change_settings($domain->id);
return access_denied($c) if !$USER->can_manage_machine($domain->id);
$c->stash(domain => $domain);
$c->stash(USER => $USER);
......
#!perl
use strict;
use warnings;
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');
init($test->connector);
##############################################################################
sub test_remove_admin {
my $vm = shift;
my $domain = create_domain($vm->type);
is(user_admin->can_remove_machine($domain->id), 1);
$domain->remove( user_admin );
my $domain2 = $vm->search_domain( $domain->name );
ok(!$domain2,"[".$domain->type."] expecting domain already removed");
}
sub test_remove_own_clone {
my $vm = shift;
my $base = create_domain($vm->type);
$base->prepare_base( user_admin );
$base->is_public(1);
my $user = create_user("kevin.garvey","sleepwalk");
my $clone = $base->clone(
name => new_domain_name
, user => $user
);
# can remove by default
is($user->can_remove_machine($clone), 1);
$clone->remove( $user );
my $clone2 = $vm->search_domain( $clone->name );
ok(!$clone2,"[".$base->type."] expecting clone already removed");
$clone = $base->clone(
name => new_domain_name
, user => $user
);
# revoked grant can't remove
user_admin->revoke($user, 'remove');
is($user->can_remove_machine($clone), 0);
eval { $clone->remove( $user ); };
like($@,qr'.');
$clone2 = $vm->search_domain( $clone->name );
ok($clone2,"[".$base->type."] expecting clone not removed");
# grant remove again
user_admin->grant($user, 'remove');
is($user->can_remove_machine($clone), 1);
eval { $clone->remove( $user ); };
is($@,'');
$clone2 = $vm->search_domain( $clone->name );
ok(!$clone2,"[".$base->type."] expecting clone removed");
# done
$base->remove( user_admin );
my $base2 = $vm->search_domain( $base->name );
ok(!$base2,"[".$base->type."] expecting domain already removed");
$user->remove();
}
sub test_remove_all {
my $vm = shift;
my $base = create_domain($vm->type);
my $user = create_user("kevin.garvey","sleepwalk");
is($user->can_remove_machine($base), 0);
eval { $base->remove( $user ) };
like($@, qr'.');
my $base2 = $vm->search_domain( $base->name );
ok($base2,"[".$base->type."] expecting base not removed");
user_admin->grant($user, 'remove_all');
is($user->can_remove_machine($base), 1);
eval { $base->remove( $user ) };
is($@, '');
$base2 = $vm->search_domain( $base->name );
ok(!$base2,"[".$base->type."] expecting base removed");
$base->remove( user_admin ) if $base2;
$user->remove();
}
sub test_remove_others_clone {
my $vm = shift;
my $base = create_domain($vm->type);
$base->prepare_base( user_admin );
$base->is_public(1);
my $user = create_user("kevin.garvey","sleepwalk");
my $clone = $base->clone(
name => new_domain_name
, user => user_admin
);
is($user->can_remove_machine($clone), 0);
eval { $clone->remove( $user ) };
my $clone2 = $vm->search_domain( $clone->name );
ok($clone2,"[".$base->type."] expecting clone already there");
user_admin->grant($user, 'remove_clone_all');
is($user->can_remove_clone_all,1);
eval { $clone->remove($user)};
is($@, '');
$clone2 = $vm->search_domain( $clone->name );
ok(!$clone2,"[".$base->type."] expecting clone removed");
$clone->remove( user_admin ) if $clone2;
$base->remove( user_admin );
$user->remove();
}
sub test_remove_clones_from_own_base {
my $vm = shift;
}
sub test_list_all{
my $vm = shift;
my $base = create_domain($vm->type);
$base->prepare_base( user_admin );
$base->is_public(1);
my $user = create_user("kevin.garvey","sleepwalk");
my $clone = $base->clone(
name => new_domain_name
, user => user_admin
);
my $list = rvd_front->list_machines($user);
is(scalar @$list , 0);
user_admin->grant($user, 'remove_all');
is($user->can_list_machines, 1);
$list = rvd_front->list_machines($user);
is(scalar @$list , 2);
$user->remove();
$clone->remove(user_admin);
$base->remove(user_admin);
}
sub test_list_clones_from_own_base {
my $vm = shift;
my $user = create_user("kevin.garvey","sleepwalk");
user_admin->grant($user,'create_machine');
my $base = create_domain($vm->type, $user);
$base->prepare_base( user_admin );
$base->is_public(1);
my $clone = $base->clone(
name => new_domain_name
, user =>user_admin
);
my $list = rvd_front->list_machines($user);
is(scalar @$list , 0);
user_admin->grant($user, 'remove_clone');
is($user->can_list_machines, 0);
$list = rvd_front->list_machines($user);
is(scalar @$list , 2) and do {
is($list->[0]->{name}, $base->name);
is($list->[1]->{name}, $clone->name, Dumper($list->[1]));
};
$user->remove();
$clone->remove(user_admin);
$base->remove(user_admin);
}
sub test_list_clones_from_own_base_2 {
my $vm = shift;
my $user = create_user("kevin.garvey","sleepwalk");
user_admin->grant($user,'create_machine');
my $base = create_domain($vm->type, $user);
$base->prepare_base( user_admin );
$base->is_public(1);
my $clone = $base->clone(
name => new_domain_name
, user =>user_admin
);
my $clone2 = $base->clone(
name => new_domain_name
, user =>user_admin
);
my $list = rvd_front->list_machines($user);
is(scalar @$list , 0);
user_admin->grant($user, 'remove_clone');
is($user->can_list_machines, 0);
$list = rvd_front->list_machines($user);
is(scalar @$list , 3) and do {
is($list->[0]->{name}, $base->name);
is($list->[1]->{name}, $clone->name, Dumper($list->[1]));
is($list->[2]->{name}, $clone2->name, Dumper($list->[2]));
};
#####################################################################3
#
# another base
my $base2 = create_domain($vm->type, $user);
$base2->prepare_base(user_admin);
$base2->is_public(1);
my $clone3 = $base2->clone(
name => new_domain_name
, user =>user_admin
);
$list = rvd_front->list_machines($user);
is(scalar @$list , 5) and do {
is($list->[0]->{name}, $base->name);
is($list->[1]->{name}, $base2->name);
is($list->[2]->{name}, $clone->name, Dumper($list->[2]));
is($list->[3]->{name}, $clone2->name, Dumper($list->[3]));
is($list->[4]->{name}, $clone3->name, Dumper($list->[4]));
};
for my $m (@$list) {
is($user->can_manage_machine($m->{id}), 1);
next if !$m->{id_base};
my $machine = $vm->search_domain($m->{name});
eval { $machine->remove($user) };
is($@,'');
my $machine_d = $vm->search_domain($machine->name);
ok(!$machine_d);
$machine->remove(user_admin) if $machine_d;
}
$user->remove();
$base->remove(user_admin);
$base2->remove(user_admin);
}
sub test_list_others_clone {
my $vm = shift;
my $base = create_domain($vm->type );
$base->prepare_base( user_admin );
$base->is_public(1);
my $user = create_user("kevin.garvey","sleepwalk");
my $clone = $base->clone(
name => new_domain_name
, user =>user_admin
);
my $list = rvd_front->list_machines($user);
is(scalar @$list , 0);
user_admin->grant($user, 'remove_clone_all');
is($user->can_list_machines, 0);
$list = rvd_front->list_machines($user);
is(scalar @$list , 2 ) and do {
is($list->[0]->{name}, $base->name);
is($list->[1]->{name}, $clone->name, Dumper($list->[1]));
};
is($user->can_manage_machine($base->id), 0);
is($user->can_manage_machine($clone->id), 1);
eval { $clone->remove($user) };
is($@ , '');
my $clone_d = $vm->search_domain($clone->name);
ok(!$clone_d);
$user->remove();
$clone->remove(user_admin) if $clone_d;
$base->remove(user_admin);
}
sub test_list_clones_from_own_base_deny {
# User can't list becase base is not his
my $vm = shift;
my $user = create_user("kevin.garvey","sleepwalk");
my $base = create_domain($vm->type);
$base->prepare_base( user_admin );
$base->is_public(1);
my $clone = $base->clone(
name => new_domain_name
, user =>user_admin
);
my $list = rvd_front->list_machines($user);
is(scalar @$list , 0);
user_admin->grant($user, 'remove_clone');
is($user->can_list_machines, 0);
is($user->can_list_clones_from_own_base, 1);
$list = rvd_front->list_machines($user);
is(scalar @$list , 0);
is($user->can_manage_machine($base->id), 0);
is($user->can_manage_machine($clone->id), 0);
eval { $clone->remove($user)};
like($@,qr'.');
my $clone_d = $vm->search_domain($clone->name);
ok($clone_d);
$user->remove();
$clone->remove(user_admin) if $clone_d;
$base->remove(user_admin);
}
##############################################################################
clean();
use_ok('Ravada');
for my $vm_name ( vm_names() ) {
my $vm;
eval { $vm = rvd_back->search_vm($vm_name) };
SKIP: {
my $msg = "SKIPPED test: No $vm_name VM found ";
if ($vm && $vm_name =~ /kvm/i && $>) {
$msg = "SKIPPED: Test must run as root";
$vm = undef;
}
diag($msg) if !$vm;
skip $msg if !$vm;
diag("Testing remove on $vm_name");
test_remove_admin($vm);
test_remove_all($vm);
test_remove_own_clone($vm);
test_remove_clones_from_own_base($vm);
test_remove_others_clone($vm);
test_list_all($vm);
test_list_clones_from_own_base($vm);
test_list_clones_from_own_base_2($vm);
test_list_clones_from_own_base_deny($vm);
test_list_others_clone($vm);
}
}
clean();
done_testing();
% if ($USER->can_change_settings($domain->id)) {
<div class="tab-pane fade in active" id="description">
%= include 'main/vm_description'
</div>
......@@ -10,12 +11,11 @@
% }
</div>
% if ($USER->can_change_settings($domain->id) ) {
<div class="tab-pane fade" id="options">
%= include 'main/vm_options'
</div>
% }
% if ($USER->can_change_settings && $domain->drivers) {
% if ($USER->can_change_settings($domain->id) && $domain->drivers) {
<div class="tab-pane fade" id="drivers">
% if ($domain->is_base) {