Unverified Commit 789c98f1 authored by Fernando Verdugo's avatar Fernando Verdugo Committed by GitHub
Browse files

Merge pull request #708 from UPC/700_remove_domain

feat(grants): remove domain
parents 9e1e111c fe609c7e
......@@ -2350,6 +2350,7 @@ sub search_vm {
die $@ if $@;
for my $vm (@vms) {
$vm->connect if !$vm->vm;
return $vm if ref($vm) eq $class;
}
return;
......
......@@ -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,12 +769,57 @@ 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);
confess "ERROR: domain is not a base " if !$domain->id_base;
return 1 if $self->can_remove_clone_all();
return 0 if !$self->can_remove_clone();
my $base = Ravada::Front::Domain->open($domain->id_base);
return 1 if $base->id_owner == $self->id;
return 0;
}
sub can_remove_machine($self, $domain) {
return 1 if $self->can_remove_all();
return 0 if !$self->can_remove();
$domain = Ravada::Front::Domain->open($domain) if !ref $domain;
if ( $domain->id_owner == $self->id ) {
return 1 if $self->can_do("remove");
}
return $self->can_remove_clones($domain->id) if $domain->id_base;
return 0;
}
sub grants($self) {
$self->_load_grants() if !$self->{_grant};
return () if !$self->{_grant};
return %{$self->{_grant}};
}
sub AUTOLOAD($self) {
my $name = $AUTOLOAD;
......
......@@ -264,7 +264,7 @@ sub _allow_remove($self, $user) {
confess "ERROR: Undefined user" if !defined $user;
die "ERROR: remove not allowed for user ".$user->name
unless $user->can_remove() || $user->is_admin;
unless $user->can_remove_machine($self);
$self->_check_has_clones() if $self->is_known();
if ( $self->is_known
......@@ -274,7 +274,6 @@ sub _allow_remove($self, $user) {
my $base = $self->open($self->id_base);
return if ($user->can_remove_clone_all() || ($base->id_owner == $user->id));
}
$self->_allowed($user);
}
......@@ -469,7 +468,7 @@ sub _allowed {
my $err = $@;
confess "User ".$user->name." [".$user->id."] not allowed to access ".$self->domain
." owned by ".($id_owner or '<UNDEF>')."\n".Dumper($self)
." owned by ".($id_owner or '<UNDEF>')
if (defined $id_owner && $id_owner != $user->id );
confess $err if $err;
......
......@@ -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);
......
......@@ -42,6 +42,8 @@ our $CONT_POOL= 0;
our $USER_ADMIN;
our $CHAIN = 'RAVADA';
our $RVD_BACK;
our %ARG_CREATE_DOM = (
KVM => []
,Void => []
......@@ -122,6 +124,8 @@ sub new_pool_name {
sub rvd_back {
my ($connector, $config) = @_;
return $RVD_BACK if $RVD_BACK && !$connector && !$config;
init($connector,$config,0) if $connector;
my $rvd = Ravada->new(
......@@ -133,6 +137,7 @@ sub rvd_back {
$ARG_CREATE_DOM{KVM} = [ id_iso => search_id_iso('Alpine') ];
$RVD_BACK = $rvd;
return $rvd;
}
......@@ -157,6 +162,7 @@ sub init {
$Ravada::Domain::MIN_FREE_MEMORY = 512*1024;
rvd_back() if !$RVD_BACK;
}
sub _remove_old_domains_vm {
......
......@@ -20,7 +20,6 @@ use_ok('Ravada');
my @VMS = vm_names();
init($test->connector);
rvd_back();
#########################################################3
sub test_defaults {
......
#!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($@ , '');