SQL.pm 26.1 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
    confess "Permission '$grant' invalid\n".Dumper($self->{_grant_alias})
653
654
655
656
657
658
659
660
661
662
663
664
665
        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;
742
743
        $self->{_grant_type}->{$grant_alias} = 'boolean';
        $self->{_grant_type}->{$grant_alias} = 'int' if $is_int;
Francesc Guasch's avatar
Francesc Guasch committed
744
745
    }
    $sth->finish;
746
747
}

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

753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
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
778
779
}

Francesc Guasch's avatar
Francesc Guasch committed
780
781
782
783
784
785
=head2 grant_user_permissions

Grant an user permissions for normal users

=cut

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

Francesc Guasch's avatar
Francesc Guasch committed
795
796
797
798
799
800
=head2 grant_operator_permissions

Grant an user operator permissions, ie: hibernate all

=cut

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

Francesc Guasch's avatar
Francesc Guasch committed
806
807
808
809
810
811
=head2 grant_manager_permissions

Grant an user manager permissions, ie: hibernate all clones

=cut

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

Francesc Guasch's avatar
Francesc Guasch committed
817
818
819
820
821
822
=head2 grant_admin_permissions

Grant an user all the permissions

=cut

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

840
841
842
843
844
845
846
847
=head2 revoke_all_permissions

Revoke all permissions from an user

=cut

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

}


Francesc Guasch's avatar
Francesc Guasch committed
859
860
861
862
863
864
865
866
867
868
869
=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

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

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

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

Francesc Guasch's avatar
Francesc Guasch committed
881
882
883
884
885
886
    if ( $self->grant_type($permission) eq 'boolean' ) {
        if ($value eq 'false' || !$value ) {
            $value = 0;
        } else {
            $value = 1;
        }
887
888
889
890
    }

    return 0 if !$value && !$user->can_do($permission);

891
    my $value_sql = $user->can_do($permission);
892
    return 0 if !$value && !$value_sql;
893
    return $value if defined $value_sql && $value_sql eq $value;
894

895
896
    $permission = $self->_grant_alias($permission);
    my $id_grant = $self->_search_id_grant($permission);
897
    if (! defined $value_sql) {
898
        my $sth = $$CON->dbh->prepare(
899
900
            "INSERT INTO grants_user "
            ." (id_grant, id_user, allowed)"
901
            ." VALUES(?,?,?) "
902
903
904
905
906
        );
        $sth->execute($id_grant, $user->id, $value);
        $sth->finish;
    } else {
        my $sth = $$CON->dbh->prepare(
907
908
909
910
911
912
913
914
915
916
917
            "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
918
    return $value;
Francesc Guasch's avatar
Francesc Guasch committed
919
920
}

Francesc Guasch's avatar
Francesc Guasch committed
921
922
923
924
925
926
927
928
=head2 revoke

Revoke a permission from an user

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

=cut

929
930
931
932
933
sub revoke($self,$user,$permission) {
    return $self->grant($user,$permission,0);
}


Francesc Guasch's avatar
Francesc Guasch committed
934
935
936
937
938
939
=head2 list_all_permissions

Returns a list of all the available permissions

=cut

Francesc Guasch's avatar
Francesc Guasch committed
940
sub list_all_permissions($self) {
Francesc Guasch's avatar
Francesc Guasch committed
941
    return if !$self->is_admin && !$self->can_grant();
942
    $self->_load_grants();
943

Francesc Guasch's avatar
Francesc Guasch committed
944
    my $sth = $$CON->dbh->prepare(
945
946
947
        "SELECT * FROM grant_types"
        ." WHERE enabled=1 "
        ." ORDER BY name "
Francesc Guasch's avatar
Francesc Guasch committed
948
949
950
    );
    $sth->execute;
    my @list;
951
    while (my $row = $sth->fetchrow_hashref ) {
952
        $row->{name} = $self->_grant_alias($row->{name});
953
954
        lock_hash(%$row);
        push @list,($row);
Francesc Guasch's avatar
Francesc Guasch committed
955
956
    }
    return @list;
Francesc Guasch's avatar
Francesc Guasch committed
957
958
}

959
sub grant_type($self, $permission) {
Francesc Guasch's avatar
Francesc Guasch committed
960
    return 'boolean' if !exists $self->{_grant_type}->{$permission};
961
962
963
    return $self->{_grant_type}->{$permission};
}

Francesc Guasch's avatar
Francesc Guasch committed
964
965
966
967
968
969
=head2 list_permissions

Returns a list of all the permissions granted to the user

=cut

Francesc Guasch's avatar
Francesc Guasch committed
970
sub list_permissions($self) {
971
    $self->_load_grants();
Francesc Guasch's avatar
Francesc Guasch committed
972
973
974
975
976
977
978
979
    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
980
981
=pod

982
983
984
985
986
987
988
989
990
991
992
993
994
995
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
996
997
=cut

Francesc Guasch's avatar
Francesc Guasch committed
998
999
1000
1001
1002
1003
1004
1005
1006
=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

1007
sub can_manage_machine($self, $domain) {
1008
1009
    return 1 if $self->is_admin;

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

1012
1013
1014
1015
1016
1017
    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);
1018

1019
1020
    if ( ($self->can_remove_clones || $self->can_change_settings_clones || $self->can_rename_clones) 
         && $domain->id_base ) {
1021
1022
1023
1024
1025
1026
        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
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
=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
1041
1042
1043
sub can_remove_clones($self, $id_domain=undef) {

    return $self->can_do('remove_clones') if !$id_domain;
Francesc Guasch's avatar
Francesc Guasch committed
1044
1045
1046
1047
1048
1049

    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
1050
    return 0 if !$self->can_remove_clones();
Francesc Guasch's avatar
Francesc Guasch committed
1051
1052
1053
1054
1055
1056

    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
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
=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
1071
1072
sub can_remove_machine($self, $domain) {
    return 1 if $self->can_remove_all();
Francesc Guasch's avatar
Francesc Guasch committed
1073
    #return 0 if !$self->can_remove();
Francesc Guasch's avatar
Francesc Guasch committed
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084

    $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
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
=head2 can_shutdown_machine

Return true if the user can shutdown this machine

Arguments:

=over

=item * domain

=back

=cut

1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
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
1115
1116
1117
1118
1119
1120
=head2 grants

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

=cut

1121
sub grants($self) {
1122
    $self->_load_grants();
1123
1124
1125
1126
    return () if !$self->{_grant};
    return %{$self->{_grant}};
}

1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
sub grants_info($self) {
    my %grants = $self->grants();
    my %grants_info;
    for my $key ( keys %grants ) {
        $grants_info{$key}->[0] = $grants{$key};
        $grants_info{$key}->[1] = $self->{_grant_type}->{$key};
    }
    return %grants_info;
}

1137
1138
1139
1140
1141
1142
1143
1144
1145
=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"
1146
        if !$self->external_auth || $self->external_auth ne 'ldap';
1147
1148
1149

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

1150
1151
1152
1153
1154
1155
    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;
    }
1156

1157
    return;
1158
}
1159

1160
1161
1162
1163
1164
1165
=head2 groups

Returns a list of the groups this user belogs to

=cut

1166
1167
sub groups($self) {
    return () if !$self->external_auth || $self->external_auth ne 'ldap';
1168
    my @groups = Ravada::Auth::LDAP::search_group_members($self->name);
1169
1170
1171
1172
    return @groups;

}

Francesc Guasch's avatar
Francesc Guasch committed
1173
sub AUTOLOAD($self, $domain=undef) {
Francesc Guasch's avatar
Francesc Guasch committed
1174
1175
1176
1177
1178
1179
1180
1181

    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
1182
1183
1184
    return $self->can_do($permission)   if !$domain;

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

1187
1;