SQL.pm 25.3 KB
Newer Older
Francesc Guasch's avatar
Francesc Guasch committed
1
2
3
4
5
package Ravada::Auth::SQL;

use warnings;
use strict;

6
7
8
9
10
11
=head1 NAME

Ravada::Auth::SQL - SQL authentication library for Ravada

=cut

12
13
use Carp qw(carp);

14
use Ravada;
15
use Ravada::Utils;
16
use Ravada::Front;
Francesc Guasch's avatar
Francesc Guasch committed
17
use Digest::SHA qw(sha1_hex);
Francesc Guasch's avatar
Francesc Guasch committed
18
19
20
use Hash::Util qw(lock_hash);
use Moose;

Francesc Guasch's avatar
Francesc Guasch committed
21
22
23
use feature qw(signatures);
no warnings "experimental::signatures";

Francesc Guasch's avatar
Francesc Guasch committed
24
25
use vars qw($AUTOLOAD);

26
27
use Data::Dumper;

Francesc Guasch's avatar
Francesc Guasch committed
28
with 'Ravada::Auth::User';
Francesc Guasch's avatar
Francesc Guasch committed
29

Francesc Guasch's avatar
Francesc Guasch committed
30

31
32
33
our $CON;

sub _init_connector {
34
35
36
37
38
39
40
41
    my $connector = shift;

    $CON = \$connector                 if defined $connector;
    return if $CON;

    $CON= \$Ravada::CONNECTOR          if !$CON || !$$CON;
    $CON= \$Ravada::Front::CONNECTOR   if !$CON || !$$CON;

42
    if (!$CON || !$$CON) {
43
44
        my $connector = Ravada::_connect_dbh();
        $CON = \$connector;
45
46
47
    }

    die "Undefined connector"   if !$CON || !$$CON;
48
}
49

Francesc Guasch's avatar
Francesc Guasch committed
50

Francesc Guasch's avatar
Francesc Guasch committed
51
52
53
54
55
56
=head2 BUILD

Internal OO build method

=cut

Francesc Guasch's avatar
Francesc Guasch committed
57
sub BUILD {
58
59
    _init_connector();

Francesc Guasch's avatar
Francesc Guasch committed
60
    my $self = shift;
61
62
63

    $self->_load_data();

64
    return if !$self->password();
65

Francesc Guasch's avatar
Francesc Guasch committed
66
67
    die "ERROR: Login failed ".$self->name
        if !$self->login();#$self->name, $self->password);
68

Francesc Guasch's avatar
Francesc Guasch committed
69
70
71
    return $self;
}

Francesc Guasch's avatar
Francesc Guasch committed
72
73
74
75
76
77
78
79
=head2 search_by_id

Searches a user by its id

    my $user = Ravada::Auth::SQL->search_by_id( $id );

=cut

80
81
82
83
sub search_by_id {
    my $self = shift;
    my $id = shift;
    my $data = _load_data_by_id($id);
84
    return if !keys %$data;
85
86
87
    return Ravada::Auth::SQL->new(name => $data->{name});
}

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
=head2 list_all_users

Returns a list of all the usernames

=cut

sub list_all_users() {
    my $sth = $$CON->dbh->prepare(
        "SELECT(name) FROM users ORDER BY name"
    );
    $sth->execute;
    my @list;
    while (my $row = $sth->fetchrow) {
        push @list,($row);
    }
    return @list;
}

Francesc Guasch's avatar
Francesc Guasch committed
106
107
108
109
=head2 add_user

Adds a new user in the SQL database. Returns nothing.

110
    Ravada::Auth::SQL::add_user(
111
112
113
114
115
                 name => $user
           , password => $pass
           , is_admin => 0
       , is_temporary => 0
    );
Francesc Guasch's avatar
Francesc Guasch committed
116
117
118

=cut

Francesc Guasch's avatar
Francesc Guasch committed
119
sub add_user {
120
121
    my %args = @_;

122
    _init_connector();
123
124
125
126
127

    my $name= $args{name};
    my $password = $args{password};
    my $is_admin = ($args{is_admin} or 0);
    my $is_temporary= ($args{is_temporary} or 0);
128
    my $is_external= ($args{is_external} or 0);
129
    my $external_auth = $args{external_auth};
130

131
    delete @args{'name','password','is_admin','is_temporary','is_external', 'external_auth'};
132
133
134
135

    confess "WARNING: Unknown arguments ".Dumper(\%args)
        if keys %args;

136

137
138
    my $sth;
    eval { $sth = $$CON->dbh->prepare(
139
140
            "INSERT INTO users (name,password,is_admin,is_temporary, is_external, external_auth)"
            ." VALUES(?,?,?,?,?,?)");
141
142
    };
    confess $@ if $@;
143
144
145
146
147
    if ($password) {
        $password = sha1_hex($password);
    } else {
        $password = '*LK* no pss';
    }
148
    $sth->execute($name,$password,$is_admin,$is_temporary, $is_external, $external_auth);
Francesc Guasch's avatar
Francesc Guasch committed
149
    $sth->finish;
150
151
152
153
154
155

    $sth = $$CON->dbh->prepare("SELECT id FROM users WHERE name = ? ");
    $sth->execute($name);
    my ($id_user) = $sth->fetchrow;
    $sth->finish;

156
157
    my $user = Ravada::Auth::SQL->search_by_id($id_user);

158
    Ravada::Utils::user_daemon->grant_user_permissions($user);
159
    if (!$is_admin) {
160
        Ravada::Utils::user_daemon->grant_user_permissions($user);
161
162
        return $user;
    }
163
    Ravada::Utils::user_daemon->grant_admin_permissions($user);
164
    return $user;
165
166
}

167
168
169
170
171
172
173
174
175
sub _search_id_grant($self, $type) {

    $self->_load_grants();

    my @names = $self->_grant_alternate_name($type);

    my $sth = $$CON->dbh->prepare("SELECT id FROM grant_types WHERE "
        .join( " OR ",  map { "name=?"}@names));
    $sth->execute(@names);
176
177
178
    my ($id) = $sth->fetchrow;
    $sth->finish;

179
180
    confess "Unknown grant $type\n".Dumper($self->{_grant_alias}, $self->{_grant})   if !$id;

181
    return $id;
Francesc Guasch's avatar
Francesc Guasch committed
182
183
}

184
185
sub _load_data {
    my $self = shift;
186
    _init_connector();
187

188
    die "No login name nor id " if !$self->name && !$self->id;
189

190
    confess "Undefined \$\$CON" if !defined $$CON;
191
192
    my $sth = $$CON->dbh->prepare(
       "SELECT * FROM users WHERE name=? ");
193
    $sth->execute($self->name);
194
195
196
    my ($found) = $sth->fetchrow_hashref;
    $sth->finish;

197
198
199
200
201
202
203
204
205
    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;
206
    _init_connector();
207
208
209
210
211
212
213
214
215
216
217

    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;
218
219
}

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
sub _load_data_by_username {
    my $username = shift;
    _init_connector();

    my $sth = $$CON->dbh->prepare(
       "SELECT * FROM users WHERE name=? ");
    $sth->execute($username);
    my ($found) = $sth->fetchrow_hashref;
    $sth->finish;

    delete $found->{password};
    lock_hash %$found;

    return $found;
}

236
237
238
239
240
241
242
243
244
245
246
247
=head2 login

Logins the user

     my $ok = $user->login($password);
     my $ok = Ravada::LDAP::SQL::login($name, $password);

returns true if it succeeds

=cut


Francesc Guasch's avatar
Francesc Guasch committed
248
sub login {
Francesc Guasch's avatar
Francesc Guasch committed
249
250
    my $self = shift;

251
252
    _init_connector();

Francesc Guasch's avatar
Francesc Guasch committed
253
254
255
256
257
258
259
260
261
262
263
    my ($name, $password);

    if (ref $self) {
        $name = $self->name;
        $password = $self->password;
        $self->{_data} = {};
    } else { # old login API
        $name = $self;
        $password = shift;
    }

Francesc Guasch's avatar
Francesc Guasch committed
264

265
    my $sth = $$CON->dbh->prepare(
Francesc Guasch's avatar
Francesc Guasch committed
266
       "SELECT * FROM users WHERE name=? AND password=?");
Francesc Guasch's avatar
Francesc Guasch committed
267
    $sth->execute($name , sha1_hex($password));
Francesc Guasch's avatar
Francesc Guasch committed
268
    my ($found) = $sth->fetchrow_hashref;
Francesc Guasch's avatar
Francesc Guasch committed
269
    $sth->finish;
270

Francesc Guasch's avatar
Francesc Guasch committed
271
272
    if ($found) {
        lock_hash %$found;
Francesc Guasch's avatar
Francesc Guasch committed
273
        $self->{_data} = $found if ref $self && $found;
Francesc Guasch's avatar
Francesc Guasch committed
274
275
276
    }

    return 1 if $found;
277
278

    return;
Francesc Guasch's avatar
Francesc Guasch committed
279
280
}

Laura Figuerola's avatar
Laura Figuerola committed
281
282
283
284
285
286
=head2 make_admin

Makes the user admin. Returns nothing.

     Ravada::Auth::SQL::make_admin($id);

287
=cut
Laura Figuerola's avatar
Laura Figuerola committed
288

Francesc Guasch's avatar
Francesc Guasch committed
289
sub make_admin($self, $id) {
Laura Figuerola's avatar
Laura Figuerola committed
290
291
292
293
294
    my $sth = $$CON->dbh->prepare(
            "UPDATE users SET is_admin=1 WHERE id=?");

    $sth->execute($id);
    $sth->finish;
295

296
297
298
    my $user = $self->search_by_id($id);
    $self->grant_admin_permissions($user);

Laura Figuerola's avatar
Laura Figuerola committed
299
300
}

301
302
303
304
305
306
=head2 remove_admin

Remove user admin privileges. Returns nothing.

     Ravada::Auth::SQL::remove_admin($id);

307
=cut
308

Francesc Guasch's avatar
Francesc Guasch committed
309
sub remove_admin($self, $id) {
310
311
312
313
314
    my $sth = $$CON->dbh->prepare(
            "UPDATE users SET is_admin=NULL WHERE id=?");

    $sth->execute($id);
    $sth->finish;
315

316
317
318
    my $user = $self->search_by_id($id);
    $self->revoke_all_permissions($user);
    $self->grant_user_permissions($user);
319
320
}

321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
=head2 external_auth

Sets or gets the external auth value of an user.

=cut

sub external_auth($self, $value=undef) {
    if (!defined $value) {
        return $self->{_data}->{external_auth};
    }
    my $sth = $$CON->dbh->prepare(
        "UPDATE users set external_auth=? WHERE id=?"
    );
    $sth->execute($value, $self->id);
    $self->_load_data();
}

Francesc Guasch's avatar
Francesc Guasch committed
338
339
340
341
342
343
344
345
346
=head2 is_admin

Returns true if the user is admin.

    my $is = $user->is_admin;

=cut


Francesc Guasch's avatar
Francesc Guasch committed
347
348
sub is_admin {
    my $self = shift;
349
    return ($self->{_data}->{is_admin} or 0);
Francesc Guasch's avatar
Francesc Guasch committed
350
}
351

serk's avatar
serk committed
352
353
354
355
356
357
358
359
360
361
362
363
364
=head2 is_user_manager

Returns true if the user is user manager

=cut

sub is_user_manager {
    my $self = shift;
    return 1 if $self->can_grant()
            || $self->can_manage_users();
    return 0;
}

365
366
367
368
369
370
371
372
=head2 is_operator

Returns true if the user is admin or has been granted special permissions

=cut

sub is_operator {
    my $self = shift;
serk's avatar
serk committed
373
374
375
376
    return 1 if $self->can_list_own_machines()
            || $self->can_list_clones()
            || $self->can_list_clones_from_own_base()
            || $self->can_list_machines()
Francesc Guasch's avatar
Francesc Guasch committed
377
378
379
380
            || $self->is_user_manager()
            || $self->can_view_groups()
            || $self->can_manage_groups()
    ;
serk's avatar
serk committed
381
    return 0;
382
383
}

384
385
386
=head2 can_list_own_machines

Returns true if the user can list her own virtual machines at the web frontend
serk's avatar
serk committed
387
(can_XXXXX)
388
389
390
391
392

=cut

sub can_list_own_machines {
    my $self = shift;
serk's avatar
serk committed
393
    return 1 if $self->can_create_base()
394
            || $self->can_create_machine()
serk's avatar
serk committed
395
396
397
            || $self->can_rename()
            || $self->can_list_clones()
            || $self->can_list_machines();
398
399
400
    return 0;
}

serk's avatar
serk committed
401
=head2 can_list_clones_from_own_base
402

serk's avatar
serk committed
403
404
Returns true if the user can list all machines that are clones from his bases
(can_XXXXX_clones)
405
406
407

=cut

serk's avatar
serk committed
408
409
410
411
412
413
414
sub can_list_clones_from_own_base($self) {
    return 1 if $self->can_change_settings_clones()
            || $self->can_remove_clones()
            || $self->can_rename_clones()
            || $self->can_shutdown_clones()
            || $self->can_list_clones()
            || $self->can_list_machines();
415
416
417
    return 0;
}

serk's avatar
serk committed
418
=head2 can_list_clones
Francesc Guasch's avatar
Francesc Guasch committed
419

serk's avatar
serk committed
420
421
Returns true if the user can list all machines that are clones and its bases
(can_XXXXX_clones_all)
Francesc Guasch's avatar
Francesc Guasch committed
422
423
424

=cut

serk's avatar
serk committed
425
426
427
428
sub can_list_clones {
    my $self = shift;
    return 1 if $self->can_remove_clone_all()
            || $self->can_list_machines();
429
    return 0;
serk's avatar
serk committed
430
  
431
432
}

433
434
435
=head2 can_list_machines

Returns true if the user can list all the virtual machines at the web frontend
serk's avatar
serk committed
436
(can_XXXXX_all or is_admin)
437
438
439
440
441

=cut

sub can_list_machines {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
442
    return 1 if $self->is_admin()
Francesc Guasch's avatar
Francesc Guasch committed
443
            || $self->can_change_settings_all()
serk's avatar
serk committed
444
445
446
447
            || $self->can_clone_all()
            || $self->can_remove_all()
            || $self->can_rename_all()
            || $self->can_shutdown_all();
448
449
450
451
    return 0;
}


452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
=head2 is_external

Returns true if the user authentication is not from SQL

    my $is = $user->is_external;

=cut


sub is_external {
    my $self = shift;
    return $self->{_data}->{is_external};
}


467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
=head2 is_temporary

Returns true if the user is admin.

    my $is = $user->is_temporary;

=cut


sub is_temporary{
    my $self = shift;
    return $self->{_data}->{is_temporary};
}


Francesc Guasch's avatar
Francesc Guasch committed
482
483
484
485
486
487
488
489
=head2 id

Returns the user id

    my $id = $user->id;

=cut

490
491
sub id {
    my $self = shift;
492
493
494
    my $id;
    eval { $id = $self->{_data}->{id} };
    confess $@ if $@;
495

496
497
    return $id;
}
Francesc Guasch's avatar
Francesc Guasch committed
498

Roberto P. Rubio's avatar
Roberto P. Rubio committed
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
=head2 password_will_be_changed

Returns true if user password will be changed

    $user->password_will_be_changed();

=cut

sub password_will_be_changed {
    my $self = shift;

    _init_connector();

    my $sth = $$CON->dbh->prepare("SELECT change_password FROM users WHERE name=?");
    $sth->execute($self->name);
    return $sth->fetchrow();
}

Francesc Guasch's avatar
Francesc Guasch committed
517
518
519
520
521
522
523
524
525
526
527
528
529
=head2 change_password

Changes the password of an User

    $user->change_password();

Arguments: password

=cut

sub change_password {
    my $self = shift;
    my $password = shift or die "ERROR: password required\n";
530
    my ($force_change_password) = @_;
Francesc Guasch's avatar
Francesc Guasch committed
531

532
533
    _init_connector();

Francesc Guasch's avatar
Francesc Guasch committed
534
535
    die "Password too small" if length($password)<6;

536
537
538
539
    if ($self->is_external) {
        return $self->_change_password_external($password);
    }

540
541
542
543
544
545
546
547
548
549
    my $sth;
    if (defined($force_change_password)) {
        $sth= $$CON->dbh->prepare("UPDATE users set password=?, change_password=?"
            ." WHERE name=?");
        $sth->execute(sha1_hex($password), $force_change_password ? 1 : 0, $self->name);
    } else {
        my $sth= $$CON->dbh->prepare("UPDATE users set password=?"
            ." WHERE name=?");
        $sth->execute(sha1_hex($password), $self->name);
    }
Francesc Guasch's avatar
Francesc Guasch committed
550
}
Francesc Guasch's avatar
Francesc Guasch committed
551

552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
sub _change_password_external($self,$password) {

    if ($self->external_auth eq 'ldap') {
        my $ldap_entry = $self->ldap_entry() or die "Error: no ldap entry";
        $ldap_entry->replace(
            userPassword => Ravada::Auth::LDAP::_password_store($password,'rfc2307'));
        my $ldap = Ravada::Auth::LDAP::_init_ldap_admin();
        my $mesg = $ldap_entry->update($ldap);
        die "ERROR: ".$mesg->code." : ".$mesg->error
        if $mesg->code;
    } else {
        confess
        "Error: I don't know how to change external password for ".$self->external_auth;
    }

}

569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
=head2 compare_password

Changes the input with the password of an User

    $user->compare_password();

Arguments: password

=cut

sub compare_password {
    my $self = shift;
    my $password = shift or die "ERROR: password required\n";
    
    _init_connector();
    
    my $sth= $$CON->dbh->prepare("SELECT password FROM users WHERE name=?");
    $sth->execute($self->name);
    my $hex_pass = $sth->fetchrow();
    if ($hex_pass eq sha1_hex($password)) {
        return 1;
    }
    else {
        return 0;
    }
}

596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
=head2 language

  Updates or selects the language selected for an User

    $user->language();

  Arguments: lang

=cut

  sub language {
    my $self = shift;
    my $tongue = shift;
    if (defined $tongue) {
      my $sth= $$CON->dbh->prepare("UPDATE users set language=?"
          ." WHERE name=?");
      $sth->execute($tongue, $self->name);
    }
    else {
      my $sth = $$CON->dbh->prepare(
         "SELECT language FROM users WHERE name=? ");
      $sth->execute($self->name);
      return $sth->fetchrow();
    }
  }

Francesc Guasch's avatar
Francesc Guasch committed
622
623
624
625
626
627
628
629
630
631

=head2 remove

Removes the user

    $user->remove();

=cut

sub remove($self) {
632
633
634
635
    my $sth = $$CON->dbh->prepare("DELETE FROM grants_user where id_user=?");
    $sth->execute($self->id);

    $sth = $$CON->dbh->prepare("DELETE FROM users where id=?");
Francesc Guasch's avatar
Francesc Guasch committed
636
637
638
639
    $sth->execute($self->id);
    $sth->finish;
}

Francesc Guasch's avatar
Francesc Guasch committed
640
641
642
643
644
645
646
647
648
=head2 can_do

Returns if the user is allowed to perform a privileged action

    if ($user->can_do("remove")) { 
        ...

=cut

Francesc Guasch's avatar
Francesc Guasch committed
649
650
651
sub can_do($self, $grant) {
    $self->_load_grants();

652
653
654
655
656
657
658
659
660
661
662
663
664
665
    confess "Wrong grant '$grant'\n".Dumper($self->{_grant_alias})
        if $grant !~ /^[a-z_]+$/;

    $grant = $self->_grant_alias($grant);

    confess "Wrong grant '$grant'\n".Dumper($self->{_grant_alias})
        if $grant !~ /^[a-z_]+$/;

    return $self->{_grant}->{$grant} if defined $self->{_grant}->{$grant};
    confess "Unknown permission '$grant'. Maybe you are using an old release.\n"
            ."Try removing the table grant_types and start rvd_back again:\n"
            ."mysql> drop table grant_types;\n"
            .Dumper($self->{_grant}, $self->{_grant_alias})
        if !exists $self->{_grant}->{$grant};
Francesc Guasch's avatar
Francesc Guasch committed
666
667
668
    return $self->{_grant}->{$grant};
}

Francesc Guasch's avatar
Francesc Guasch committed
669
670
671
672
673
674
675
676
677
=head2 can_do_domain

Returns if the user is allowed to perform a privileged action in a virtual machine

    if ($user->can_do_domain("remove", $domain)) {
        ...

=cut

Francesc Guasch's avatar
Francesc Guasch committed
678
sub can_do_domain($self, $grant, $domain) {
Roberto P. Rubio's avatar
Roberto P. Rubio committed
679
    my %valid_grant = map { $_ => 1 } qw(change_settings shutdown reboot rename);
Francesc Guasch's avatar
Francesc Guasch committed
680
681
    confess "Invalid grant here '$grant'"   if !$valid_grant{$grant};

Francesc Guasch's avatar
Francesc Guasch committed
682
    return 0 if !$self->can_do($grant) && !$self->_domain_id_base($domain);
Francesc Guasch's avatar
Francesc Guasch committed
683
684

    return 1 if $self->can_do("${grant}_all");
Francesc Guasch's avatar
Francesc Guasch committed
685
    return 1 if $self->_domain_id_owner($domain) == $self->id && $self->can_do($grant);
Francesc Guasch's avatar
Francesc Guasch committed
686

Francesc Guasch's avatar
Francesc Guasch committed
687
    if ($self->can_do("${grant}_clones") && $self->_domain_id_base($domain)) {
Francesc Guasch's avatar
Francesc Guasch committed
688
689
690
691
692
693
694
        my $base;
        my $id_base = $self->_domain_id_base($domain);
        eval { $base = Ravada::Front::Domain->open($id_base) };
        if (!defined $base) {
            warn "Error: base $id_base from $domain not found";
            return 0;
        }
Francesc Guasch's avatar
Francesc Guasch committed
695
696
697
698
699
        return 1 if $base->id_owner == $self->id;
    }
    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
sub _domain_id_base($self, $domain) {
    return $domain->id_base if ref($domain);

    my $sth = $$CON->dbh->prepare("SELECT id_base FROM domains WHERE id=?");
    $sth->execute($domain);
    my ($id_base) = $sth->fetchrow;
    return $id_base;
}

sub _domain_id_owner($self, $domain) {
    return $domain->id_owner if ref($domain);

    my $sth = $$CON->dbh->prepare("SELECT id_owner FROM domains WHERE id=?");
    $sth->execute($domain);
    my ($id_owner) = $sth->fetchrow;
    return $id_owner;
}


Francesc Guasch's avatar
Francesc Guasch committed
719
sub _load_grants($self) {
720
721
722
    $self->_load_aliases();
    return if exists $self->{_grant};

723
724
    _init_connector();

725
726
    my $sth;
    eval { $sth= $$CON->dbh->prepare(
727
        "SELECT gt.name, gu.allowed, gt.enabled, gt.is_int"
Francesc Guasch's avatar
Francesc Guasch committed
728
729
730
731
732
        ." FROM grant_types gt LEFT JOIN grants_user gu "
        ."      ON gt.id = gu.id_grant "
        ."      AND gu.id_user=?"
    );
    $sth->execute($self->id);
733
734
    };
    confess $@ if $@;
735
736
    my ($name, $allowed, $enabled, $is_int);
    $sth->bind_columns(\($name, $allowed, $enabled, $is_int));
Francesc Guasch's avatar
Francesc Guasch committed
737
738

    while ($sth->fetch) {
739
740
741
        my $grant_alias = $self->_grant_alias($name);
        $self->{_grant}->{$grant_alias} = $allowed     if $enabled;
        $self->{_grant_disabled}->{$grant_alias} = !$enabled;
Francesc Guasch's avatar
Francesc Guasch committed
742
743
    }
    $sth->finish;
744
745
}

Francesc Guasch's avatar
Francesc Guasch committed
746
747
748
749
750
sub _reload_grants($self) {
    delete $self->{_grant};
    return $self->_load_grants();
}

751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
sub _grant_alias($self, $name) {
    my $alias = $name;
    return $self->{_grant_alias}->{$name} if exists $self->{_grant_alias}->{$name};
    return $name;# if exists $self->{_grant}->{$name};

}

sub _grant_alternate_name($self,$name_req) {
    my %name = ( $name_req => 1);
    while (my($name, $alias) = each %{$self->{_grant_alias}}) {
        $name{$name} = 1 if $name_req eq $alias;
        $name{$alias} = 1 if $name_req eq $name;
    }
    return keys %name;
}

sub _load_aliases($self) {
    return if exists $self->{_grant_alias};

    my $sth = $$CON->dbh->prepare("SELECT name,alias FROM grant_types_alias");
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        $self->{_grant_alias}->{$row->{name}} = $row->{alias};
    }

Francesc Guasch's avatar
Francesc Guasch committed
776
777
}

Francesc Guasch's avatar
Francesc Guasch committed
778
779
780
781
782
783
=head2 grant_user_permissions

Grant an user permissions for normal users

=cut

Francesc Guasch's avatar
Francesc Guasch committed
784
sub grant_user_permissions($self,$user) {
785
786
787
    $self->grant($user, 'clone');
    $self->grant($user, 'change_settings');
    $self->grant($user, 'remove');
Francesc Guasch's avatar
Francesc Guasch committed
788
    $self->grant($user, 'shutdown');
Francesc Guasch's avatar
Francesc Guasch committed
789
    $self->grant($user, 'screenshot');
790
    $self->grant($user, 'reboot');
791
792
}

Francesc Guasch's avatar
Francesc Guasch committed
793
794
795
796
797
798
=head2 grant_operator_permissions

Grant an user operator permissions, ie: hibernate all

=cut

799
800
801
802
803
sub grant_operator_permissions($self,$user) {
    $self->grant($user, 'hibernate_all');
    #TODO
}

Francesc Guasch's avatar
Francesc Guasch committed
804
805
806
807
808
809
=head2 grant_manager_permissions

Grant an user manager permissions, ie: hibernate all clones

=cut

810
811
812
813
814
sub grant_manager_permissions($self,$user) {
    $self->grant($user, 'hibernate_clone');
    #TODO
}

Francesc Guasch's avatar
Francesc Guasch committed
815
816
817
818
819
820
=head2 grant_admin_permissions

Grant an user all the permissions

=cut

821
822
sub grant_admin_permissions($self,$user) {
    my $sth = $$CON->dbh->prepare(
Francesc Guasch's avatar
Francesc Guasch committed
823
            "SELECT name,default_admin FROM grant_types"
824
            ." WHERE enabled=1"
825
            ." ORDER BY name"
826
827
    );
    $sth->execute();
828
    my $grant_found=0;
Francesc Guasch's avatar
Francesc Guasch committed
829
830
831
    while ( my ($name, $default_admin) = $sth->fetchrow) {
        $default_admin=1 if !defined $default_admin;
        $self->grant($user,$name,$default_admin);
832
        $grant_found++ if $name eq'grant';
833
834
    }
    $sth->finish;
835
    confess if !$grant_found;
836
837
}

838
839
840
841
842
843
844
845
=head2 revoke_all_permissions

Revoke all permissions from an user

=cut

sub revoke_all_permissions($self,$user) {
    my $sth = $$CON->dbh->prepare(
846
            "SELECT name FROM grant_types WHERE enabled=1"
847
848
849
850
851
852
853
854
855
856
    );
    $sth->execute();
    while ( my ($name) = $sth->fetchrow) {
        $self->revoke($user,$name);
    }
    $sth->finish;

}


Francesc Guasch's avatar
Francesc Guasch committed
857
858
859
860
861
862
863
864
865
866
867
=head2 grant

Grant an user a specific permission, or revoke it

    $admin_user->grant($user2,"clone");    # both are 
    $admin_user->grant($user3,"clone",1);  # the same

    $admin_user->grant($user4,"clone",0);  # revoke a grant

=cut

868
sub grant($self,$user,$permission,$value=1) {
869
870
871
872

    confess "ERROR: permission '$permission' disabled "
        if $self->{_grant_disabled}->{$permission};

873
    if ( !$self->can_grant() && $self->name ne Ravada::Utils::user_daemon->name ) {
Francesc Guasch's avatar
Francesc Guasch committed
874
875
876
877
        my @perms = $self->list_permissions();
        confess "ERROR: ".$self->name." can't grant permissions for ".$user->name."\n"
            .Dumper(\@perms);
    }
878

879
    my $value_sql = $user->can_do($permission);
880
    return 0 if !$value && !$value_sql;
881
    return $value if defined $value_sql && $value_sql eq $value;
882

883
884
    $permission = $self->_grant_alias($permission);
    my $id_grant = $self->_search_id_grant($permission);
885
    if (! defined $value_sql) {
886
        my $sth = $$CON->dbh->prepare(
887
888
            "INSERT INTO grants_user "
            ." (id_grant, id_user, allowed)"
889
            ." VALUES(?,?,?) "
890
891
892
893
894
        );
        $sth->execute($id_grant, $user->id, $value);
        $sth->finish;
    } else {
        my $sth = $$CON->dbh->prepare(
895
896
897
898
899
900
901
902
903
904
905
            "UPDATE grants_user "
            ." set allowed=?"
            ." WHERE id_grant = ? AND id_user=?"
        );
        $sth->execute($value, $id_grant, $user->id);
        $sth->finish;
    }
    $user->{_grant}->{$permission} = $value;
    confess "Unable to grant $permission for ".$user->name ." expecting=$value "
            ." got= ".$user->can_do($permission)
        if $user->can_do($permission) ne $value;
Francesc Guasch's avatar
Francesc Guasch committed
906
    return $value;
Francesc Guasch's avatar
Francesc Guasch committed
907
908
}

Francesc Guasch's avatar
Francesc Guasch committed
909
910
911
912
913
914
915
916
=head2 revoke

Revoke a permission from an user

    $admin_user->revoke($user2,"clone");

=cut

917
918
919
920
921
sub revoke($self,$user,$permission) {
    return $self->grant($user,$permission,0);
}


Francesc Guasch's avatar
Francesc Guasch committed
922
923
924
925
926
927
=head2 list_all_permissions

Returns a list of all the available permissions

=cut

Francesc Guasch's avatar
Francesc Guasch committed
928
sub list_all_permissions($self) {
Francesc Guasch's avatar
Francesc Guasch committed
929
    return if !$self->is_admin && !$self->can_grant();
930
    $self->_load_grants();
931

Francesc Guasch's avatar
Francesc Guasch committed
932
    my $sth = $$CON->dbh->prepare(
933
934
935
        "SELECT * FROM grant_types"
        ." WHERE enabled=1 "
        ." ORDER BY name "
Francesc Guasch's avatar
Francesc Guasch committed
936
937
938
    );
    $sth->execute;
    my @list;
939
    while (my $row = $sth->fetchrow_hashref ) {
940
        $row->{name} = $self->_grant_alias($row->{name});
941
942
        lock_hash(%$row);
        push @list,($row);
Francesc Guasch's avatar
Francesc Guasch committed
943
944
    }
    return @list;
Francesc Guasch's avatar
Francesc Guasch committed
945
946
}

Francesc Guasch's avatar
Francesc Guasch committed
947
948
949
950
951
952
=head2 list_permissions

Returns a list of all the permissions granted to the user

=cut

Francesc Guasch's avatar
Francesc Guasch committed
953
sub list_permissions($self) {
954
    $self->_load_grants();
Francesc Guasch's avatar
Francesc Guasch committed
955
956
957
958
959
960
961
962
    my @list;
    for my $grant (sort keys %{$self->{_grant}}) {
        push @list , (  [$grant => $self->{_grant}->{$grant} ] )
            if $self->{_grant}->{$grant};
    }
    return @list;
}

Francesc Guasch's avatar
Francesc Guasch committed
963
964
=pod

965
966
967
968
969
970
971
972
973
974
975
976
977
978
sub can_change_settings($self, $id_domain=undef) {
    if (!defined $id_domain) {
        return $self->can_do("change_settings");
    }
    return 1 if $self->can_change_settings_all();

    return 0 if !$self->can_change_settings();

    my $domain = Ravada::Front::Domain->open($id_domain);
    return 1 if $self->id == $domain->id_owner;

    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
979
980
=cut

Francesc Guasch's avatar
Francesc Guasch committed
981
982
983
984
985
986
987
988
989
=head2 can_manage_machine

The user can change settings, remove or change other things yet to be defined.
Some changes require special permissions granted.

Unlinke change_settings that any user is granted to his own machines by default.

=cut

990
sub can_manage_machine($self, $domain) {
991
992
    return 1 if $self->is_admin;

993
994
    $domain = Ravada::Front::Domain->open($domain)  if !ref $domain;

995
996
997
998
999
1000
    return 1 if $self->can_clone_all
                || $self->can_change_settings($domain)
                || $self->can_rename_all
                || $self->can_remove_all
                || ($self->can_remove_clone_all && $domain->id_base)
                || ($self->can_remove && $domain->id_owner == $self->id);
1001

1002
1003
    if ( ($self->can_remove_clones || $self->can_change_settings_clones || $self->can_rename_clones) 
         && $domain->id_base ) {
1004
1005
1006
1007
1008
1009
        my $base = Ravada::Front::Domain->open($domain->id_base);
        return 1 if $base->id_owner == $self->id;
    }
    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
=head2 can_remove_clones

Returns true if the user can remove clones.

Arguments:

=over

=item * id_domain: optional

=back

=cut

Francesc Guasch's avatar
Francesc Guasch committed
1024
1025
1026
sub can_remove_clones($self, $id_domain=undef) {

    return $self->can_do('remove_clones') if !$id_domain;
Francesc Guasch's avatar
Francesc Guasch committed
1027
1028
1029
1030
1031
1032

    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();

Francesc Guasch's avatar
Francesc Guasch committed
1033
    return 0 if !$self->can_remove_clones();
Francesc Guasch's avatar
Francesc Guasch committed
1034
1035
1036
1037
1038
1039

    my $base = Ravada::Front::Domain->open($domain->id_base);
    return 1 if $base->id_owner == $self->id;
    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
=head2 can_remove_machine

Return true if the user can remove this machine

Arguments:

=over

=item * domain

=back

=cut

Francesc Guasch's avatar
Francesc Guasch committed
1054
1055
sub can_remove_machine($self, $domain) {
    return 1 if $self->can_remove_all();
Francesc Guasch's avatar
Francesc Guasch committed
1056
    #return 0 if !$self->can_remove();
Francesc Guasch's avatar
Francesc Guasch committed
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067

    $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;
}

Francesc Guasch's avatar
Francesc Guasch committed
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
=head2 can_shutdown_machine

Return true if the user can shutdown this machine

Arguments:

=over

=item * domain

=back

=cut

1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
sub can_shutdown_machine($self, $domain) {

    return 1 if $self->can_shutdown_all();

    $domain = Ravada::Front::Domain->open($domain)   if !ref $domain;

    return 1 if $self->id == $domain->id_owner;

    if ($domain->id_base && $self->can_shutdown_clone()) {
        my $base = Ravada::Front::Domain->open($domain->id_base);
        return 1 if $base->id_owner == $self->id;
    }

    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
1098
1099
1100
1101
1102
1103
=head2 grants

Returns a list of permissions granted to the user in a hash

=cut

1104
sub grants($self) {
1105
    $self->_load_grants();
1106
1107
1108
1109
    return () if !$self->{_grant};
    return %{$self->{_grant}};
}

1110
1111
1112
1113
1114
1115
1116
1117
1118
=head2 ldap_entry

Returns the ldap entry as a Net::LDAP::Entry of the user if it has
LDAP external authentication

=cut

sub ldap_entry($self) {
    confess "Error: User ".$self->name." is not in LDAP external auth"
1119
        if !$self->external_auth || $self->external_auth ne 'ldap';
1120
1121
1122

    return $self->{_ldap_entry} if $self->{_ldap_entry};

1123
1124
1125
1126
1127
1128
    for my $field ( qw(uid cn)) {
        my ($entry) = Ravada::Auth::LDAP::search_user( name => $self->name,field => $field );
        next if !$entry;
        $self->{_ldap_entry} = $entry;
        return $entry;
    }
1129

1130
    return;
1131
}
1132

1133
1134
1135
1136
1137
1138
=head2 groups

Returns a list of the groups this user belogs to

=cut

1139
1140
sub groups($self) {
    return () if !$self->external_auth || $self->external_auth ne 'ldap';
1141
    my @groups = Ravada::Auth::LDAP::search_group_members($self->name);
1142
1143
1144
1145
    return @groups;

}

Francesc Guasch's avatar
Francesc Guasch committed
1146
sub AUTOLOAD($self, $domain=undef) {
Francesc Guasch's avatar
Francesc Guasch committed
1147
1148
1149
1150
1151
1152
1153
1154

    my $name = $AUTOLOAD;
    $name =~ s/.*://;

    confess "Can't locate object method $name via package $self"
        if !ref($self) || $name !~ /^can_(.*)/;

    my ($permission) = $name =~ /^can_([a-z_]+)/;
Francesc Guasch's avatar
Francesc Guasch committed
1155
1156
1157
    return $self->can_do($permission)   if !$domain;

    return $self->can_do_domain($permission,$domain);
Francesc Guasch's avatar
Francesc Guasch committed
1158
1159
}

1160
1;