Domain.pm 124 KB
Newer Older
1
2
3
4
5
package Ravada::Domain;

use warnings;
use strict;

6
7
8
9
10
11
=head1 NAME

Ravada::Domain - Domains ( Virtual Machines ) library for Ravada

=cut

12
13
use Carp qw(carp confess croak cluck);
use Data::Dumper;
Francesc Guasch's avatar
Francesc Guasch committed
14
use File::Copy qw(copy move);
15
use File::Rsync;
16
use Hash::Util qw(lock_hash unlock_hash);
17
18
19
use Image::Magick;
use JSON::XS;
use Moose::Role;
20
use NetAddr::IP;
21
use IPC::Run3 qw(run3);
22
use Time::Piece;
23

24
25
26
no warnings "experimental::signatures";
use feature qw(signatures);

27
28
29
30
31
32
33
34
35
use Ravada::Domain::Driver;
use Ravada::Utils;

our $TIMEOUT_SHUTDOWN = 20;
our $CONNECTOR;

our $MIN_FREE_MEMORY = 1024*1024;
our $IPTABLES_CHAIN = 'RAVADA';

36
37
our %PROPAGATE_FIELD = map { $_ => 1} qw( run_timeout );

Francesc Guasch's avatar
Francesc Guasch committed
38
our $TIME_CACHE_NETSTAT = 60; # seconds to cache netstat data output
39

40
41
42
43
_init_connector();

requires 'name';
requires 'remove';
Francesc Guasch's avatar
Francesc Guasch committed
44
requires 'display_info';
45
46

requires 'is_active';
47
requires 'is_hibernated';
48
requires 'is_paused';
49
50
requires 'is_removed';

51
52
53
54
55
56
57
58
59
60
requires 'start';
requires 'shutdown';
requires 'shutdown_now';
requires 'force_shutdown';
requires '_do_force_shutdown';

requires 'pause';
requires 'resume';

requires 'rename';
Francesc Guasch's avatar
Francesc Guasch committed
61
requires 'dettach';
62
63
64

#storage
requires 'add_volume';
Francesc Guasch's avatar
Francesc Guasch committed
65
requires 'remove_volume';
66
requires 'list_volumes';
Francesc Guasch's avatar
Francesc Guasch committed
67
requires 'list_volumes_info';
68
69
70
71
72
73
74
75
76
77

requires 'disk_device';

requires 'disk_size';

#hardware info

requires 'get_info';
requires 'set_memory';
requires 'set_max_mem';
78

79
requires 'autostart';
80
requires 'hybernate';
81
requires 'hibernate';
82

83
84
#remote methods
requires 'migrate';
85

Francesc Guasch's avatar
Francesc Guasch committed
86
requires 'get_driver';
Francesc Guasch's avatar
Francesc Guasch committed
87
88
89
90
requires 'get_controller_by_name';
requires 'list_controllers';
requires 'set_controller';
requires 'remove_controller';
Francesc Guasch's avatar
Francesc Guasch committed
91
requires 'change_hardware';
Francesc Guasch's avatar
Francesc Guasch committed
92
#
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
##########################################################

has 'domain' => (
    isa => 'Any'
    ,is => 'rw'
);

has 'timeout_shutdown' => (
    isa => 'Int'
    ,is => 'ro'
    ,default => $TIMEOUT_SHUTDOWN
);

has 'readonly' => (
    isa => 'Int'
    ,is => 'ro'
    ,default => 0
);

has 'storage' => (
113
    is => 'ro'
114
115
116
117
118
    ,isa => 'Object'
    ,required => 0
);

has '_vm' => (
Francesc Guasch's avatar
Francesc Guasch committed
119
    is => 'rw',
120
    ,isa => 'Object'
121
    ,required => 0
122
123
);

124
125
126
127
128
129
130
has 'description' => (
    is => 'rw'
    ,isa => 'Str'
    ,required => 0
    ,trigger => \&_update_description
);

131
132
133
134
135
136
137
138
139
##################################################################################3
#


##################################################################################3
#
# Method Modifiers
#

Francesc Guasch's avatar
Francesc Guasch committed
140
141
around 'display_info' => \&_around_display_info;
around 'display_file_tls' => \&_around_display_file_tls;
142

143
around 'add_volume' => \&_around_add_volume;
Francesc Guasch's avatar
Francesc Guasch committed
144
145
around 'remove_volume' => \&_around_remove_volume;
around 'list_volumes_info' => \&_around_list_volumes_info;
146

147
148
149
150
before 'remove' => \&_pre_remove_domain;
#\&_allow_remove;
 after 'remove' => \&_after_remove_domain;

151
152
153
around 'prepare_base' => \&_around_prepare_base;
#before 'prepare_base' => \&_pre_prepare_base;
# after 'prepare_base' => \&_post_prepare_base;
154

155
156
157
#before 'start' => \&_start_preconditions;
# after 'start' => \&_post_start;
around 'start' => \&_around_start;
158

Francesc Guasch's avatar
Francesc Guasch committed
159
before 'pause' => \&_allow_shutdown;
160
161
 after 'pause' => \&_post_pause;

Francesc Guasch's avatar
Francesc Guasch committed
162
before 'hybernate' => \&_allow_shutdown;
163
 after 'hybernate' => \&_post_hibernate;
164

Francesc Guasch's avatar
Francesc Guasch committed
165
before 'hibernate' => \&_allow_shutdown;
166
167
 after 'hibernate' => \&_post_hibernate;

168
169
170
before 'resume' => \&_allow_manage;
 after 'resume' => \&_post_resume;

171
before 'shutdown' => \&_pre_shutdown;
172
after 'shutdown' => \&_post_shutdown;
173

174
175
around 'shutdown_now' => \&_around_shutdown_now;
around 'force_shutdown' => \&_around_shutdown_now;
176

177
before 'remove_base' => \&_pre_remove_base;
178
after 'remove_base' => \&_post_remove_base;
Francesc Guasch's avatar
Francesc Guasch committed
179
after 'spinoff' => \&_post_spinoff;
180
181
182
183

before 'rename' => \&_pre_rename;
after 'rename' => \&_post_rename;

Francesc Guasch's avatar
Francesc Guasch committed
184
185
after 'dettach' => \&_post_dettach;

186
187
before 'clone' => \&_pre_clone;

188
after 'screenshot' => \&_post_screenshot;
Francesc Guasch's avatar
Francesc Guasch committed
189
190
191

after '_select_domain_db' => \&_post_select_domain_db;

192
before 'migrate' => \&_pre_migrate;
Francesc Guasch's avatar
Francesc Guasch committed
193
after 'migrate' => \&_post_migrate;
194

Francesc Guasch's avatar
Francesc Guasch committed
195
around 'get_info' => \&_around_get_info;
Francesc Guasch's avatar
Francesc Guasch committed
196
197
around 'set_max_mem' => \&_around_set_max_mem;
around 'set_memory' => \&_around_set_memory;
Francesc Guasch's avatar
Francesc Guasch committed
198

Francesc Guasch's avatar
Francesc Guasch committed
199
around 'is_active' => \&_around_is_active;
Francesc Guasch's avatar
Francesc Guasch committed
200

201
around 'is_hibernated' => \&_around_is_hibernated;
202

203
around 'autostart' => \&_around_autostart;
Francesc Guasch's avatar
Francesc Guasch committed
204

Francesc Guasch's avatar
Francesc Guasch committed
205
206
207
208
before 'set_controller' => \&_pre_change_hardware;
before 'remove_controller' => \&_pre_change_hardware;
before 'change_hardware' => \&_pre_change_hardware;

Francesc Guasch's avatar
Francesc Guasch committed
209
210
211
after 'set_controller' => \&_post_change_hardware;
after 'remove_controller' => \&_post_change_hardware;
after 'change_hardware' => \&_post_change_hardware;
Francesc Guasch's avatar
Francesc Guasch committed
212

213
214
around 'name' => \&_around_name;

215
##################################################
216
217
218
219
#

sub BUILD {
    my $self = shift;
220
221
    my $args = shift;

Francesc Guasch's avatar
Francesc Guasch committed
222
223
224
225
    my $name;
    $name = $args->{name}               if exists $args->{name};

    $self->{_name} = $name  if $name;
226

227
    $self->_init_connector();
Francesc Guasch's avatar
Francesc Guasch committed
228

229
    $self->is_known();
230
231
232
}

sub _check_clean_shutdown($self) {
233
    return if !$self->is_known || $self->readonly || $self->is_volatile;
234
235
236

    if (( $self->_data('status') eq 'active' && !$self->is_active )
        || $self->_active_iptables(id_domain => $self->id)) {
237
            $self->_post_shutdown();
238
    }
Francesc Guasch's avatar
Francesc Guasch committed
239
240
241
242
243
}

sub _set_last_vm($self,$force=0) {
    my $id_vm;
    $id_vm = $self->_data('id_vm')  if $self->is_known();
Francesc Guasch's avatar
Francesc Guasch committed
244
245
246
247
248
249
250
251
252
253
254
255
256
257
    return $self->_set_vm($id_vm, $force)   if $id_vm;
}

sub _set_vm($self, $vm, $force=0) {
    if (!ref($vm)) {
        $vm = Ravada::VM->open($vm);
    }

    my $domain;
    eval { $domain = $vm->search_domain($self->name) };
    die $@ if $@ && $@ !~ /no domain with matching name/;
    if ($domain && ($force || $domain->is_active)) {
       $self->_vm($vm);
       $self->domain($domain->domain);
258
        $self->_update_id_vm();
Francesc Guasch's avatar
Francesc Guasch committed
259
    }
Francesc Guasch's avatar
Francesc Guasch committed
260
261
    return $vm->id;

262
}
263

Francesc Guasch's avatar
Francesc Guasch committed
264
265
sub _check_equal_storage_pools($self, $vm2) {
    my $vm1 = $self->_vm;
266
    my @sp;
267
    push @sp,($vm1->default_storage_pool_name)  if $vm1->default_storage_pool_name;
268
269
270
271
    push @sp,($vm1->base_storage_pool)  if $vm1->base_storage_pool;
    push @sp,($vm1->clone_storage_pool) if $vm1->clone_storage_pool;

    my %sp1 = map { $_ => 1 } @sp;
Francesc Guasch's avatar
Francesc Guasch committed
272
273
274
275
276
277
278
279
280

    my @sp1 = grep /./,keys %sp1;

    my %sp2 = map { $_ => 1 } $vm2->list_storage_pools();

    for my $pool ( @sp1 ) {
        next if $sp2{ $pool };
        die "Error: Storage pool '$pool' not found on node ".$vm2->name."\n"
            .Dumper([keys %sp2]);
281
282
283
284
    }
    return 1;
}

285
286
287
288
289
290
291
292
293
294
sub _vm_connect {
    my $self = shift;
    $self->_vm->connect();
}

sub _vm_disconnect {
    my $self = shift;
    $self->_vm->disconnect();
}

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
sub _around_start($orig, $self, @arg) {
    $self->_start_preconditions(@arg);

    my %arg;
    if (!(scalar(@arg) % 2) ) {
        %arg = @arg;
    } else {
        $arg{user} = $arg[0];
    }

    my $listen_ip = delete $arg{listen_ip};
    my $remote_ip = $arg{remote_ip};

    if (!defined $listen_ip) {
        my $display_ip;
        if ($remote_ip) {
            my $set_password = 0;
            my $network = Ravada::Network->new(address => $remote_ip);
            $set_password = 1 if $network->requires_password();
            $display_ip = $self->_listen_ip($remote_ip);
            $arg{set_password} = $set_password;
        } else {
            $display_ip = $self->_listen_ip();
        }
        $arg{listen_ip} = $display_ip;
    }
    my $ret = $self->$orig(%arg);

    $self->_post_start(%arg);

}

327
328
329
sub _start_preconditions{
    my ($self) = @_;

330
    die "Domain ".$self->name." is a base. Bases can't get started.\n"
331
332
        if $self->is_base();

Francesc Guasch's avatar
Francesc Guasch committed
333
    my $request;
334
    my $id_vm;
335
    if (scalar @_ %2 ) {
336
337
        my @args = @_;
        shift @args;
Francesc Guasch's avatar
Francesc Guasch committed
338
        my %args = @args;
339
340
        my $user = delete $args{user};
        my $remote_ip = delete $args{remote_ip};
Francesc Guasch's avatar
Francesc Guasch committed
341
        $request = delete $args{request} if exists $args{request};
342
343
        $id_vm = delete $args{id_vm};

344
345
        confess "ERROR: Unknown argument ".join("," , sort keys %args)
            ."\n\tknown: remote_ip, user"   if keys %args;
346
347
348
349
        _allow_manage_args(@_);
    } else {
        _allow_manage(@_);
    }
Francesc Guasch's avatar
Francesc Guasch committed
350
    #_check_used_memory(@_);
351

352
353
    return if $self->_search_already_started('fast');
    $self->status('starting');
354
    # if it is a clone ( it is not a base )
355
    if ($self->id_base) {
Francesc Guasch's avatar
Francesc Guasch committed
356
#        $self->_set_last_vm(1)
357
        if ( !$self->is_local && ( !$self->_vm->enabled || !$self->_vm->ping) ) {
358
359
360
            my $vm_local = $self->_vm->new( host => 'localhost' );
            $self->_set_vm($vm_local, 1);
        }
361
362
363
364
365
366
367
368
369
370
371
372
373
374
        my $vm;
        if ($id_vm) {
            $vm = Ravada::VM->open($id_vm);
            if ( !$vm->is_alive ) {
                $vm->disconnect();
                $vm->connect;
            }
        };
        warn $@ if $@;
        if ($vm) {
            $self->_set_vm($vm);
        } else {
            $self->_balance_vm();
        }
375
        $self->rsync(request => $request)  if !$self->is_volatile && !$self->_vm->is_local();
376
377
378
    } elsif (!$self->is_local) {
        my $vm_local = $self->_vm->new( host => 'localhost' );
        $self->_set_vm($vm_local, 1);
379
    }
Francesc Guasch's avatar
Francesc Guasch committed
380
    $self->status('starting');
381
382
383
    $self->_check_free_vm_memory();
    #TODO: remove them and make it more general now we have nodes
    #$self->_check_cpu_usage($request);
384
385
}

386
387
388
389
sub _search_already_started($self, $fast = 0) {
    my $sql = "SELECT id FROM vms where vm_type=?";
    $sql .= " AND is_active=1" if $fast;
    my $sth = $$CONNECTOR->dbh->prepare($sql);
390
391
392
393
    $sth->execute($self->_vm->type);
    my %started;
    while (my ($id) = $sth->fetchrow) {
        my $vm = Ravada::VM->open($id);
Francesc Guasch's avatar
Francesc Guasch committed
394
395
396
397
398
399
400
401
402
403
404
405
406
        next if !$vm->is_enabled;

        my $vm_active;
        eval {
            $vm_active = $vm->is_active;
        };
        my $error = $@;
        if ($error) {
            warn $error;
            $vm->enabled(0) if !$vm->is_local;
            next;
        }
        next if !$vm_active;
407

408
409
410
411
        my $domain;
        eval { $domain = $vm->search_domain($self->name) };
        if ( $@ ) {
            warn $@;
Francesc Guasch's avatar
Francesc Guasch committed
412
            $vm->enabled(0) if !$vm->is_local;
413
414
            next;
        }
415
416
417
418
        next if !$domain;
        if ( $domain->is_active || $domain->is_hibernated ) {
            $self->_set_vm($vm,'force');
            $started{$vm->id}++;
419
420
421
422

            my $status = 'shutdown';
            $status = 'active'  if $domain->is_active;
            $domain->_data(status => $status);
423
        }
424
    }
425
426
427
428
429
430
    if (keys %started > 1) {
        for my $id_vm (sort keys %started) {
            Ravada::Request->shutdown_domain(
                id_domain => $self->id
                , uid => $self->id_owner
                , id_vm => $id_vm
431
                ,timeout => $TIMEOUT_SHUTDOWN
432
433
434
            );
        }
    }
435
    return keys %started;
436
437
438
439
440
}

sub _balance_vm($self) {
    return if $self->{_migrated};

441
442
    my $base;
    $base = Ravada::Domain->open($self->id_base) if $self->id_base;
443

444
445
    my $vm_free = $self->_vm->balance_vm($base);
    return if !$vm_free;
446

447
448
    $self->migrate($vm_free) if $vm_free->id != $self->_vm->id;
    return $vm_free->id;
449
450
}

451
452
sub _update_description {
    my $self = shift;
fv3rdugo's avatar
fv3rdugo committed
453

454
455
456
457
    return if defined $self->description
        && defined $self->_data('description')
        && $self->description eq $self->_data('description');

458
459
    my $sth = $$CONNECTOR->dbh->prepare(
        "UPDATE domains SET description=? "
460
461
        ." WHERE id=? ");
    $sth->execute($self->description,$self->id);
462
    $sth->finish;
463
    $self->{_data}->{description} = $self->{description};
464
}
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490

sub _allow_manage_args {
    my $self = shift;

    confess "Disabled from read only connection"
        if $self->readonly;

    my %args = @_;

    confess "Missing user arg ".Dumper(\%args)
        if !$args{user} ;

    $self->_allowed($args{user});

}
sub _allow_manage {
    my $self = shift;

    return $self->_allow_manage_args(@_)
        if scalar(@_) % 2 == 0;

    my ($user) = @_;
    return $self->_allow_manage_args( user => $user);

}

491
492
493
sub _allow_remove($self, $user) {

    confess "ERROR: Undefined user" if !defined $user;
494

Francesc Guasch's avatar
Francesc Guasch committed
495
496
    return if !$self->is_known(); # already removed

497
    die "ERROR: remove not allowed for user ".$user->name
Francesc Guasch's avatar
Francesc Guasch committed
498
        unless $user->can_remove_machine($self);
499

500
    $self->_check_has_clones() if $self->is_known();
501
502
    if ( $self->is_known
        && $self->id_base
Francesc Guasch's avatar
Francesc Guasch committed
503
        && ($user->can_remove_clones() || $user->can_remove_clone_all())
504
    ) {
505
        my $base = $self->open(id => $self->id_base, id_vm => $self->_vm->id);
joelalju's avatar
joelalju committed
506
        return if ($user->can_remove_clone_all() || ($base->id_owner == $user->id));
507
    }
508
509
510

}

511
512
sub _allow_shutdown {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
513
    my %args;
514

Francesc Guasch's avatar
Francesc Guasch committed
515
516
    if (scalar @_ == 1 ) {
        $args{user} = shift;
517
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
518
        %args = @_;
519
    }
520
521
522
    my $user = $args{user} || confess "ERROR: Missing user arg";

    if ( $self->id_base() && $user->can_shutdown_clone()) {
523
524
        my $base = Ravada::Domain->open($self->id_base)
            or confess "ERROR: Base domain id: ".$self->id_base." not found";
525
        return if $base->id_owner == $user->id;
526
527
    } elsif($user->can_shutdown_all) {
        return;
528
    }
Francesc Guasch's avatar
Francesc Guasch committed
529
530
    confess "User ".$user->name." [".$user->id."] not allowed to shutdown ".$self->name
        ." owned by ".($self->id_owner or '<UNDEF>')
Francesc Guasch's avatar
Francesc Guasch committed
531
            if !$user->can_shutdown($self->id);
532
533
}

534
535
536
sub _around_add_volume {
    my $orig = shift;
    my $self = shift;
537
538
    confess "ERROR in args ".Dumper(\@_)
        if scalar @_ % 2;
539
540
    my %args = @_;

541
    my $file = ($args{file} or $args{path});
Francesc Guasch's avatar
Francesc Guasch committed
542
    confess if $args{id_iso} && !$file;
Francesc Guasch's avatar
Francesc Guasch committed
543
    my $name = $args{name};
544
545
546
547
548
549
    $args{target} = $self->_new_target_dev() if !exists $args{target};

    if (!$name) {
        ($name) = $file =~ m{.*/(.*)} if !$name && $file;
        $name = $self->name if !$name;

Francesc Guasch's avatar
Francesc Guasch committed
550
        $name .= "-".$args{target}."-".Ravada::Utils::random_name(4);
551
552
553
        $args{name} = $name;
    }

Francesc Guasch's avatar
Francesc Guasch committed
554
555
    $args{size} = delete $args{capacity} if exists $args{capacity} && !exists $args{size};
    my $size = $args{size};
556
557
    if ( $file ) {
        $self->_check_volume_added($file);
558
    }
Francesc Guasch's avatar
Francesc Guasch committed
559
560
561
562
    $args{size} = Ravada::Utils::size_to_number($size) if defined $size;
    $args{allocation} = Ravada::Utils::size_to_number($args{allocation})
        if exists $args{allocation} && defined $args{allocation};

Francesc Guasch's avatar
Francesc Guasch committed
563
564
565
    my $free = $self->_vm->free_disk();
    my $free_out = int($free / 1024 / 1024 / 1024 ) * 1024 *1024 *1024;

Francesc Guasch's avatar
Francesc Guasch committed
566
    confess "Error creating volume, out of space $size . Disk free: "
Francesc Guasch's avatar
Francesc Guasch committed
567
568
569
570
            .Ravada::Utils::number_to_size($free_out)
            ."\n"
        if exists $args{size} && $args{size} >= $free;

571
572
573
574
575
576
577
    if ($name) {
        confess "Error: volume $name already exists"
            if grep {$_->info->{name} eq $name} $self->list_volumes_info;
    }
    confess "Error: target $args{target} already exists"
            if grep {$_->info->{target} eq $args{target} } $self->list_volumes_info;

Francesc Guasch's avatar
Francesc Guasch committed
578
579
580
581
582
583
584
    my $ok = $self->$orig(%args);
    confess "Error adding ".Dumper(\%args) if !$ok;

    return $ok;
}

sub _check_volume_added($self, $file) {
585
586
    return if $file =~ /\.iso$/i;

Francesc Guasch's avatar
Francesc Guasch committed
587
588
589
590
591
592
593
594
595
    my $sth = $$CONNECTOR->dbh->prepare("SELECT id,id_domain FROM volumes "
        ." WHERE file=?"
    );
    $sth->execute($file);
    my ($id, $id_domain) = $sth->fetchrow();
    $sth->finish;

    return if !$id;

Francesc Guasch's avatar
Francesc Guasch committed
596
    confess "Volume $file already in domain id $id_domain, this is ".$self->id;
Francesc Guasch's avatar
Francesc Guasch committed
597
598
599
600
601
602
603
604
605
}

sub _around_remove_volume {
    my $orig = shift;
    my $self = shift;
    my ($file) = @_;

    my $ok = $self->$orig(@_);

Francesc Guasch's avatar
Francesc Guasch committed
606
607
    return $ok if !$self->is_local;

Francesc Guasch's avatar
Francesc Guasch committed
608
609
610
611
612
613
614
615
    my $sth = $$CONNECTOR->dbh->prepare(
        "DELETE FROM volumes "
        ." WHERE id_domain=? AND file=?"
    );
    $sth->execute($self->id, $file);
    return $ok;
}

Francesc Guasch's avatar
Francesc Guasch committed
616
617
618
sub _around_list_volumes_info($orig, $self, $attribute=undef, $value=undef) {
    confess "Error: value must be supplied for filter attribute"
    if defined $attribute && !defined $value;
Francesc Guasch's avatar
Francesc Guasch committed
619

Francesc Guasch's avatar
Francesc Guasch committed
620
    return $self->$orig($attribute, $value) if ref($self) =~ /^Ravada::Front/i;
Francesc Guasch's avatar
Francesc Guasch committed
621

622
623
    my @volumes = $self->$orig($attribute => $value);

Francesc Guasch's avatar
Francesc Guasch committed
624
    return @volumes;
625
626
}

627
628
629
630
631
632
633
634
635
636
637
638
sub _around_prepare_base($orig, $self, @args) {
    #sub _around_prepare_base($orig, $self, $user, $request = undef) {
    my ($user, $request, $with_cd);
    if(ref($args[0]) =~/^Ravada::/) {
        ($user, $request) = @args;
    } else {
        my %args = @args;
        $user = delete $args{user};
        $request = delete $args{request};
        $with_cd = delete $args{with_cd};
        confess "Error: uknown args". Dumper(\%args) if keys %args;
    }
639
640
    $self->_pre_prepare_base($user, $request);

Francesc Guasch's avatar
Francesc Guasch committed
641
642
643
644
    if (!$self->is_local) {
        my $vm_local = $self->_vm->new( host => 'localhost' );
        $self->_vm($vm_local);
    }
645
    my @base_img = $self->$orig($with_cd);
646
647
648
649
650
651
652
653
654

    die "Error: No information files returned from prepare_base"
        if !scalar (\@base_img);

    $self->_prepare_base_db(@base_img);

    $self->_post_prepare_base($user, $request);
}

655
sub prepare_base($self, $with_cd) {
656
    my @base_img;
657
    for my $volume ($self->list_volumes_info()) {
Francesc Guasch's avatar
Francesc Guasch committed
658
        my $base_file = $volume->base_filename;
659
        next if !$base_file || $base_file =~ /\.iso$/;
Francesc Guasch's avatar
Francesc Guasch committed
660
661
662
        die "Error: file '$base_file' already exists" if $self->_vm->file_exists($base_file);
    }

663
664
665
    for my $volume ($self->list_volumes_info()) {
        next if !$volume->info->{target} && $volume->info->{device} eq 'cdrom';
        next if $volume->info->{device} eq 'cdrom' && !$with_cd;
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
        confess "Undefined info->target ".Dumper($volume)
            if !$volume->info->{target};

        my $base = $volume->prepare_base();
        push @base_img,([$base, $volume->info->{target}]);
    }
    $self->post_prepare_base();
    return @base_img;
}

=head2 post_prepare_base

Placeholder for optional method implemented in subclasses. This will
run after preparing the base files.

=cut

sub post_prepare_base($self) {}

685
sub _pre_prepare_base($self, $user, $request = undef ) {
686
687
688

    $self->_allowed($user);

689
690
691
692
693
694
695
    my $owner = Ravada::Auth::SQL->search_by_id($self->id_owner);
    confess "User ".$user->name." [".$user->id."] not allowed to prepare base ".$self->domain
        ." owned by ".($owner->name or '<UNDEF>')."\n"
            unless $user->is_admin || (
                $self->id_owner == $user->id && $user->can_create_base());


696
697
    # TODO: if disk is not base and disks have not been modified, do not generate them
    # again, just re-attach them 
Francesc Guasch's avatar
Francesc Guasch committed
698
#    $self->_check_disk_modified(
699
    confess "ERROR: domain ".$self->name." is already a base" if $self->is_base();
700
701
702
    $self->_check_has_clones();

    $self->is_base(0);
703
    $self->_post_remove_base();
704
705
706
707
708
709
710
711
712
713
714
715
716
717
    if ($self->is_active) {
        $self->shutdown(user => $user);
        for ( 1 .. $TIMEOUT_SHUTDOWN ) {
            last if !$self->is_active;
            sleep 1;
        }
        if ($self->is_active ) {
            $request->status('working'
                    ,"Domain ".$self->name." still active, forcing hard shutdown")
                if $request;
            $self->force_shutdown($user);
            sleep 1;
        }
    }
718
719
720
721
    if (!$self->is_local) {
        my $vm_local = Ravada::VM->open( type => $self->vm );
        $self->migrate($vm_local);
    }
Francesc Guasch's avatar
Francesc Guasch committed
722
723
724
    if ($self->id_base ) {
        $self->spinoff();
    }
Francesc Guasch's avatar
Francesc Guasch committed
725
726
727
728
729
730
731
732
    $self->_check_free_space_prepare_base();
}

sub _check_free_space_prepare_base($self) {
    my $pool_base = $self->_vm->default_storage_pool_name;
    $pool_base = $self->_vm->base_storage_pool()   if $self->_vm->base_storage_pool();

    for my $volume ($self->list_volumes_info(device => 'disk')) {;
733
        $self->_vm->_check_free_disk($volume->capacity * 2, $pool_base);
Francesc Guasch's avatar
Francesc Guasch committed
734
    }
735
736
737
738
739
740
741
742
743
};

sub _post_prepare_base {
    my $self = shift;

    my ($user) = @_;

    $self->is_base(1);

Francesc Guasch's avatar
Francesc Guasch committed
744
745
746
747
748
    if ($self->id_base && !$self->description()) {
        my $base = Ravada::Domain->open($self->id_base);
        $self->description($base->description)  if $base->description();
    }

749
    $self->_remove_id_base();
Francesc Guasch's avatar
Francesc Guasch committed
750
    $self->_set_base_vm_db($self->_vm->id,1);
751
    $self->autostart(0,$user);
752
753
};

Francesc Guasch's avatar
Francesc Guasch committed
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
=pod

=head2 spinoff

Makes volumes indpendent from base

=cut

sub spinoff {
    my $self = shift;

    $self->_do_force_shutdown() if $self->is_active;
    confess "Error: spinoff from remote nodes not available. Node: ".$self->_vm->name
        if !$self->is_local;

    for my $volume ($self->list_volumes_info ) {
        next if !$volume->file || $volume->file =~ /\.iso$/i;
        my $bf;
        eval { $bf = $volume->backing_file };
        die $@ if $@ && $@ !~ /No backing file/;
        next if !$bf;
        $volume->spinoff;
    }
}


780
781
782
783
sub _around_autostart($orig, $self, @arg) {
    my ($value, $user) = @arg;
    $self->_allowed($user) if defined $value;
    confess "ERROR: Autostart can't be activated on base ".$self->name
784
        if $value && $self->is_base;
785
786
787
788
789
790
791
792
793
794
795

    confess "ERROR: You can't set autostart on readonly domains"
        if defined $value && $self->readonly;
    my $autostart = 0;
    my @orig_args = ();
    push @orig_args, ( $value) if defined $value;
    if ( $self->$orig(@orig_args) ) {
        $autostart = 1;
    }
    $self->_data(autostart => $autostart)   if defined $value;
    return $autostart;
796
}
797

798
799
800
801
802
803
804
805
806
sub _check_has_clones {
    my $self = shift;
    return if !$self->is_known();

    my @clones = $self->clones;
    die "Domain ".$self->name." has ".scalar @clones." clones : ".Dumper(\@clones)
        if $#clones>=0;
}

807
sub _check_free_vm_memory {
808
809
    my $self = shift;

810
    return if !$self->_vm->min_free_memory;
Francesc Guasch's avatar
Francesc Guasch committed
811
    my $vm_free_mem = $self->_vm->free_memory;
812

Francesc Guasch's avatar
Francesc Guasch committed
813
    return if $vm_free_mem > $self->_vm->min_free_memory;
814

Francesc Guasch's avatar
Francesc Guasch committed
815
    my $msg = "Error: No free memory. Only "._gb($vm_free_mem)." out of "
816
        ._gb($self->_vm->min_free_memory)." GB required.\n";
817

Francesc Guasch's avatar
Francesc Guasch committed
818
819
    die $msg;
}
820

Francesc Guasch's avatar
Francesc Guasch committed
821
sub _check_cpu_usage($self, $request=undef){
822

Francesc Guasch's avatar
Francesc Guasch committed
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
    return if ref($self) =~ /Void/i;
    if ($self->_vm->active_limit){
        chomp(my $cpu_count = `grep -c -P '^processor\\s+:' /proc/cpuinfo`);
        die "Error: Too many active domains." if (scalar $self->_vm->vm->list_domains() >= $self->_vm->active_limit);
    }
    
    my @cpu;
    my $msg;
    for ( 1 .. 10 ) {
        open( my $stat ,'<','/proc/loadavg') or die "WTF: $!";
        @cpu = split /\s+/, <$stat>;
        close $stat;

        if ( $cpu[0] < $self->_vm->max_load ) {
            $request->error('') if $request;
            return;
        }
        $msg = "Error: CPU Too loaded. ".($cpu[0])." out of "
        	.$self->_vm->max_load." max specified.";
        $request->error($msg)   if $request;
        die "$msg\n" if $cpu[0] > $self->_vm->max_load +1;
        sleep 1;
845
    }
Francesc Guasch's avatar
Francesc Guasch committed
846
    die "$msg\n";
847
848
849
850
851
852
853
}

sub _gb($mem=0) {
    my $gb = $mem / 1024 / 1024 ;

    $gb =~ s/(\d+\.\d).*/$1/;
    return ($gb);
854
855
856

}

Francesc Guasch's avatar
Francesc Guasch committed
857
858
=pod

859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
sub _check_disk_modified {
    my $self = shift;

    if ( !$self->is_base() ) {
        return;
    }

    my $last_stat_base = 0;
    for my $file_base ( $self->list_files_base ) {
        my @stat_base = stat($file_base);
        $last_stat_base = $stat_base[9] if$stat_base[9] > $last_stat_base;
#        warn $last_stat_base;
    }

    my $files_updated = 0;
    for my $file ( $self->disk_device ) {
        my @stat = stat($file) or next;
        $files_updated++ if $stat[9] > $last_stat_base;
#        warn "\ncheck\t$file ".$stat[9]."\n vs \tfile_base $last_stat_base $files_updated\n";
    }
    die "Base already created and no disk images updated"
        if !$files_updated;
}

Francesc Guasch's avatar
Francesc Guasch committed
883
884
=cut

885
886
887
888
889
890
891
892
893
894
895
896
897
898
sub _allowed {
    my $self = shift;

    my ($user) = @_;

    confess "Missing user"  if !defined $user;
    confess "ERROR: User '$user' not class user , it is ".(ref($user) or 'SCALAR')
        if !ref $user || ref($user) !~ /Ravada::Auth/;

    return if $user->is_admin;
    my $id_owner;
    eval { $id_owner = $self->id_owner };
    my $err = $@;

Francesc Guasch's avatar
Francesc Guasch committed
899
    confess "User ".$user->name." [".$user->id."] not allowed to access ".$self->name
Francesc Guasch's avatar
Francesc Guasch committed
900
        ." owned by ".($id_owner or '<UNDEF>')
901
902
903
904
905
            if (defined $id_owner && $id_owner != $user->id );

    confess $err if $err;

}
Francesc Guasch's avatar
Francesc Guasch committed
906

Francesc Guasch's avatar
Francesc Guasch committed
907
sub _around_display_info($orig,$self,$user ) {
Francesc Guasch's avatar
Francesc Guasch committed
908
909
    $self->_allowed($user);
    my $display = $self->$orig($user);
910

Francesc Guasch's avatar
Francesc Guasch committed
911
    if (!$self->readonly) {
912
        $self->_set_display_ip($display);
913
        $self->_data(display => encode_json($display)) if $self->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
914
    }
Francesc Guasch's avatar
Francesc Guasch committed
915
916
    return $display;
}
Francesc Guasch's avatar
Francesc Guasch committed
917

918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
sub _set_display_ip($self, $display) {

    my $new_ip = ( $self->_vm->nat_ip
            or $self->_vm->public_ip
            or Ravada::display_ip()
    );
    unlock_hash(%$display);
    $display->{listen_ip} = $display->{ip};

    if ( $new_ip ) {
        $display->{ip} = $new_ip;
        $display->{display} =~ s{(\w+)://(.*?):(.*)}{$1://$new_ip:$3};
    }

    lock_hash(%$display);
}

Francesc Guasch's avatar
Francesc Guasch committed
935
936
sub _around_get_info($orig, $self) {
    my $info = $self->$orig();
937
    if (ref($self) =~ /^Ravada::Domain/ && $self->is_known()) {
938
        $info->{ip} = $self->ip() if $self->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
939
940
941
942
943
        $self->_data(info => encode_json($info));
    }
    return $info;
}

Francesc Guasch's avatar
Francesc Guasch committed
944
sub _around_set_memory($orig, $self, $value) {
Francesc Guasch's avatar
Francesc Guasch committed
945
946
    my $ret = $self->$orig($value);
    if ($self->is_known) {
Francesc Guasch's avatar
Francesc Guasch committed
947
948
949
        my $info;
        eval { $info = decode_json($self->_data('info')) if $self->_data('info')};
        warn $@ if $@ && $@ !~ /malformed JSON/i;
Francesc Guasch's avatar
Francesc Guasch committed
950
        $info->{memory} = $value;
Francesc Guasch's avatar
Francesc Guasch committed
951
952
953
954
955
956
957
958
959
960
961
962
        $self->_data(info => encode_json($info));
    }
    return $ret;
}

sub _around_set_max_mem($orig, $self, $value) {
    my $ret = $self->$orig($value);
    if ($self->is_known) {
        my $info;
        eval { $info = decode_json($self->_data('info')) if $self->_data('info')};
        warn $@ if $@ && $@ !~ /malformed JSON/i;
        $info->{max_mem} = $value;
Francesc Guasch's avatar
Francesc Guasch committed
963
964
965
966
967
        $self->_data(info => encode_json($info))
    }
    return $ret;
}

968
969
970
971
972
973
974
975
976
977
978
979
980
981
##################################################################################3

sub _init_connector {
    return if $CONNECTOR && $$CONNECTOR;
    $CONNECTOR = \$Ravada::CONNECTOR if $Ravada::CONNECTOR;
    $CONNECTOR = \$Ravada::Front::CONNECTOR if !defined $$CONNECTOR
                                                && defined $Ravada::Front::CONNECTOR;
}

=head2 id
Returns the id of  the domain
    my $id = $domain->id();
=cut

Francesc Guasch's avatar
Francesc Guasch committed
982
983
984
985
986
sub id($self) {
    return $self->{_id} if exists $self->{_id};
    my $id = $_[0]->_data('id');
    $self->{_id} = $id;
    return $id;
987
988
989
990
991
}


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

Francesc Guasch's avatar
Francesc Guasch committed
992
993
994
995
996
997
998
999
1000
sub _execute_request($self, $field, $value) {
    my %req = (
        pools => 'manage_pools'
        ,pool_start => 'manage_pools'
        ,pool_clones => 'manage_pools'
    );
    my $exec = $req{$field} or return;

    Ravada::Request->_new_request(
For faster browsing, not all history is shown. View entire blame