Ravada.pm 10.8 KB
Newer Older
1
2
3
4
5
package Ravada;

use warnings;
use strict;

6
use Data::Dumper;
7
use DBIx::Connector;
Francesc Guasch's avatar
Francesc Guasch committed
8
use JSON::XS;
9
10
11
use Moose;
use YAML;

12
use Ravada::Request;
13
use Ravada::VM::KVM;
14
use Ravada::VM::LXC;
15

Francesc Guasch's avatar
Francesc Guasch committed
16
17
18
19
20
21
22
23
24
25
26
27
=head1 NAME

Ravada - Remove Virtual Desktop Manager

=head1 SYNOPSIS

  use Ravada;

  my $ravada = Ravada->new()

=cut

28
29
30
31
32
33
34

our $FILE_CONFIG = "/etc/ravada.conf";

###########################################################################

our $CONNECTOR;
our $CONFIG = {};
35
36
our $DEBUG;

37
38
39
40
41
42
43
44
45
46


has 'vm' => (
          is => 'ro'
        ,isa => 'ArrayRef'
       ,lazy => 1
     , builder => '_create_vm'
);

has 'connector' => (
47
48
49
50
51
52
        is => 'rw'
);

has 'config' => (
    is => 'ro'
    ,isa => 'Str'
53
54
);

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

Internal constructor

=cut


62
63
sub BUILD {
    my $self = shift;
64
    if ($self->config()) {
65
        _init_config($self->config);
66
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
67
        _init_config($FILE_CONFIG) if -e $FILE_CONFIG;
68
    }
69

Francesc Guasch's avatar
Francesc Guasch committed
70
71
72
73
    if ( $self->connector ) {
        $CONNECTOR = $self->connector 
    } else {
        $CONNECTOR = $self->_connect_dbh();
74
        $self->connector($CONNECTOR);
Francesc Guasch's avatar
Francesc Guasch committed
75
    }
76

77
78
79
80
81
82
}

sub _connect_dbh {
    my $driver= ($CONFIG->{db}->{driver} or 'mysql');;
    my $db_user = ($CONFIG->{db}->{user} or getpwnam($>));;
    my $db_pass = ($CONFIG->{db}->{password} or undef);
Francesc Guasch's avatar
Francesc Guasch committed
83
84
    my $db = ( $CONFIG->{db}->{db} or 'ravada' );
    return DBIx::Connector->new("DBI:$driver:$db"
85
86
87
88
89
90
91
92
93
94
95
                        ,$db_user,$db_pass,{RaiseError => 1
                        , PrintError=> 0 });

}

sub _init_config {
    my $file = shift;
    $CONFIG = YAML::LoadFile($file);
    _connect_dbh();
}

96
sub _create_vm_kvm {
97
    my $self = shift;
98

99
100
101
102
    my $cmd_qemu_img = `which qemu-img`;
    chomp $cmd_qemu_img;

    return(undef,"ERROR: Missing qemu-img") if !$cmd_qemu_img;
103
104

    my $vm_kvm;
105

106
107
    eval { $vm_kvm = Ravada::VM::KVM->new( connector => ( $self->connector or $CONNECTOR )) };
    my $err_kvm = $@;
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

    my ($internal_vm , $storage);
    eval {
        $internal_vm = $vm_kvm->vm;
        $internal_vm->list_all_domains();

        $storage = $vm_kvm->dir_img();
    };
    $vm_kvm = undef if $@ || !$internal_vm || !$storage;
    return ($vm_kvm,$@);
}

sub _create_vm {
    my $self = shift;

    my @vms = ();

    my ($vm_kvm, $err_kvm) = $self->_create_vm_kvm();

127
128
129
130
131
132
133
134
135
136
137
138
    push @vms,($vm_kvm) if $vm_kvm;

    my $vm_lxc;
    eval { $vm_lxc = Ravada::VM::LXC->new( connector => ( $self->connector or $CONNECTOR )) };
    push @vms,($vm_lxc) if $vm_lxc;
    my $err_lxc = $@;

    if (!@vms) {
        die "No VMs found: $err_lxc\n$err_kvm\n";
    }
    return \@vms;

139
140
}

Francesc Guasch's avatar
Francesc Guasch committed
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
=head2 create_domain

Creates a new domain based on an ISO image or another domain.

  my $domain = $ravada->create_domain( 
         name => $name
    , id_iso => 1
  );


  my $domain = $ravada->create_domain( 
         name => $name
    , id_base => 3
  );


=cut


160
sub create_domain {
161
162
    my $self = shift;

163
164
165
166
167
168
    my %args = @_;

    my $backend = $args{backend};
    delete $args{backend};

    my $vm = $self->vm->[0];
Francesc Guasch's avatar
Francesc Guasch committed
169
    $vm = $self->search_vm($backend)   if $backend;
170
171

    return $vm->create_domain(@_);
172
173
}

Francesc Guasch's avatar
Francesc Guasch committed
174
175
176
177
178
179
180
181
=head2 remove_domain

Removes a domain

  $ravada->remove_domain($name);

=cut

182
183
184
185
sub remove_domain {
    my $self = shift;
    my $name = shift or confess "Missing domain name";

186
    my $domain = $self->search_domain($name, 1)
187
188
189
190
        or confess "ERROR: I can't find domain $name";
    $domain->remove();
}

Francesc Guasch's avatar
Francesc Guasch committed
191
192
193
194
195
196
=head2 search_domain

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

=cut

197
198
199
sub search_domain {
    my $self = shift;
    my $name = shift;
200
    my $import = shift;
201
202

    for my $vm (@{$self->vm}) {
Francesc Guasch's avatar
Francesc Guasch committed
203
        my $domain = $vm->search_domain($name, $import);
204
205
        next if !$domain;
        warn "found domain $name";
206
207
208
        my $id;
        eval { $id = $domain->id };
        # TODO import the domain in the database with an _insert_db or something
209
        warn $@ if $@;
210
        return $domain if $id || $import;
211
    }
212
    return;
213
}
214

Francesc Guasch's avatar
Francesc Guasch committed
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
=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;

    for my $vm (@{$self->vm}) {
        my $domain = $vm->search_domain_by_id($id);
        return $domain if $domain;
    }
}


232
233
=head2 list_domains

Francesc Guasch's avatar
Francesc Guasch committed
234
List all created domains
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250

  my @list = $ravada->list_domains();

=cut

sub list_domains {
    my $self = shift;
    my @domains;
    for my $vm (@{$self->vm}) {
        for my $domain ($vm->list_domains) {
            push @domains,($domain);
        }
    }
    return @domains;
}

251
252
253
254
255
256
257
258
259
260
261
262
263
=head2 list_domains_data

List all domains in raw format. Return a list of id => { name , id , is_active , is_base }

   my $list = $ravada->list_domains_data();

   $c->render(json => $list);

=cut

sub list_domains_data {
    my $self = shift;
    my @domains;
264
    for my $domain ($self->list_domains()) {
265
266
267
        eval { $domain->id };
        warn $@ if $@;
        next if $@;
268
269
270
271
272
        push @domains, {                id => $domain->id 
                                    , name => $domain->name
                                  ,is_base => $domain->is_base
                                ,is_active => $domain->is_active
                               
273
274
                           }
    }
275
    return \@domains;
276
277
278
}


Francesc Guasch's avatar
Francesc Guasch committed
279
280
281
282
283
284
285
286
287
288
289
290
291
292
=head2 list_bases

List all base domains

  my @list = $ravada->list_domains();


=cut

sub list_bases {
    my $self = shift;
    my @domains;
    for my $vm (@{$self->vm}) {
        for my $domain ($vm->list_domains) {
293
294
295
            eval { $domain->id };
            warn $@ if $@;
            next    if $@;
Francesc Guasch's avatar
Francesc Guasch committed
296
297
298
299
300
301
            push @domains,($domain) if $domain->is_base;
        }
    }
    return @domains;
}

302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
=head2 list_bases_data

List information about the bases

=cut

sub list_bases_data {
    my $self = shift;
    my @data;
    for ($self->list_bases ) {
        push @data,{ id => $_->id , name => $_->name };
    }
    return \@data;
}

Francesc Guasch's avatar
Francesc Guasch committed
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
=head2 list_images

List all ISO images

=cut

sub list_images {
    my $self = shift;
    my @domains;
    my $sth = $CONNECTOR->dbh->prepare(
        "SELECT * FROM iso_images ORDER BY name"
    );
    $sth->execute;
    while (my $row = $sth->fetchrow_hashref) {
        push @domains,($row);
    }
    $sth->finish;
    return @domains;
}

337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
=head2 list_images_data

List information about the images

=cut

sub list_images_data {
    my $self = shift;
    my @data;
    for ($self->list_images ) {
        push @data,{ id => $_->{id} , name => $_->{name} };
    }
    return \@data;
}

Francesc Guasch's avatar
Francesc Guasch committed
352

Francesc Guasch's avatar
Francesc Guasch committed
353
354
355
356
=head2 remove_volume

  $ravada->remove_volume($file);

Francesc Guasch's avatar
Francesc Guasch committed
357

Francesc Guasch's avatar
Francesc Guasch committed
358
359
=cut

360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
sub remove_volume {
    my $self = shift;

    my $file = shift;
    my ($name) = $file =~ m{.*/(.*)};

    my $removed = 0;
    for my $vm (@{$self->vm}) {
        my $vol = $vm->search_volume($name);
        next if !$vol;

        $vol->delete();
        $removed++;
    }
    if (!$removed && -e $file ) {
        warn "volume $file not found. removing file $file.\n";
        unlink $file or die "$! $file";
    }

}
380

Francesc Guasch's avatar
Francesc Guasch committed
381
382
383
384
385
386
387
388
=head2 process_requests

This is run in the ravada backend. It processes the commands requested by the fronted

  $ravada->process_requests();

=cut

389
390
391
392
393
394
sub process_requests {
    my $self = shift;

    my $sth = $CONNECTOR->dbh->prepare("SELECT id FROM requests WHERE status='requested'");
    $sth->execute;
    while (my ($id)= $sth->fetchrow) {
Francesc Guasch's avatar
Francesc Guasch committed
395
        my $req = Ravada::Request->open($id);
396
        warn "executing request ".$req." ".Dumper($req) if $DEBUG;
Francesc Guasch's avatar
Francesc Guasch committed
397
        $self->_execute($req);
398
        warn $req->status() if $DEBUG;
399
400
401
402
    }
    $sth->finish;
}

Francesc Guasch's avatar
Francesc Guasch committed
403
404
405
406
407
408
409
410
=head2 list_requests

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

=cut

sub list_requests {
    my $self = shift;
joansp's avatar
joansp committed
411
    my $sth = $CONNECTOR->dbh->prepare("SELECT id, command, args, date_changed, status, error "
Francesc Guasch's avatar
Francesc Guasch committed
412
        ." FROM requests "
joansp's avatar
joansp committed
413
        ." ORDER BY date_changed DESC LIMIT 4"
Francesc Guasch's avatar
Francesc Guasch committed
414
415
416
    );
    $sth->execute;
    my @reqs;
joansp's avatar
joansp committed
417
418
    my ($id, $command, $j_args, $date_changed, $status, $error);
    $sth->bind_columns(\($id, $command, $j_args, $date_changed, $status, $error));
Francesc Guasch's avatar
Francesc Guasch committed
419
420
421
422

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

joansp's avatar
joansp committed
423
        push @reqs,{ id => $id,  command => $command, date_changed => $date_changed, status => $status, error => $error , name => $args->{name}};
Francesc Guasch's avatar
Francesc Guasch committed
424
425
426
427
428
    }
    $sth->finish;
    return \@reqs;
}

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
=head2 list_vm_types

Returnsa list ofthe types of Virtual Machines available on this system

=cut

sub list_vm_types {
    my $self = shift;
    
    my %type;
    for my $vm (@{$self->vm}) {
            my ($name) = ref($vm) =~ /.*::(.*)/;
            $type{$name}++;
    }
    return sort keys %type;
}

446
447
448
449
sub _execute {
    my $self = shift;
    my $request = shift;

Francesc Guasch's avatar
Francesc Guasch committed
450
451
452
453
454
455
456
457
458
459
460
461
462
    my $sub = $self->_req_method($request->command);

    die "Unknown command ".$request->command
        if !$sub;

    return $sub->($self,$request);

}

sub _cmd_create {
    my $self = shift;
    my $request = shift;

463
464
465
466
    $request->status('creating domain');
    my $domain;
    eval {$domain = $self->create_domain(%{$request->args}) };

Francesc Guasch's avatar
Francesc Guasch committed
467
468
469
470
471
472
473
474
475
476
477
478
479
    $request->status('done');
    $request->error($@);

}

sub _cmd_remove {
    my $self = shift;
    my $request = shift;

    $request->status('working');
    eval { $self->remove_domain($request->args('name')) };
    $request->status('done');
    $request->error($@);
Francesc Guasch's avatar
Francesc Guasch committed
480

481
}
Francesc Guasch's avatar
Francesc Guasch committed
482

Francesc Guasch's avatar
Francesc Guasch committed
483
484
485
486
487
488
489
490
491
492
493
sub _cmd_start {
    my $self = shift;
    my $request = shift;

    $request->status('working');
    my $name = $request->args('name');
    eval { 
        my $domain = $self->search_domain($name);
        die "Unknown domain '$name'\n" if !$domain;
        $domain->start();
    };
494

Francesc Guasch's avatar
Francesc Guasch committed
495
496
497
498
499
    $request->status('done');
    $request->error($@);

}

Francesc Guasch's avatar
Francesc Guasch committed
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
sub _cmd_prepare_base {
    my $self = shift;
    my $request = shift;

    $request->status('working');
    my $name = $request->args('name');
    eval { 
        my $domain = $self->search_domain($name);
        die "Unknown domain '$name'\n" if !$domain;
        $domain->prepare_base();
    };
    $request->status('done');
    $request->error($@);

}


Francesc Guasch's avatar
Francesc Guasch committed
517
518
519
520
521
522
523
524
525
526
527
sub _cmd_shutdown {
    my $self = shift;
    my $request = shift;

    $request->status('working');
    my $name = $request->args('name');
    eval { 
        my $domain = $self->search_domain($name);
        die "Unknown domain '$name'\n" if !$domain;
        $domain->shutdown();
    };
528
    sleep(60000);
Francesc Guasch's avatar
Francesc Guasch committed
529
530
531
532
533
534
    $request->status('done');
    $request->error($@);

}


Francesc Guasch's avatar
Francesc Guasch committed
535
536
537
538
539
sub _req_method {
    my $self = shift;
    my  $cmd = shift;

    my %methods = (
Francesc Guasch's avatar
Francesc Guasch committed
540

Francesc Guasch's avatar
Francesc Guasch committed
541
542
543
          start => \&_cmd_start
        ,create => \&_cmd_create
        ,remove => \&_cmd_remove
Francesc Guasch's avatar
Francesc Guasch committed
544
      ,shutdown => \&_cmd_shutdown
Francesc Guasch's avatar
Francesc Guasch committed
545
  ,prepare_base => \&_cmd_prepare_base
Francesc Guasch's avatar
Francesc Guasch committed
546
547
548
549
    );
    return $methods{$cmd};
}

550
551
552
553
554
555
556
557
558
559
560
561
=head2 search_vm

Searches for a VM of a given type

  my $vm = $ravada->search_vm('kvm');

=cut

sub search_vm {
    my $self = shift;
    my $type = shift;

562
563
    confess "Missing VM type"   if !$type;

564
565
566
567
568
569
    my $class = 'Ravada::VM::'.uc($type);
    for my $vm (@{$self->vm}) {
        return $vm if ref($vm) eq $class;
    }
    return;
}
Francesc Guasch's avatar
Francesc Guasch committed
570

Francesc Guasch's avatar
Francesc Guasch committed
571
572
573
574
575
576
577
578
579
580
=head1 AUTHOR

Francesc Guasch-Ortiz	, frankie@telecos.upc.edu

=head1 SEE ALSO

Sys::Virt

=cut

581
1;