Front.pm 25 KB
Newer Older
1
2
3
4
5
package Ravada::Front;

use strict;
use warnings;

6
7
8
9
10
11
=head1 NAME

Ravada::Front - Web Frontend library for Ravada

=cut

12
use Carp qw(carp);
Francesc Guasch's avatar
Francesc Guasch committed
13
use DateTime;
14
15
16
17
use Hash::Util qw(lock_hash);
use JSON::XS;
use Moose;
use Ravada;
18
use Ravada::Front::Domain;
19
use Ravada::Front::Domain::KVM;
20
21
use Ravada::Network;

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

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
use Data::Dumper;

has 'config' => (
    is => 'ro'
    ,isa => 'Str'
);
has 'connector' => (
        is => 'rw'
);
has 'backend' => (
    is => 'ro',
    isa => 'Ravada'

);

has 'fork' => (
    is => 'rw'
    ,isa => 'Int'
    ,default => 1
);

our $CONNECTOR;# = \$Ravada::CONNECTOR;
our $TIMEOUT = 20;
our @VM_TYPES = ('KVM');
our $DIR_SCREENSHOTS = "/var/www/img/screenshots";

our %VM;
52
our %VM_ID;
53
our $PID_FILE_BACKEND = '/var/run/rvd_back.pid';
54

Francesc Guasch's avatar
Francesc Guasch committed
55
our $LOCAL_TZ = DateTime::TimeZone->new(name => 'local');
Francesc Guasch's avatar
Francesc Guasch committed
56
57
58
59
60
61
62
###########################################################################
#
# method modifiers
#

around 'list_machines' => \&_around_list_machines;

63
64
65
66
67
68
69
70
71
72
73
=head2 BUILD

Internal constructor

=cut

sub BUILD {
    my $self = shift;
    if ($self->connector) {
        $CONNECTOR = $self->connector;
    } else {
74
        Ravada::_init_config($self->config()) if $self->config;
75
76
        $CONNECTOR = Ravada::_connect_dbh();
    }
77
78
    Ravada::_init_config($self->config()) if $self->config;
    Ravada::Auth::init($Ravada::CONFIG);
79
80
81
82
83
84
85
86
87
88
89
    $CONNECTOR->dbh();
}

=head2 list_bases

Returns a list of the base domains as a listref

    my $bases = $rvd_front->list_bases();

=cut

90
91
sub list_bases($self, %args) {
    $args{is_base} = 1;
Francesc Guasch's avatar
Francesc Guasch committed
92
    my $query = "SELECT name, id, is_base, id_owner FROM domains "
93
94
95
96
97
98
        ._where(%args)
        ." ORDER BY name";

    my $sth = $CONNECTOR->dbh->prepare($query);
    $sth->execute(map { $args{$_} } sort keys %args);

99
100
101
102
103
104
    my @bases = ();
    while ( my $row = $sth->fetchrow_hashref) {
        my $domain;
        eval { $domain   = $self->search_domain($row->{name}) };
        next if !$domain;
        $row->{has_clones} = $domain->has_clones;
Francesc Guasch's avatar
Francesc Guasch committed
105
        $row->{is_locked} = 0 if !exists $row->{is_locked};
106
        delete $row->{spice_password};
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
        push @bases, ($row);
    }
    $sth->finish;

    return \@bases;
}

=head2 list_machines_user

Returns a list of machines available to the user

If the user has ever clone the base, it shows this information. It show the
base data if not.

Arguments: user

Returns: listref of machines

=cut

sub list_machines_user {
    my $self = shift;
    my $user = shift;

    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT id,name,is_public, file_screenshot"
        ." FROM domains "
        ." WHERE is_base=1"
        ." ORDER BY name "
    );
    my ($id, $name, $is_public, $screenshot);
    $sth->execute;
139
    $sth->bind_columns(\($id, $name, $is_public, $screenshot ));
140
141
142

    my @list;
    while ( $sth->fetch ) {
Francesc Guasch's avatar
Francesc Guasch committed
143
        next if !$is_public && !$user->is_admin;
144
145
146
147
148
149
        my $is_active = 0;
        my $clone = $self->search_clone(
            id_owner =>$user->id
            ,id_base => $id
        );
        my %base = ( id => $id, name => $name
150
            , is_public => ($is_public or 0)
151
152
153
154
155
            , screenshot => ($screenshot or '')
            , is_active => 0
            , id_clone => undef
            , name_clone => undef
            , is_locked => undef
156
            , can_hibernate => 0
157
158
159
160
        );

        if ($clone) {
            $base{is_locked} = $clone->is_locked;
Francesc Guasch's avatar
Francesc Guasch committed
161
            if ($clone->is_active && !$clone->is_locked && $user->can_screenshot) {
162
163
164
165
166
167
168
169
170
                my $req = Ravada::Request->screenshot_domain(
                id_domain => $clone->id
                ,filename => "$DIR_SCREENSHOTS/".$clone->id.".png"
                );
            }
            $base{name_clone} = $clone->name;
            $base{screenshot} = ( $clone->_data('file_screenshot') 
                                or $base{screenshot});
            $base{is_active} = $clone->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
171
172
173
            $base{id_clone} = $clone->id;
            $base{can_remove} = 0;
            $base{can_remove} = 1 if $user->can_remove && $clone->id_owner == $user->id;
174
            $base{can_hibernate} = 1 if $clone->is_active && !$clone->is_volatile;
175
176
177
178
179
180
181
182
183
        }
        $base{screenshot} =~ s{^/var/www}{};
        lock_hash(%base);
        push @list,(\%base);
    }
    $sth->finish;
    return \@list;
}

184
185
186
sub list_machines($self, $user) {
    return $self->list_domains() if $user->can_list_machines;

Francesc Guasch's avatar
Francesc Guasch committed
187
    my @list = ();
Francesc Guasch's avatar
Francesc Guasch committed
188
    if ($user->can_remove_clones() || $user->can_shutdown_clones() ) {
189
190
        my $machines = $self->list_bases( id_owner => $user->id );
        for my $base (@$machines) {
Francesc Guasch's avatar
Francesc Guasch committed
191
            confess "ERROR: BAse without id ".Dumper($base) if !$base->{id};
192
193
            push @$machines,@{$self->list_domains( id_base => $base->{id} )};
        }
Francesc Guasch's avatar
Francesc Guasch committed
194
        push @list,(@$machines);
195
    }
Francesc Guasch's avatar
Francesc Guasch committed
196
197
198
199
200
201
202
203
204
205
206
207
208
209

    push @list,(@{$self->list_clones()}) if $user->can_list_clones;
    if ($user->can_create_base || $user->can_create_machine || $user->is_operator) {
        my $machines = $self->list_domains(id_owner => $user->id);
        for my $clone (@$machines) {
            next if !$clone->{id_base};
            push @$machines,@{$self->list_domains( id => $clone->{id_base} )};
        }
        push @list,(@$machines);
    }
    return [@list] if scalar @list < 2;

    my %uniq = map { $_->{name} => $_ } @list;
    return [sort { $a->{name} cmp $b->{name} } values %uniq];
210
211
}

Francesc Guasch's avatar
Francesc Guasch committed
212
213
214
sub _around_list_machines($orig, $self, $user) {
    my $machines = $self->$orig($user);
    for my $m (@$machines) {
Francesc Guasch's avatar
Francesc Guasch committed
215
        $m->{can_shutdown} = $user->can_shutdown($m->{id});
Francesc Guasch's avatar
Francesc Guasch committed
216
217
218
219
220
221

        $m->{can_start} = 0;
        $m->{can_start} = 1 if $m->{id_owner} == $user->id || $user->is_admin;

        $m->{can_view} = 0;
        $m->{can_view} = 1 if $m->{id_owner} == $user->id || $user->is_admin;
Francesc Guasch's avatar
Francesc Guasch committed
222
223
224

        $m->{can_manage} = ( $user->can_manage_machine($m->{id}) or 0);
        $m->{can_change_settings} = ( $user->can_change_settings($m->{id}) or 0);
225
226
227
228

        $m->{can_hibernate} = 0;
        $m->{can_hibernate} = 1 if $user->can_shutdown($m->{id})
                                    && !$m->{is_volatile};
229
        lock_hash(%$m);
Francesc Guasch's avatar
Francesc Guasch committed
230
231
232
233
    }
    return $machines;
}

234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
=pod

sub search_clone_data {
    my $self = shift;
    my %args = @_;
    my $query = "SELECT * FROM domains WHERE "
        .(join(" AND ", map { "$_ = ? " } sort keys %args));

    my $sth = $CONNECTOR->dbh->prepare($query);
    $sth->execute( map { $args{$_} } sort keys %args );
    my $row = $sth->fetchrow_hashref;
    return ( $row or {});
        
}

=cut

=head2 list_domains

Returns a list of the domains as a listref

    my $bases = $rvd_front->list_domains();

=cut

259
sub list_domains($self, %args) {
260

261
    my $query = "SELECT d.name, d.id, id_base, is_base, id_vm, status, is_public "
Francesc Guasch's avatar
Francesc Guasch committed
262
        ."      ,vms.name as node , is_volatile, client_status, id_owner "
263
264
        ." FROM domains d LEFT JOIN vms "
        ."  ON d.id_vm = vms.id ";
265
266
267
268

    my $where = '';
    for my $field ( sort keys %args ) {
        $where .= " AND " if $where;
269
        $where .= " d.$field=?"
270
271
272
    }
    $where = "WHERE $where" if $where;

273
    my $sth = $CONNECTOR->dbh->prepare("$query $where ORDER BY d.id");
274
275
276
277
    $sth->execute(map { $args{$_} } sort keys %args);
    
    my @domains = ();
    while ( my $row = $sth->fetchrow_hashref) {
Francesc Guasch's avatar
Francesc Guasch committed
278
        for (qw(is_locked is_hibernated is_paused
279
280
281
                has_clones )) {
            $row->{$_} = 0;
        }
282
        my $domain ;
283
        my $t0 = time;
284
        eval { $domain   = $self->search_domain($row->{name}) };
285
        warn $@ if $@;
Francesc Guasch's avatar
Francesc Guasch committed
286
        $row->{remote_ip} = undef;
287
288
289
290
        if ( $row->{is_volatile} && !$domain ) {
            $self->_remove_domain_db($row->{id});
            next;
        }
291
292
        $row->{has_clones} = 0 if !exists $row->{has_clones};
        $row->{is_locked} = 0 if !exists $row->{is_locked};
Francesc Guasch's avatar
Francesc Guasch committed
293
294
        $row->{is_active} = 0;
        $row->{remote_ip} = undef;
295
296
        if ( $domain ) {
            $row->{is_locked} = $domain->is_locked;
Francesc Guasch's avatar
Francesc Guasch committed
297
            $row->{is_hibernated} = ( $domain->is_hibernated or 0);
298
            $row->{is_paused} = 1 if $domain->is_paused;
299
            $row->{is_active} = 1 if $row->{status} eq 'active';
300
            $row->{has_clones} = $domain->has_clones;
301
302
303
#            $row->{disk_size} = ( $domain->disk_size or 0);
#            $row->{disk_size} /= (1024*1024*1024);
#            $row->{disk_size} = 1 if $row->{disk_size} < 1;
304
            $row->{remote_ip} = $domain->remote_ip if $row->{is_active};
305
            $row->{node} = $domain->_vm->name if $domain->_vm;
306
307
            $row->{remote_ip} = $domain->client_status
                if $domain->client_status && $domain->client_status ne 'connected';
308
            $row->{autostart} = $domain->autostart;
Francesc Guasch's avatar
Francesc Guasch committed
309
310
311
312
313
314
315
316
317
            if (!$row->{status} ) {
                if ($row->{is_active}) {
                    $row->{status} = 'active';
                } elsif ($row->{is_hibernated}) {
                    $row->{status} = 'hibernated';
                } else {
                    $row->{status} = 'down';
                }
            }
318
        }
319
        delete $row->{spice_password};
320
321
322
323
324
325
        push @domains, ($row);
    }
    $sth->finish;

    return \@domains;
}
326
327
328
329
330
331
332
333
334
sub _where(%args) {
    my $where = '';
    for my $field ( sort keys %args ) {
        $where .= " AND " if $where;
        $where .= " $field=?"
    }
    $where = "WHERE $where" if $where;
    return $where;
}
335

336
337
338
339
340
341
342
343
344
345
=head2 list_clones
  Returns a list of the domains that are clones as a listref

      my $clones = $rvd_front->list_clones();
=cut

sub list_clones {
  my $self = shift;
  my %args = @_;
  
346
  my $domains = $self->list_domains();
347
348
349
350
351
352
  my @clones;
  for (@$domains ) {
    if($_->{id_base}) { push @clones, ($_); }
  }
  return \@clones;
}
353

354
355
356
357
358
359
sub _remove_domain_db($self, $id) {
    my $sth = $CONNECTOR->dbh->prepare("DELETE FROM domains WHERE id=?");
    $sth->execute($id);
    $sth->finish;
}

360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
=head2 domain_info

Returns information of a domain

    my $info = $rvd_front->domain_info( id => $id);
    my $info = $rvd_front->domain_info( name => $name);

=cut

sub domain_info {
    my $self = shift;

    my $domains = $self->list_domains(@_);
    return $domains->[0];
}

=head2 domain_exists

Returns true if the domain name exists

    if ($rvd->domain_exists('domain_name')) {
        ...
    }

=cut

sub domain_exists {
    my $self = shift;
    my $name = shift;

    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT id FROM domains "
392
393
394
395
        ." WHERE name=? "
        ."    AND ( is_volatile = 0 "
        ."          OR is_volatile=1 AND status = 'active' "
        ."         ) "
396
397
398
399
400
401
402
403
    );
    $sth->execute($name);
    my ($id) = $sth->fetchrow;
    $sth->finish;
    return 0 if !defined $id;
    return 1;
}

404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428

=head2 node_exists

Returns true if the node name exists

    if ($rvd->node('node_name')) {
        ...
    }

=cut

sub node_exists {
    my $self = shift;
    my $name = shift;

    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT id FROM vms"
        ." WHERE name=? "
    );
    $sth->execute($name);
    my ($id) = $sth->fetchrow;
    $sth->finish;
    return 0 if !defined $id;
    return 1;
}
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
=head2 list_vm_types

Returns a reference to a list of Virtual Machine Managers known by the system

=cut

sub list_vm_types {
    my $self = shift;

    return $self->{cache}->{vm_types} if $self->{cache}->{vm_types};

    my $result = [@VM_TYPES];

    $self->{cache}->{vm_types} = $result if $result->[0];

    return $result;
}

Francesc Guasch's avatar
Francesc Guasch committed
447
448
449
450
451
452
=head2 list_vms

Returns a list of Virtual Managers

=cut

453
sub list_vms($self, $type=undef) {
Francesc Guasch's avatar
Francesc Guasch committed
454

455
    my $sql = "SELECT id,name,hostname,is_active, vm_type, enabled FROM vms ";
Francesc Guasch's avatar
Francesc Guasch committed
456

457
458
459
460
461
462
    my @args = ();
    if ($type) {
        $sql .= "WHERE (vm_type=? or vm_type=?)";
        my $type2 = $type;
        $type2 = 'qemu' if $type eq 'KVM';
        @args = ( $type, $type2);
Francesc Guasch's avatar
Francesc Guasch committed
463
    }
464
    my $sth = $CONNECTOR->dbh->prepare($sql." ORDER BY vm_type,name");
465
    $sth->execute(@args);
Francesc Guasch's avatar
Francesc Guasch committed
466

Francesc Guasch's avatar
Francesc Guasch committed
467
468
    my @list;
    while (my $row = $sth->fetchrow_hashref) {
469
470
        $row->{bases}= $self->_list_bases_vm($row->{id});
        $row->{machines}= $self->_list_machines_vm($row->{id});
Francesc Guasch's avatar
Francesc Guasch committed
471
        $row->{type} = $row->{vm_type};
472
473
474
        $row->{action_remove} = 'disabled' if length defined $row->{machines}[0] > 0;
        $row->{action_remove} = 'disabled' if $row->{hostname} eq 'localhost';
        $row->{action_remove} = 'disabled' if length defined $row->{bases}[0] > 0;
Francesc Guasch's avatar
Francesc Guasch committed
475
        delete $row->{vm_type};
Francesc Guasch's avatar
Francesc Guasch committed
476
477
478
479
        lock_hash(%$row);
        push @list,($row);
    }
    $sth->finish;
480
    return @list;
Francesc Guasch's avatar
Francesc Guasch committed
481
482
}

483
sub _list_bases_vm($self, $id_node) {
Francesc Guasch's avatar
Francesc Guasch committed
484
485
486
487
488
    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT d.id FROM domains d,bases_vm bv"
        ." WHERE d.is_base=1"
        ."  AND d.id = bv.id_domain "
        ."  AND bv.id_vm=?"
489
        ."  AND bv.enabled=1"
Francesc Guasch's avatar
Francesc Guasch committed
490
    );
491
492
    my @bases;
    $sth->execute($id_node);
Francesc Guasch's avatar
Francesc Guasch committed
493
    while ( my ($id_domain) = $sth->fetchrow ) {
494
        push @bases,($id_domain);
Francesc Guasch's avatar
Francesc Guasch committed
495
496
    }
    $sth->finish;
497
    return \@bases;
Francesc Guasch's avatar
Francesc Guasch committed
498
499
}

500
501
502
503
504
505
506
507
508
509
510
511
512
513
sub _list_machines_vm($self, $id_node) {
    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT d.id FROM domains d"
        ." WHERE d.status='active'"
        ."  AND d.id_vm=?"
    );
    my @bases;
    $sth->execute($id_node);
    while ( my ($id_domain) = $sth->fetchrow ) {
        push @bases,($id_domain);
    }
    $sth->finish;
    return \@bases;
}
514
515
516
517
518
519
520
521
=head2 list_iso_images

Returns a reference to a list of the ISO images known by the system

=cut

sub list_iso_images {
    my $self = shift;
522
523
524
    my $vm_name = shift;

    my $vm;
525
526
527
528
529
530
531
532

    my @iso;
    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT * FROM iso_images ORDER BY name"
    );
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        push @iso,($row);
533

534
        delete $row->{device} if $row->{device} && !-e $row->{device};
535
536
        next if $row->{device};

537
        my ($file);
538
        ($file) = $row->{url} =~ m{.*/(.*)}   if $row->{url};
539
540
541
542
543
        my $file_re = $row->{file_re};
        next if !$file_re && !$file || !$vm_name;

        $vm = $self->search_vm($vm_name)    if !$vm;

544
        next if $row->{device};
545
        if ($file) {
Francesc Guasch's avatar
Francesc Guasch committed
546
            my $iso_file = $vm->search_volume_path($file);
547
548
549
550
            if ($iso_file) {
                $row->{device} = $iso_file;
                next;
            }
551
        }
552
        if ($file_re) {
Francesc Guasch's avatar
Francesc Guasch committed
553
            my $iso_file = $vm->search_volume_path_re(qr($file_re));
554
555
556
557
            if ($iso_file) {
                $row->{device} = $iso_file;
                next;
            }
558
        }
559
560
561
562
563
    }
    $sth->finish;
    return \@iso;
}

564
=head2 iso_file
joelalju's avatar
joelalju committed
565
566
567
568
569

Returns a reference to a list of the ISOs known by the system

=cut

570
sub iso_file {
joelalju's avatar
joelalju committed
571
572
    my $self = shift;
    my $vm = $self->search_vm('KVM');
JanFontanet's avatar
JanFontanet committed
573
    my @isos = sort { "\L$a" cmp "\L$b" } $vm->search_volume_path_re(qr(.*\.iso$));
574
    #TODO remove path from device
joelalju's avatar
joelalju committed
575
576
577
    return \@isos;
}

578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
=head2 list_lxc_templates

Returns a reference to a list of the LXC templates known by the system

=cut


sub list_lxc_templates {
    my $self = shift;

    my @template;
    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT * FROM lxc_templates ORDER BY name"
    );
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        push @template,($row);
    }
    $sth->finish;
    return \@template;

}

=head2 list_users

Returns a reference to a list of the users

=cut

607
sub list_users($self,$name=undef) {
608
    my $sth = $CONNECTOR->dbh->prepare("SELECT id, name FROM users ");
609
610
611
612
    $sth->execute();
    
    my @users = ();
    while ( my $row = $sth->fetchrow_hashref) {
613
        next if defined $name && $row->{name} !~ /$name/;
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
        push @users, ($row);
    }
    $sth->finish;

    return \@users;
}

=head2 create_domain

Request the creation of a new domain or virtual machine

    # TODO: document the args here
    my $req = $rvd_front->create_domain( ... );

=cut

sub create_domain {
    my $self = shift;
    return Ravada::Request->create_domain(@_);
}

=head2 wait_request

Waits for a request for some seconds.

=head3 Arguments

=over 

=item * request

=item * timeout (optional defaults to $Ravada::Front::TIMEOUT

=back

Returns: the request

=cut

sub wait_request {
    my $self = shift;
    my $req = shift or confess "Missing request";

    my $timeout = ( shift or $TIMEOUT );

    if ( $self->backend ) {
        if ($self->fork ) {
            $self->backend->process_requests();
        } else {
            $self->backend->_process_requests_dont_fork();
        }
    }

    for ( 1 .. $timeout ) {
        last if $req->status eq 'done';
        sleep 1;
    }
    $req->status("timeout")
        if $req->status eq 'working';
    return $req;

}

=head2 ping_backend

Checks if the backend is alive.

Return true if alive, false otherwise.

=cut

sub ping_backend {
    my $self = shift;

    return 1 if $self->_ping_backend_localhost();

    my $req = Ravada::Request->ping_backend();
    $self->wait_request($req, 2);

    return 1 if $req->status() eq 'done';
    return 0;
}

sub _ping_backend_localhost {
    my $self = shift;
    return 1 if -e $PID_FILE_BACKEND;
    # TODO check the process with pid $PID_FILE_BACKEND is really alive
    return;
}

=head2 open_vm

Connects to a Virtual Machine Manager ( or VMM ( or VM )).
Returns a read-only connection to the VM.

joelalju's avatar
joelalju committed
709
710
  my $vm = $front->open_vm('KVM');

711
712
713
714
715
716
717
=cut

sub open_vm {
    my $self = shift;
    my $type = shift or confess "I need vm type";
    my $class = "Ravada::VM::$type";

718
719
720
721
722
723
724
    if (my $vm = $VM{$type}) {
        if (!$vm->ping) {
            $vm->disconnect();
            $vm->connect();
        } else {
            return $vm;
        }
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
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
776
777
778
779
780
781
782
783
784
    }

    my $proto = {};
    bless $proto,$class;

    my $vm = $proto->new(readonly => 1);
    eval { $vm->vm };
    warn $@ if $@;
    return if $@;
    return $vm if $0 =~ /\.t$/;

    $VM{$type} = $vm;
    return $vm;
}

=head2 search_vm

Calls to open_vm

=cut

sub search_vm {
    return open_vm(@_);
}

=head2 search_clone

Search for a clone of a domain owned by an user.

    my $domain_clone = $rvd_front->(id_base => $domain_base->id , id_owner => $user->id);

=head3 arguments

=over

=item id_base : The id of the base domain

=item id_user

=back

Returns the domain

=cut

sub search_clone {
    my $self = shift;
    my %args = @_;
    confess "Missing id_owner " if !$args{id_owner};
    confess "Missing id_base" if !$args{id_base};

    my ($id_base , $id_owner) = ($args{id_base} , $args{id_owner} );

    delete $args{id_base};
    delete $args{id_owner};

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

    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT id,name FROM domains "
785
        ." WHERE id_base=? AND id_owner=? AND (is_base=0 OR is_base=NULL)"
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
    );
    $sth->execute($id_base, $id_owner);

    my ($id_domain, $name) = $sth->fetchrow;
    $sth->finish;

    return if !$id_domain;

    return $self->search_domain($name);

}

=head2 search_domain

Searches a domain by name

    my $domain = $rvd_front->search_domain($name);

Returns a Ravada::Domain object

=cut

sub search_domain {
    my $self = shift;

    my $name = shift;

813
    my $sth = $CONNECTOR->dbh->prepare("SELECT id, vm FROM domains WHERE name=?");
814
    $sth->execute($name);
815
    my ($id, $tipo) = $sth->fetchrow or return;
816

Francesc Guasch's avatar
Francesc Guasch committed
817
    return Ravada::Front::Domain->open($id);
818
819
820
821
822
823
824
825
}

=head2 list_requests

Returns a list of ruquests : ( id , domain_name, status, error )

=cut

826
sub list_requests($self, $id_domain_req=undef, $seconds=60) {
827

Francesc Guasch's avatar
Francesc Guasch committed
828
    my @now = localtime(time-$seconds);
829
830
831
832
833
    $now[4]++;
    for (0 .. 4) {
        $now[$_] = "0".$now[$_] if length($now[$_])<2;
    }
    my $time_recent = ($now[5]+=1900)."-".$now[4]."-".$now[3]
Francesc Guasch's avatar
Francesc Guasch committed
834
        ." ".$now[2].":".$now[1].":".$now[0];
835
    my $sth = $CONNECTOR->dbh->prepare(
836
        "SELECT requests.id, command, args, date_changed, requests.status"
837
838
839
840
841
            ." ,requests.error, id_domain ,domains.name as domain"
            ." ,date_changed "
        ." FROM requests left join domains "
        ."  ON requests.id_domain = domains.id"
        ." WHERE "
842
        ."    requests.status <> 'done' "
Francesc Guasch's avatar
Francesc Guasch committed
843
        ."  OR ( date_changed >= ?) "
844
        ." ORDER BY date_changed "
845
    );
846
    $sth->execute($time_recent);
847
    my @reqs;
848
    my ($id_request, $command, $j_args, $date_changed, $status
849
        , $error, $id_domain, $domain, $date);
850
    $sth->bind_columns(\($id_request, $command, $j_args, $date_changed, $status
851
        , $error, $id_domain, $domain, $date));
852
853

    while ( $sth->fetch) {
Francesc Guasch's avatar
Francesc Guasch committed
854
855
856
857
858
859
860
861
862
863
        my $epoch_date_changed;
        if ($date_changed) {
            my ($y,$m,$d,$hh,$mm,$ss) = $date_changed =~ /(\d{4})-(\d\d)-(\d\d) (\d+):(\d+):(\d+)/;
            if ($y)  {
                $epoch_date_changed = DateTime->new(year => $y, month => $m, day => $d
                    ,hour => $hh, minute => $mm, second => $ss
                    ,time_zone => $LOCAL_TZ
                )->epoch;
            }
        }
864
865
866
867
        next if $command eq 'enforce_limits'
                || $command eq 'refresh_vms'
                || $command eq 'refresh_storage'
                || $command eq 'ping_backend'
868
                || $command eq 'cleanup'
Francesc Guasch's avatar
Francesc Guasch committed
869
                || $command eq 'screenshot'
870
                ;
Francesc Guasch's avatar
Francesc Guasch committed
871
        next if ( $command eq 'force_shutdown'
872
873
                || $command eq 'start'
                || $command eq 'shutdown'
874
                || $command eq 'hibernate'
875
                )
Francesc Guasch's avatar
Francesc Guasch committed
876
877
878
                && time - $epoch_date_changed > 5
                && $status eq 'done'
                && !$error;
879
        next if $id_domain_req && defined $id_domain && $id_domain != $id_domain_req;
880
881
        my $args;
        $args = decode_json($j_args) if $j_args;
882

883
884
885
886
        if (!$domain && $args->{id_domain}) {
            $domain = $args->{id_domain};
        }
        $domain = $args->{name} if !$domain && $args->{name};
887
888
889
890
891

        my $message = ( $self->_last_message($id_request) or $error or '');
        $message =~ s/^$command\s+$status(.*)/$1/i;

        push @reqs,{ id => $id_request,  command => $command, date_changed => $date_changed, status => $status, name => $args->{name}
892
893
            ,domain => $domain
            ,date => $date
894
            ,message => $message
Francesc Guasch's avatar
Francesc Guasch committed
895
            ,error => $error
896
        };
897
898
899
900
901
    }
    $sth->finish;
    return \@reqs;
}

902
903
904
905
sub _last_message {
    my $self = shift;
    my $id_request = shift;
    my $sth = $CONNECTOR->dbh->prepare(
906
        "SELECT subject , message FROM messages WHERE id_request=? ORDER BY date_send DESC,id DESC");
907
908
909
910
911
    $sth->execute($id_request);
    my ($subject, $message) = $sth->fetchrow;

    return '' if !$subject;

912
    $subject = '' if $message && $message =~ /^$subject/;
913
914
915
916
917
    return "$subject ".($message or '');
    $sth->finish;

}

918
919
920
921
922
923
924
925
926
927
=head2 search_domain_by_id

  my $domain = $ravada->search_domain_by_id($id);

=cut

sub search_domain_by_id {
    my $self = shift;
      my $id = shift;

928
    my $sth = $CONNECTOR->dbh->prepare("SELECT name, id, id_base, is_base FROM domains WHERE id=?");
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
    $sth->execute($id);

    my $row = $sth->fetchrow_hashref;

    return if !keys %$row;

    lock_hash(%$row);

    return $self->search_domain($row->{name});
}

=head2 start_domain

Request to start a domain.

=head3 arguments

=over

=item user => $user : a Ravada::Auth::SQL user

=item name => $name : the domain name

=item remote_ip => $remote_ip: a Ravada::Auth::SQL user

954
=back
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992

Returns an object: Ravada::Request.

    my $req = $rvd_front->start_domain(
               user => $user
              ,name => 'mydomain'
        , remote_ip => '192.168.1.1');

=cut

sub start_domain {
    my $self = shift;
    confess "ERROR: Must call start_domain with user=>\$user, name => \$name, remote_ip => \$ip"
        if scalar @_ % 2;

    my %args = @_;

    # TODO check for user argument
    $args{uid} = $args{user}->id    if $args{user};
    delete $args{user};

    return Ravada::Request->start_domain( %args );
}

=head2 list_bases_anonymous

List the available bases for anonymous user in a remote IP

    my $list = $rvd_front->list_bases_anonymous($remote_ip);

=cut

sub list_bases_anonymous {
    my $self = shift;
    my $ip = shift or confess "Missing remote IP";

    my $net = Ravada::Network->new(address => $ip);

993
    my $sth = $CONNECTOR->dbh->prepare("SELECT id, name, id_base, is_public FROM domains where is_base=1 AND is_public=1");
994
995
996
997
998
999
1000
    $sth->execute();
    
    my @bases = ();
    while ( my $row = $sth->fetchrow_hashref) {
        next if !$net->allowed_anonymous($row->{id});
        push @bases, ($row);
    }
For faster browsing, not all history is shown. View entire blame