enforcing user permissions to view domain

lib/Ravada.pm

@@ -484,8 +484,8 @@ sub _cmd_domdisplay {
     my $name = $request->args('name');
     confess "Unknown name for request ".Dumper($request)  if!$name;
     my $domain = $self->search_domain($request->args->{name});
-
-    my $display = $domain->display;
+    my $user = Ravada::Auth::SQL->search_by_id( $request->args->{uid});
+    my $display = $domain->display($user);
     $request->result({display => $display});
 
     $request->status('done');

lib/Ravada/Auth/SQL.pm

@@ -9,6 +9,8 @@ use Digest::SHA qw(sha1_hex);
 use Hash::Util qw(lock_hash);
 use Moose;
 
+use Data::Dumper;
+
 with 'Ravada::Auth::User';
 
 
@@ -34,6 +36,13 @@ sub BUILD {
     return $self;
 }
 
+sub search_by_id {
+    my $self = shift;
+    my $id = shift;
+    my $data = _load_data_by_id($id);
+    return Ravada::Auth::SQL->new(name => $data->{name});
+}
+
 sub add_user {
     _init_connector();
     my ($login,$password, $is_admin ) = @_;
@@ -52,19 +61,34 @@ sub add_user {
 sub _load_data {
     my $self = shift;
 
-    die "No login name" if !$self->name;
+    die "No login name nor id " if !$self->name && !$self->id;
 
     my $sth = $$CON->dbh->prepare(
        "SELECT * FROM users WHERE name=? ");
-    $sth->execute($self->name );
+    $sth->execute($self->name);
     my ($found) = $sth->fetchrow_hashref;
     $sth->finish;
 
-    if ($found) {
-        delete $found->{password};
-        lock_hash %$found;
-        $self->{_data} = $found if ref $self && $found;
-    }
+    return if !$found->{name};
+
+    delete $found->{password};
+    lock_hash %$found;
+    $self->{_data} = $found if ref $self && $found;
+}
+
+sub _load_data_by_id {
+    my $id = shift;
+
+    my $sth = $$CON->dbh->prepare(
+       "SELECT * FROM users WHERE id=? ");
+    $sth->execute($id);
+    my ($found) = $sth->fetchrow_hashref;
+    $sth->finish;
+
+    delete $found->{password};
+    lock_hash %$found;
+
+    return $found;
 }
 
 sub login {
@@ -107,8 +131,11 @@ sub is_admin {
 
 sub id {
     my $self = shift;
-    return $self->{_data}->{id};
-}
+    my $id;
+    eval { $id = $self->{_data}->{id} };
+    confess $@ if $@;
 
+    return $id;
+}
 1;
 

lib/Ravada/Auth/User.pm

@@ -12,7 +12,7 @@ requires 'is_admin';
 has 'name' => (
            is => 'ro'
          ,isa => 'Str'
-    ,required => 1
+    ,required =>1 
 );
 
 has 'password' => (

lib/Ravada/Domain.pm

@@ -36,8 +36,25 @@ has 'timeout_shutdown' => (
 our $CONNECTOR = \$Ravada::CONNECTOR;
 
 ##################################################################################3
-
 #
+# Method Modifiers
+# 
+
+before 'display' => \&_allowed;
+
+sub _allowed {
+    my $self = shift;
+
+    my ($user) = @_;
+
+    confess "Missing user uid"  if !defined $user;
+    return if $self->id_owner == $user->id
+            || $user->is_admin;
+
+    die "User ".$user->name." not allowed to access ".$self->domain;
+
+}
+##################################################################################3
 sub id {
     return $_[0]->_data('id');
 

lib/Ravada/Domain/Void.pm

@@ -23,7 +23,10 @@ sub name {
     return $self->domain;
 };
 
-sub display {}
+sub display {
+    return 'void://hostname:000/';
+}
+
 sub is_active {}
 
 sub pause {}

lib/Ravada/Front.pm

@@ -215,8 +215,9 @@ sub search_domain_by_id {
 sub domdisplay {
     my $self = shift;
     my $name = shift;
+    my $user = shift;
 
-    my $req = Ravada::Request->domdisplay($name);
+    my $req = Ravada::Request->domdisplay($name, $user->id);
     $self->wait_request($req, 10);
 
     return if $req->status() ne 'done';

lib/Ravada/Request.pm

@@ -259,10 +259,12 @@ sub domdisplay {
     my $class=ref($proto) || $proto;
 
     my $name = shift;
+    my $uid = shift;
 
     my $self = {};
     bless ($self, $class);
-    return $self->_new_request( command => 'domdisplay',args => { name => $name });
+    return $self->_new_request( command => 'domdisplay'
+        ,args => { name => $name, uid => $uid });
 }
 
 sub _new_request {

t/60_user_sql.t

@@ -25,7 +25,14 @@ Ravada::Auth::SQL::add_user('root','root', 1);
     my $user = Ravada::Auth::SQL->new(name => 'root',password => 'root');
     
     ok($user);
+    ok($user->id, "User ".$user->name." has no id");
     ok($user->is_admin,"User ".$user->name." should be admin ".Dumper($user->{_data}));
+
+    my $user2 = Ravada::Auth::SQL->search_by_id($user->id );
+    ok($user2, "I can't open user with id") or return;
+    ok($user2->id eq $user->id ,"Expecting user id=".$user->id." , got ".$user2->id);
+    ok($user2->name eq $user->name,"Expecting user name =".$user->name." , got ".$user2->name);
+
 }
     
 Ravada::Auth::SQL::add_user('mcnulty','jameson');

t/front/20_create_domain.t

@@ -5,6 +5,9 @@ use Data::Dumper;
 use Test::More;
 use Test::SQL::Data;
 
+use lib 't/lib';
+use Test::Ravada;
+
 use_ok('Ravada::Front');
 
 my ($DOMAIN_NAME) = $0 =~ m{.*/(.*)\.t};
@@ -13,12 +16,14 @@ my $CONT= 0;
 
 my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
 
+my $CONFIG_FILE = 't/etc/ravada.conf';
+
 my @rvd_args = (
-       config => 't/etc/ravada.conf' 
+       config => $CONFIG_FILE
    ,connector => $test->connector 
 );
 
-my $RVD_BACK  = Ravada->new( @rvd_args );
+my $RVD_BACK  = rvd_back( $test->connector, $CONFIG_FILE );
 my $RVD_FRONT = Ravada::Front->new( @rvd_args
     , backend => $RVD_BACK
 );
@@ -28,6 +33,8 @@ my %CREATE_ARGS = (
     ,lxc => { id_template => 1, id_owner => 1 }
 );
 
+my $USER = create_user('foo','bar');
+
 ###################################################################
 
 sub _new_name {
@@ -40,32 +47,6 @@ sub create_args {
     die "Unknown backend $backend" if !$CREATE_ARGS{$backend};
     return %{$CREATE_ARGS{$backend}};
 }
-sub remove_old_disks {
-    my $name = $DOMAIN_NAME;
-
-    my $vm = $RVD_BACK->search_vm('kvm');
-    ok($vm,"I can't find a KVM virtual manager") or return;
-
-    my $dir_img = $vm->dir_img();
-    ok($dir_img," I cant find a dir_img in the KVM virtual manager") or return;
-
-    for my $count ( 0 .. 10 ) {
-        my $disk = $dir_img."/$name"."_$count.img";
-        if ( -e $disk ) {
-            unlink $disk or die "I can't remove $disk";
-        }
-    }
-    $vm->storage_pool->refresh();
-}
-
-sub remove_old_domains {
-    for ( 0 .. 10 ) {
-        my $dom_name = $DOMAIN_NAME."_$_";
-        my $domain = $RVD_BACK->search_domain($dom_name);
-        $domain->shutdown_now() if $domain;
-        test_remove_domain($dom_name);
-    }
-}
 
 sub search_domain_db
  {
@@ -132,7 +113,7 @@ for my $vm_name ('kvm','lxc') {
     $RVD_FRONT->wait_request($req,10);
     ok($req->status('done'),"Request ".$req->status);
 
-    my $display = $RVD_FRONT->domdisplay($name);
+    my $display = $RVD_FRONT->domdisplay($name, $USER);
     ok($display,"No display for domain $name found. Is it active ?");
     ok($display =~ m{\w+://.*?:\d+},"Expecting display a URL, it is '$display'");
 }

t/lib/Test/Ravada.pm

@@ -5,13 +5,17 @@ use warnings;
 use  Carp qw(carp);
 use  Data::Dumper;
 use  Test::More;
+
+use Ravada;
+use Ravada::Auth::SQL;
+
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 
 require Exporter;
 
 @ISA = qw(Exporter);
 
-@EXPORT = qw(base_domain_name new_domain_name rvd_back remove_old_disks remove_old_domains);
+@EXPORT = qw(base_domain_name new_domain_name rvd_back remove_old_disks remove_old_domains create_user);
 
 our $DEFAULT_CONFIG = "t/etc/ravada.conf";
 
@@ -90,4 +94,16 @@ sub remove_old_disks {
     $vm->storage_pool->refresh();
 }
 
+sub create_user {
+    my ($name, $pass, $is_admin) = @_;
+    Ravada::Auth::SQL::add_user($name, $pass, $is_admin);
+
+    my $user;
+    eval {
+        $user = Ravada::Auth::SQL->new(name => $name, password => $pass);
+    };
+    die $@ if !$user;
+    return $user;
+}
+
 1;

t/user/10_domains.t

@@ -16,24 +16,80 @@ my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
 
 my $ravada = rvd_back($test->connector , 't/etc/ravada.conf');
 
-my $name = 'foo';
-Ravada::Auth::SQL::add_user($name, 'bar',);
+#
+# Create a new user
+#
+sub test_create_user {
 
-my $user = Ravada::Auth::SQL->new(name => $name, password => 'bar');
-ok(! $user->is_admin,"User $name should not be admin");
+    my $name = shift;
+    my $is_admin = shift or 0;
 
-my $vm = Ravada::VM::Void->new();
-ok($vm,"I can't create void VM");
+    Ravada::Auth::SQL::add_user($name, 'bar', $is_admin);
 
-my $domain_name = new_domain_name();
-my $domain = $vm->create_domain(name => $domain_name, id_owner => $user->id);
+    my $user = Ravada::Auth::SQL->new(name => $name, password => 'bar');
+    if ($is_admin) {
+        ok($user->is_admin,"User $name should be admin");
+    } else {
+        ok(! $user->is_admin,"User $name should not be admin");
+    }
 
-ok($domain,"No domain $domain_name created");
+    return $user;
+}
 
-ok($domain->name eq $domain_name, "Expecting domain name $domain_name , got "
+sub test_create_domain {
+    my $user = shift;
+
+    my $vm = Ravada::VM::Void->new();
+    ok($vm,"I can't connect void VM");
+
+    my $domain_name = new_domain_name();
+    my $domain = $vm->create_domain(name => $domain_name, id_owner => $user->id);
+
+    ok($domain,"No domain $domain_name created");
+
+    ok($domain->name eq $domain_name, "Expecting domain name $domain_name , got "
         .($domain->name or '<UNDEF>'));
-ok($domain->id_owner
-    && $domain->id_owner eq $user->id,"Expecting owner=".$user->id." , got ".$domain->id_owner);
+    ok($domain->id_owner
+        && $domain->id_owner eq $user->id,"Expecting owner=".$user->id
+                                        ." , got ".$domain->id_owner);
+    return $domain;
+}
+
+#
+# test display allowed
+#
+sub test_display {
+
+    my ($domain, $user1, $user2) = @_;
+    my $display;
+    
+    eval { $display = $domain->display($user1) };
+    ok($display, "User ".$user1->name." should be able to view ".$domain->name." $@ "
+        .Dumper($user1));
+    $display = undef;
+    
+    eval { $display = $domain->display($user2) };
+    ok(!$display, "User ".$user2->name." shouldn't be able to view ".$domain->name);
+}
+
+sub create_admin_user {
+    my $name = shift;
+
+    my $user = test_create_user($name, 1);
+    ok($user->is_admin);
+
+    return $user;
+}
+
+######################################3
+
+my $user_foo = test_create_user('foo');
+my $user_bar = test_create_user('bar');
+my $domain = test_create_domain($user_foo);
+test_display($domain,$user_foo , $user_bar );
+
+my $user_admin = create_admin_user('mcnulty');
+test_display($domain,$user_admin , $user_bar );
 
 done_testing();
 

t/vm/10_base.t

@@ -23,6 +23,8 @@ my %ARG_CREATE_DOM = (
 
 rvd_back($test->connector, $FILE_CONFIG);
 
+my $USER = create_user("foo","bar");
+
 ##########################################################
 
 sub test_vm_connect {
@@ -69,7 +71,7 @@ sub test_create_domain {
 
     my $domain;
     eval { $domain = $vm->create_domain(name => $name
-                    , id_owner => 1
+                    , id_owner => $USER->id
                     , @{$ARG_CREATE_DOM{$vm_name}}) 
     };
 
@@ -79,6 +81,23 @@ sub test_create_domain {
         .($domain->name or '<UNDEF>')
         ." for VM $vm_name"
     );
+
+    return $domain;
+}
+
+sub test_manage_domain {
+    my $domain = shift;
+
+    my $display;
+    eval { $display = $domain->display($USER) };
+    ok($display,"No display for ".$domain->name." $@");
+}
+
+sub test_remove_domain {
+    my $domain = shift;
+    eval { $domain->remove };
+    ok(!$@ , "Error removing domain ".$domain->name." ".ref($domain).": $@") or exit;
+
 }
 
 #######################################################
@@ -106,8 +125,9 @@ for my $vm_name (qw( Void KVM )) {
 
         test_vm_connect($vm_name);
         test_search_vm($vm_name);
-        test_create_domain($vm_name);
-
+        my $domain = test_create_domain($vm_name);
+        test_manage_domain($domain);
+        test_remove_domain($domain);
     };
 }
 done_testing();