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

use strict;
use warnings;

Francesc Guasch's avatar
Francesc Guasch committed
6
use Hash::Util qw(lock_hash);
7
use JSON::XS;
8
9
use Moose;
use Ravada;
10
use Ravada::Network;
11

12
13
use Data::Dumper;

14
15
16
17
18
19
20
21
has 'config' => (
    is => 'ro'
    ,isa => 'Str'
    ,default => $Ravada::FILE_CONFIG
);
has 'connector' => (
        is => 'rw'
);
22
23
24
25
26
has 'backend' => (
    is => 'ro',
    isa => 'Ravada'

);
27

28
29
30
31
32
has 'fork' => (
    is => 'rw'
    ,isa => 'Int'
    ,default => 1
);
33

Francesc Guasch's avatar
Francesc Guasch committed
34
our $CONNECTOR;# = \$Ravada::CONNECTOR;
35
our $TIMEOUT = 5;
fv3rdugo's avatar
fv3rdugo committed
36
our @VM_TYPES = ('KVM','LXC');
37
38
39
40
41
42
43
44
45

=head2 BUILD

Internal constructor

=cut

sub BUILD {
    my $self = shift;
46
    if ($self->connector) {
Francesc Guasch's avatar
Francesc Guasch committed
47
        $CONNECTOR = $self->connector;
48
49
50
51
    } else {
        Ravada::_init_config($self->config());
        $CONNECTOR = Ravada::_connect_dbh();
    }
52
53
}

Francesc Guasch's avatar
Francesc Guasch committed
54
55
56
57
58
59
60
61
=head2 list_bases

Returns a list of the base domains as a listref

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

=cut

62
63
sub list_bases {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
64
    my $sth = $CONNECTOR->dbh->prepare("SELECT * FROM domains where is_base='y'");
65
66
67
68
69
70
71
72
73
74
75
    $sth->execute();
    
    my @bases = ();
    while ( my $row = $sth->fetchrow_hashref) {
        push @bases, ($row);
    }
    $sth->finish;

    return \@bases;
}

Francesc Guasch's avatar
Francesc Guasch committed
76
77
78
79
80
81
82
83
=head2 list_domains

Returns a list of the domains as a listref

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

=cut

84
85
sub list_domains {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
86
    my $sth = $CONNECTOR->dbh->prepare("SELECT * FROM domains ");
87
88
89
90
    $sth->execute();
    
    my @domains = ();
    while ( my $row = $sth->fetchrow_hashref) {
91
92
93
        my $domain ;
        eval { $domain   = $self->search_domain($row->{name}) };
        $row->{is_active} = 1 if $domain && $domain->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
94
        $row->{is_locked} = 1 if $domain && $domain->is_locked;
joansp's avatar
joansp committed
95
        $row->{is_paused} = 1 if $domain && $domain->is_paused;
96
97
98
99
100
        push @domains, ($row);
    }
    $sth->finish;

    return \@domains;
101
102
}

Francesc Guasch's avatar
Francesc Guasch committed
103
104
105
106
107
108
=head2 list_vm_types

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

=cut

109
110
sub list_vm_types {
    my $self = shift;
111

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

Francesc Guasch's avatar
Francesc Guasch committed
114
    my $result = [@VM_TYPES];
115

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

    return $result;
119
120
}

Francesc Guasch's avatar
Francesc Guasch committed
121
122
123
124
125
126
=head2 list_iso_images

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

=cut

127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
sub list_iso_images {
    my $self = shift;

    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);
    }
    $sth->finish;
    return \@iso;
}

Francesc Guasch's avatar
Francesc Guasch committed
142
143
144
145
146
147
148
=head2 list_lxc_templates

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

=cut


Francesc Guasch's avatar
Francesc Guasch committed
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
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;

}

Francesc Guasch's avatar
Francesc Guasch committed
165
166
167
168
169
170
=head2 list_users

Returns a reference to a list of the users

=cut

Laura Figuerola's avatar
Laura Figuerola committed
171
172
173
174
175
176
177
178
179
180
181
182
183
184
sub list_users {
    my $self = shift;
    my $sth = $CONNECTOR->dbh->prepare("SELECT * FROM users ");
    $sth->execute();
    
    my @users = ();
    while ( my $row = $sth->fetchrow_hashref) {
        push @users, ($row);
    }
    $sth->finish;

    return \@users;
}

Francesc Guasch's avatar
Francesc Guasch committed
185
186
=head2 create_domain

Francesc Guasch's avatar
Francesc Guasch committed
187
Request the creation of a new domain or virtual machine
Francesc Guasch's avatar
Francesc Guasch committed
188
189
190
191
192
193

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

=cut

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

Francesc Guasch's avatar
Francesc Guasch committed
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
=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

Francesc Guasch's avatar
Francesc Guasch committed
217
sub wait_request {
218
    my $self = shift;
219
    my $req = shift or confess "Missing request";
220

221
222
    my $timeout = ( shift or $TIMEOUT );

223
224
225
226
227
228
229
    if ( $self->backend ) {
        if ($self->fork ) {
            $self->backend->process_requests();
        } else {
            $self->backend->_process_requests_dont_fork();
        }
    }
230

231
    for ( 1 .. $timeout ) {
232
233
234
235
236
237
238
239
240
        last if $req->status eq 'done';
        sleep 1;
    }
    $req->status("timeout")
        if $req->status eq 'working';
    return $req;

}

Francesc Guasch's avatar
Francesc Guasch committed
241
242
243
244
245
246
247
248
=head2 ping_backend

Checks if the backend is alive.

Return true if alive, false otherwise.

=cut

249
250
sub ping_backend {
    my $self = shift;
251

252
    my $req = Ravada::Request->ping_backend();
Francesc Guasch's avatar
Francesc Guasch committed
253
    $self->wait_request($req, 2);
254

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

Francesc Guasch's avatar
Francesc Guasch committed
259
260
261
262
263
264
265
=head2 open_vm

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

=cut

266
267
268
269
270
271
272
273
274
275
276
sub open_vm {
    my $self = shift;
    my $type = shift or confess "I need vm type";
    my $class = "Ravada::VM::$type";

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

    return $proto->new(readonly => 1);
}

277
278
279
280
=head2 search_clone

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

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

283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
=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;
299
300
301
302
303
304
305
306
307
308
    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;
309
310

    my $sth = $CONNECTOR->dbh->prepare(
311
        "SELECT id,name FROM domains "
312
313
        ." WHERE id_base=? AND id_owner=? "
    );
314
    $sth->execute($id_base, $id_owner);
315
316
317
318
319

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

    return if !$id_domain;
320

321
322
323
324
    return $self->search_domain($name);

}

Francesc Guasch's avatar
Francesc Guasch committed
325
326
327
328
329
330
331
332
333
334
=head2 search_domain

Searches a domain by name

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

Returns a Ravada::Domain object

=cut

Francesc Guasch's avatar
Francesc Guasch committed
335
336
337
338
339
340
341
342
343
344
345
346
sub search_domain {
    my $self = shift;

    my $name = shift;

    my $sth = $CONNECTOR->dbh->prepare("SELECT * FROM domains WHERE name=?");
    $sth->execute($name);

    my $row = $sth->fetchrow_hashref;

    return if !keys %$row;

347
348
349
350
351
    my $vm_name = $row->{vm} or confess "Unknown vm for domain $name";

    my $vm = $self->open_vm($vm_name);
    my $domain = $vm->search_domain($name);

Francesc Guasch's avatar
Francesc Guasch committed
352
    return $domain;
Francesc Guasch's avatar
Francesc Guasch committed
353
}
Francesc Guasch's avatar
Francesc Guasch committed
354
355
356
357
358
359
360
361
362
363
364

=head2 list_requests

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

=cut

sub list_requests {
    my $self = shift;
    my $sth = $CONNECTOR->dbh->prepare("SELECT id, command, args, date_changed, status, error "
        ." FROM requests "
joansp's avatar
joansp committed
365
        ." WHERE command NOT IN (SELECT command FROM requests WHERE command = 'list_vm_types')"
Francesc Guasch's avatar
Francesc Guasch committed
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
        ." ORDER BY date_changed DESC LIMIT 4"
    );
    $sth->execute;
    my @reqs;
    my ($id, $command, $j_args, $date_changed, $status, $error);
    $sth->bind_columns(\($id, $command, $j_args, $date_changed, $status, $error));

    while ( $sth->fetch) {
        my $args = decode_json($j_args) if $j_args;

        push @reqs,{ id => $id,  command => $command, date_changed => $date_changed, status => $status, error => $error , name => $args->{name}};
    }
    $sth->finish;
    return \@reqs;
}

382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
=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;

    my $sth = $CONNECTOR->dbh->prepare("SELECT * FROM domains WHERE id=?");
    $sth->execute($id);

    my $row = $sth->fetchrow_hashref;

    return if !keys %$row;

    lock_hash(%$row);
400

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

Francesc Guasch's avatar
Francesc Guasch committed
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
=head2 start_domain

Request to start a domain.

=head3 arguments

=over

=item $name : the domain name

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


Returns an object: Ravada::Request.

    my $req = $rvd_front->start_domain($name, $user);

=cut
422

423
424
425
sub start_domain {
    my $self = shift;
    my $name = shift;
426
    my $user = shift;
427

428
    return Ravada::Request->start_domain(name => $name, uid => $user->id);
429
}
430

431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
=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);

    my $sth = $CONNECTOR->dbh->prepare("SELECT * FROM domains where is_base=1");
    $sth->execute();
    
    my @bases = ();
    while ( my $row = $sth->fetchrow_hashref) {
        next if !$net->allowed_anonymous($row->{id});
        push @bases, ($row);
    }
    $sth->finish;

    return \@bases;

}

459
1;