Domain.pm 139 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
our %PROPAGATE_FIELD = map { $_ => 1} qw( run_timeout shutdown_disconnected);
37

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

Francesc Guasch's avatar
Francesc Guasch committed
41
42
our $DEBUG_RSYNC = 0;

43
44
45
46
_init_connector();

requires 'name';
requires 'remove';
Francesc Guasch's avatar
Francesc Guasch committed
47
requires 'display_info';
48
49

requires 'is_active';
50
requires 'is_hibernated';
51
requires 'is_paused';
52
53
requires 'is_removed';

54
55
56
57
58
59
60
61
62
63
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
64
requires 'dettach';
65
requires 'set_time';
66
67
68

#storage
requires 'add_volume';
Francesc Guasch's avatar
Francesc Guasch committed
69
requires 'remove_volume';
70
requires 'list_volumes';
Francesc Guasch's avatar
Francesc Guasch committed
71
requires 'list_volumes_info';
72
73
74
75
76
77
78
79
80
81

requires 'disk_device';

requires 'disk_size';

#hardware info

requires 'get_info';
requires 'set_memory';
requires 'set_max_mem';
82

83
requires 'autostart';
84
requires 'hybernate';
85
requires 'hibernate';
86

87
88
#remote methods
requires 'migrate';
89

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

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' => (
117
    is => 'ro'
118
119
120
121
122
    ,isa => 'Object'
    ,required => 0
);

has '_vm' => (
Francesc Guasch's avatar
Francesc Guasch committed
123
    is => 'rw',
124
    ,isa => 'Object'
125
    ,required => 0
126
127
);

128
129
130
131
132
133
134
has 'description' => (
    is => 'rw'
    ,isa => 'Str'
    ,required => 0
    ,trigger => \&_update_description
);

135
136
137
138
139
140
141
142
143
##################################################################################3
#


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

Francesc Guasch's avatar
Francesc Guasch committed
144
145
around 'display_info' => \&_around_display_info;
around 'display_file_tls' => \&_around_display_file_tls;
146

147
around 'add_volume' => \&_around_add_volume;
Francesc Guasch's avatar
Francesc Guasch committed
148
149
around 'remove_volume' => \&_around_remove_volume;
around 'list_volumes_info' => \&_around_list_volumes_info;
150

151
152
153
154
before 'remove' => \&_pre_remove_domain;
#\&_allow_remove;
 after 'remove' => \&_after_remove_domain;

155
156
157
around 'prepare_base' => \&_around_prepare_base;
#before 'prepare_base' => \&_pre_prepare_base;
# after 'prepare_base' => \&_post_prepare_base;
158

159
160
161
#before 'start' => \&_start_preconditions;
# after 'start' => \&_post_start;
around 'start' => \&_around_start;
162

Francesc Guasch's avatar
Francesc Guasch committed
163
before 'pause' => \&_allow_shutdown;
164
165
 after 'pause' => \&_post_pause;

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

Francesc Guasch's avatar
Francesc Guasch committed
169
before 'hibernate' => \&_allow_shutdown;
170
171
 after 'hibernate' => \&_post_hibernate;

172
173
174
before 'resume' => \&_allow_manage;
 after 'resume' => \&_post_resume;

175
before 'shutdown' => \&_pre_shutdown;
176
after 'shutdown' => \&_post_shutdown;
177

178
179
around 'shutdown_now' => \&_around_shutdown_now;
around 'force_shutdown' => \&_around_shutdown_now;
180

181
before 'remove_base' => \&_pre_remove_base;
182
after 'remove_base' => \&_post_remove_base;
Francesc Guasch's avatar
Francesc Guasch committed
183
after 'spinoff' => \&_post_spinoff;
184
185
186
187

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

Francesc Guasch's avatar
Francesc Guasch committed
188
189
after 'dettach' => \&_post_dettach;

190
191
before 'clone' => \&_pre_clone;

192
after 'screenshot' => \&_post_screenshot;
Francesc Guasch's avatar
Francesc Guasch committed
193
194
195

after '_select_domain_db' => \&_post_select_domain_db;

196
before 'migrate' => \&_pre_migrate;
Francesc Guasch's avatar
Francesc Guasch committed
197
after 'migrate' => \&_post_migrate;
198

Francesc Guasch's avatar
Francesc Guasch committed
199
around 'get_info' => \&_around_get_info;
Francesc Guasch's avatar
Francesc Guasch committed
200
201
around 'set_max_mem' => \&_around_set_max_mem;
around 'set_memory' => \&_around_set_memory;
Francesc Guasch's avatar
Francesc Guasch committed
202

Francesc Guasch's avatar
Francesc Guasch committed
203
around 'is_active' => \&_around_is_active;
Francesc Guasch's avatar
Francesc Guasch committed
204

205
around 'is_hibernated' => \&_around_is_hibernated;
206

207
around 'autostart' => \&_around_autostart;
Francesc Guasch's avatar
Francesc Guasch committed
208

Francesc Guasch's avatar
Francesc Guasch committed
209
210
211
212
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
213
214
215
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
216

217
218
around 'name' => \&_around_name;

219
##################################################
220
221
222
223
#

sub BUILD {
    my $self = shift;
224
225
    my $args = shift;

Francesc Guasch's avatar
Francesc Guasch committed
226
227
228
229
    my $name;
    $name = $args->{name}               if exists $args->{name};

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

231
    $self->_init_connector();
Francesc Guasch's avatar
Francesc Guasch committed
232

233
    $self->is_known();
234
235
236
}

sub _check_clean_shutdown($self) {
237
    return if !$self->is_known || $self->readonly || $self->is_volatile;
238
239

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

    if ($self->_data('status') eq 'hibernated' && !$self->_data('post_hibernated')) {
246
        $self->_post_hibernate();
247
    }
Francesc Guasch's avatar
Francesc Guasch committed
248
249
250
251
252
}

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
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    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);
267
        $self->_update_id_vm();
Francesc Guasch's avatar
Francesc Guasch committed
268
    }
Francesc Guasch's avatar
Francesc Guasch committed
269
270
    return $vm->id;

271
}
272

Francesc Guasch's avatar
Francesc Guasch committed
273
274
sub _check_equal_storage_pools($self, $vm2) {
    my $vm1 = $self->_vm;
275
    my @sp;
276
    push @sp,($vm1->default_storage_pool_name)  if $vm1->default_storage_pool_name;
277
278
279
280
    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
281
282
283
284
285
286
287
288
289

    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]);
290
291
292
293
    }
    return 1;
}

294
295
296
297
298
299
300
301
302
303
sub _vm_connect {
    my $self = shift;
    $self->_vm->connect();
}

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

304
sub _around_start($orig, $self, @arg) {
305

Francesc Guasch's avatar
Francesc Guasch committed
306
    $self->_data( 'post_shutdown' => 0);
307
    $self->_data( 'post_hibernated' => 0);
308
309
310
311
312
313
314
315
316
    $self->_start_preconditions(@arg);

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

Francesc Guasch's avatar
Francesc Guasch committed
317
    my $request = delete $arg{request};
318
319
320
    my $listen_ip = delete $arg{listen_ip};
    my $remote_ip = $arg{remote_ip};

321
322
    for (;;) {
        eval { $self->_start_checks(@arg) };
323
        my $error = $@;
324
325
326
327
328
329
330
331
        if ($error) {
            if ( $error =~/base file not found/ && !$self->_vm->is_local) {
                $self->_request_set_base();
                next;
            } elsif ($error =~ /No free memory/) {
                warn $error;
                die $error if $self->is_local;
                my $vm_local = $self->_vm->new( host => 'localhost' );
Francesc Guasch's avatar
Francesc Guasch committed
332
                $self->migrate($vm_local, $request);
333
334
                next;
            }
335
        }
336
        die $error if $error;
337
338
339
340
341
342
343
344
345
346
347
348
349
        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;
        }
350
        $$CONNECTOR->disconnect;
351
        eval { $self->$orig(%arg) };
352
        $error = $@;
353
354
355
        last if !$error;
        warn "WARNING: $error ".$self->_vm->name." ".$self->_vm->enabled if $error;
        if ($error && $self->id_base && !$self->is_local && $self->_vm->enabled) {
356
357
            $self->_request_set_base();
            next;
358
        }
359
        die $@;
360
361
362
363
364
    }
    $self->_post_start(%arg);

}

365
366
367
368
369
370
371
372
373
374
375
376
sub _request_set_base($self) {
    my $base = Ravada::Domain->open($self->id_base);
    $base->_set_base_vm_db($self->_vm->id,0);
    Ravada::Request->set_base_vm(
        uid => Ravada::Utils::user_daemon->id
        ,id_domain => $base->id
        ,id_vm => $self->_vm->id
    );
    my $vm_local = $self->_vm->new( host => 'localhost' );
    $self->_set_vm($vm_local, 1);
}

377
378
379
sub _start_preconditions{
    my ($self) = @_;

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

Francesc Guasch's avatar
Francesc Guasch committed
383
    my $request;
384
    my $id_vm;
385
    if (scalar @_ %2 ) {
386
387
        my @args = @_;
        shift @args;
Francesc Guasch's avatar
Francesc Guasch committed
388
        my %args = @args;
389
390
        my $user = delete $args{user};
        my $remote_ip = delete $args{remote_ip};
Francesc Guasch's avatar
Francesc Guasch committed
391
        $request = delete $args{request} if exists $args{request};
392
393
        $id_vm = delete $args{id_vm};

394
395
        confess "ERROR: Unknown argument ".join("," , sort keys %args)
            ."\n\tknown: remote_ip, user"   if keys %args;
396
397
398
399
        _allow_manage_args(@_);
    } else {
        _allow_manage(@_);
    }
Francesc Guasch's avatar
Francesc Guasch committed
400
    #_check_used_memory(@_);
401
402
    $self->status('starting');
}
403

404
sub _start_checks($self, @args) {
405
    return if $self->_search_already_started('fast');
406
407
408
    my $vm_local = $self->_vm->new( host => 'localhost' );
    my $vm = $vm_local;

409
    my ($id_vm, $request);
Francesc Guasch's avatar
Francesc Guasch committed
410
    if (!(scalar(@args) % 2)) {
411
        my %args = @args;
412
413

        # We may be asked to start the machine in a specific id_vmanager
414
415
416
        $id_vm = delete $args{id_vm};
        $request = delete $args{request} if exists $args{request};
    }
417
418
419
420
421
422
423
424
    # If not specific id_manager we go to the last id_vmanager unless it was localhost
    # If the last VManager was localhost it will try to balance here.
    $id_vm = $self->_data('id_vm')
    if !$id_vm && defined $self->_data('id_vm')
    && $self->_data('id_vm') != $vm_local->id;

    if ($id_vm) {
        $vm = Ravada::VM->open($id_vm);
425
        if ( !$vm->enabled || !$vm->ping ) {
426
427
428
429
            $vm = $vm_local;
            $id_vm = undef;
        }
    }
430

431
    # if it is a clone ( it is not a base )
432
    if ($self->id_base) {
433
        $self->_check_tmp_volumes();
Francesc Guasch's avatar
Francesc Guasch committed
434
#        $self->_set_last_vm(1)
435
436
437
        if ( !$self->is_local
            && ( !$self->_vm->enabled || !base_in_vm($self->id_base,$self->_vm->id)
                || !$self->_vm->ping) ) {
438
439
            $self->_set_vm($vm_local, 1);
        }
440
441
442
443
        if ( !$vm->is_alive ) {
            $vm->disconnect();
            $vm->connect;
            $vm = $vm_local if !$vm->is_local && !$vm->is_alive;
444
        };
445
        if ($id_vm) {
446
447
            $self->_set_vm($vm);
        } else {
Francesc Guasch's avatar
Francesc Guasch committed
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
            $self->_balance_vm($request);
        }
        if ( !$self->is_volatile && !$self->_vm->is_local() ) {
            my $args = {
                uid => Ravada::Utils::user_daemon->id
                ,id_domain => $self->id_base
                ,id_vm => $self->_vm->id
            };

            my $req;
            $req = Ravada::Request->set_base_vm(%$args)
            unless Ravada::Request::_duplicated_request(undef
                ,'set_base_vm', encode_json($args));

            $self->rsync(request => $request);
463
        }
464
    }
465
466
467
    $self->_check_free_vm_memory();
    #TODO: remove them and make it more general now we have nodes
    #$self->_check_cpu_usage($request);
468
469
}

470
471
472
473
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);
474
475
476
477
    $sth->execute($self->_vm->type);
    my %started;
    while (my ($id) = $sth->fetchrow) {
        my $vm = Ravada::VM->open($id);
478
        next if !$vm->enabled;
Francesc Guasch's avatar
Francesc Guasch committed
479
480
481
482
483
484
485
486
487
488
489
490

        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;
491

492
493
494
495
        my $domain;
        eval { $domain = $vm->search_domain($self->name) };
        if ( $@ ) {
            warn $@;
Francesc Guasch's avatar
Francesc Guasch committed
496
            $vm->enabled(0) if !$vm->is_local;
497
498
            next;
        }
499
        next if !$domain;
500
        $vm->_add_instance_db($domain->id);
501
502
503
        if ( $domain->is_active || $domain->is_hibernated ) {
            $self->_set_vm($vm,'force');
            $started{$vm->id}++;
504
505
506
507

            my $status = 'shutdown';
            $status = 'active'  if $domain->is_active;
            $domain->_data(status => $status);
508
        }
509
    }
510
511
512
513
514
515
    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
516
                ,timeout => $TIMEOUT_SHUTDOWN
517
518
519
            );
        }
    }
520
    return keys %started;
521
522
}

Francesc Guasch's avatar
Francesc Guasch committed
523
sub _balance_vm($self, $request=undef) {
524
525
    return if $self->{_migrated};

526
527
    my $base;
    $base = Ravada::Domain->open($self->id_base) if $self->id_base;
528

529
530
531
532
    my $vm_free;
    for (;;) {
        $vm_free = $self->_vm->balance_vm($base);
        return if !$vm_free;
533

534
        last if $vm_free->id == $self->_vm->id;
Francesc Guasch's avatar
Francesc Guasch committed
535
        eval { $self->migrate($vm_free, $request) };
536
537
        last if !$@;
        if ($@ && $@ =~ /file not found/i) {
538
            $base->_set_base_vm_db($vm_free->id,0) unless $vm_free->is_local;
539
540
541
542
543
544
545
546
547
            Ravada::Request->set_base_vm(
                uid => Ravada::Utils::user_daemon->id
                ,id_domain => $base->id
                ,id_vm => $vm_free->id
            );
            next;
        }
        die $@;
    }
548
    return $vm_free->id;
549
550
}

551
552
sub _update_description {
    my $self = shift;
fv3rdugo's avatar
fv3rdugo committed
553

554
555
556
557
    return if defined $self->description
        && defined $self->_data('description')
        && $self->description eq $self->_data('description');

558
559
    my $sth = $$CONNECTOR->dbh->prepare(
        "UPDATE domains SET description=? "
560
561
        ." WHERE id=? ");
    $sth->execute($self->description,$self->id);
562
    $sth->finish;
563
    $self->{_data}->{description} = $self->{description};
564
}
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590

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);

}

591
592
593
sub _allow_remove($self, $user) {

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

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

597
598
    confess "Error: arg user is not Ravada::Auth object" if !ref($user);

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

602
    $self->_check_has_clones() if $self->is_known();
603
604
    if ( $self->is_known
        && $self->id_base
Francesc Guasch's avatar
Francesc Guasch committed
605
        && ($user->can_remove_clones() || $user->can_remove_clone_all())
606
    ) {
607
        my $base = $self->open(id => $self->id_base, id_vm => $self->_vm->id);
joelalju's avatar
joelalju committed
608
        return if ($user->can_remove_clone_all() || ($base->id_owner == $user->id));
609
    }
610
611
612

}

613
614
sub _allow_shutdown {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
615
    my %args;
616

Francesc Guasch's avatar
Francesc Guasch committed
617
618
    if (scalar @_ == 1 ) {
        $args{user} = shift;
619
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
620
        %args = @_;
621
    }
622
623
624
    my $user = $args{user} || confess "ERROR: Missing user arg";

    if ( $self->id_base() && $user->can_shutdown_clone()) {
625
626
        my $base = Ravada::Domain->open($self->id_base)
            or confess "ERROR: Base domain id: ".$self->id_base." not found";
627
        return if $base->id_owner == $user->id;
628
629
    } elsif($user->can_shutdown_all) {
        return;
630
    }
Francesc Guasch's avatar
Francesc Guasch committed
631
632
    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
633
            if !$user->can_shutdown($self->id);
634
635
}

636
637
638
sub _around_add_volume {
    my $orig = shift;
    my $self = shift;
639
640
    confess "ERROR in args ".Dumper(\@_)
        if scalar @_ % 2;
641
642
    my %args = @_;

643
    my $file = ($args{file} or $args{path});
644
    confess if $args{id_iso} && !$file;
Francesc Guasch's avatar
Francesc Guasch committed
645
    my $name = $args{name};
646
647
648
649
650
651
    $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
652
        $name .= "-".$args{target}."-".Ravada::Utils::random_name(4);
653
654
655
        $args{name} = $name;
    }

Francesc Guasch's avatar
Francesc Guasch committed
656
657
    $args{size} = delete $args{capacity} if exists $args{capacity} && !exists $args{size};
    my $size = $args{size};
658
659
    if ( $file ) {
        $self->_check_volume_added($file);
660
    }
Francesc Guasch's avatar
Francesc Guasch committed
661
662
663
664
    $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
665
666
667
    my $free = $self->_vm->free_disk();
    my $free_out = int($free / 1024 / 1024 / 1024 ) * 1024 *1024 *1024;

Francesc Guasch's avatar
Francesc Guasch committed
668
    confess "Error creating volume, out of space $size . Disk free: "
Francesc Guasch's avatar
Francesc Guasch committed
669
670
671
672
            .Ravada::Utils::number_to_size($free_out)
            ."\n"
        if exists $args{size} && $args{size} >= $free;

673
674
675
676
677
678
679
    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
680
681
682
683
684
685
686
    my $ok = $self->$orig(%args);
    confess "Error adding ".Dumper(\%args) if !$ok;

    return $ok;
}

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

Francesc Guasch's avatar
Francesc Guasch committed
689
    my $sth = $$CONNECTOR->dbh->prepare("SELECT id,id_domain FROM volumes "
Francesc Guasch's avatar
Francesc Guasch committed
690
        ." WHERE file=? or name=?"
Francesc Guasch's avatar
Francesc Guasch committed
691
    );
Francesc Guasch's avatar
Francesc Guasch committed
692
    $sth->execute($file,$file);
Francesc Guasch's avatar
Francesc Guasch committed
693
694
695
696
697
    my ($id, $id_domain) = $sth->fetchrow();
    $sth->finish;

    return if !$id;

698
    confess "Volume $file already in domain id $id_domain, this is ".$self->id;
Francesc Guasch's avatar
Francesc Guasch committed
699
700
701
702
703
704
705
706
707
}

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

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

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

Francesc Guasch's avatar
Francesc Guasch committed
710
711
712
713
714
715
716
717
    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
718
719
720
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
721

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

724
725
    my @volumes = $self->$orig($attribute => $value);

Francesc Guasch's avatar
Francesc Guasch committed
726
    return @volumes;
727
728
}

729
730
731
732
733
734
735
736
737
738
739
740
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;
    }
741
742
    $self->_pre_prepare_base($user, $request);

Francesc Guasch's avatar
Francesc Guasch committed
743
744
745
746
    if (!$self->is_local) {
        my $vm_local = $self->_vm->new( host => 'localhost' );
        $self->_vm($vm_local);
    }
747
    $self->pre_prepare_base();
748
    my @base_img = $self->$orig($with_cd);
749
750
751
752
753
754
755
756
757

    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);
}

758
759
760
761
762
763
764
765
766
=head2 pre_prepare_base

Run this before preparing the base. By default does nothing and may
be implemented in the object.

This is executed automatically so it shouldn't been called.

=cut

767
768
sub pre_prepare_base($self) {}

769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
=head2 prepare_base

Prepares the virtual machine as a base:

=over

=item * shuts it down

=item * creates read only volumes based on this base

=item * locks it so it won't get started

=item * stores the virtual machine template for the clones

=cut

785
sub prepare_base($self, $with_cd) {
786
    my @base_img;
787
    for my $volume ($self->list_volumes_info()) {
Francesc Guasch's avatar
Francesc Guasch committed
788
        my $base_file = $volume->base_filename;
789
        next if !$base_file || $base_file =~ /\.iso$/;
790
791
        confess "Error: file '$base_file' already exists in ".$self->_vm->name
            if $self->_vm->file_exists($base_file);
Francesc Guasch's avatar
Francesc Guasch committed
792
793
    }

794
795
796
    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;
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
        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) {}

816
sub _pre_prepare_base($self, $user, $request = undef ) {
817
818
819

    $self->_allowed($user);

820
821
822
823
824
825
826
    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());


827
828
    # 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
829
#    $self->_check_disk_modified(
830
    confess "ERROR: domain ".$self->name." is already a base" if $self->is_base();
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
    $self->_check_has_clones();

    $self->is_base(0);
    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;
        }
    }
848
    $self->_post_remove_base();
849
850
    if (!$self->is_local) {
        my $vm_local = Ravada::VM->open( type => $self->vm );
Francesc Guasch's avatar
Francesc Guasch committed
851
        $self->migrate($vm_local, $request);
852
    }
Francesc Guasch's avatar
Francesc Guasch committed
853
854
855
    if ($self->id_base ) {
        $self->spinoff();
    }
Francesc Guasch's avatar
Francesc Guasch committed
856
857
858
859
860
861
862
863
    $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')) {;
864
        $self->_vm->_check_free_disk($volume->capacity * 2, $pool_base);
Francesc Guasch's avatar
Francesc Guasch committed
865
    }
866
867
868
869
870
871
872
873
874
};

sub _post_prepare_base {
    my $self = shift;

    my ($user) = @_;

    $self->is_base(1);

Francesc Guasch's avatar
Francesc Guasch committed
875
876
877
878
879
    if ($self->id_base && !$self->description()) {
        my $base = Ravada::Domain->open($self->id_base);
        $self->description($base->description)  if $base->description();
    }

880
    $self->_remove_id_base();
Francesc Guasch's avatar
Francesc Guasch committed
881
    $self->_set_base_vm_db($self->_vm->id,1);
882
    $self->autostart(0,$user);
883
884
};

Francesc Guasch's avatar
Francesc Guasch committed
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
=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;
    }
}


911
912
913
914
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
915
        if $value && $self->is_base;
916
917
918
919
920
921

    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;
922
923
924
925
926
927
928
929
930

    # We only set the internal autostart when domain is not in nodes
    if ($self->_domain_in_nodes) {
        if (defined $value) {
            $autostart = $value;
        } else {
            $autostart = $self->_data('autostart');
        }
    } elsif ( $self->$orig(@orig_args) ) {
931
932
933
934
        $autostart = 1;
    }
    $self->_data(autostart => $autostart)   if defined $value;
    return $autostart;
935
}
936

937
938
939
940
941
sub _check_has_clones {
    my $self = shift;
    return if !$self->is_known();

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

946
sub _check_free_vm_memory {
947
948
    my $self = shift;

Francesc Guasch's avatar
Francesc Guasch committed
949
    my $vm_free_mem = $self->_vm->free_memory;
950

951
952
953
954
955
956
    my $domain_memory = $self->info(Ravada::Utils::user_daemon)->{memory};
    my $min_free_memory = ($self->_vm->min_free_memory or $MIN_FREE_MEMORY)+$domain_memory;

    return if $vm_free_mem > $min_free_memory;

    $self->_data(status => 'down');
957

958
    my $msg = "Error: No free memory in ".$self->_vm->name.". Only "._gb($vm_free_mem)." out of "
959
        ._gb($min_free_memory)." GB required.\n";
960

Francesc Guasch's avatar
Francesc Guasch committed
961
962
    die $msg;
}
963

964
965
966
sub _check_tmp_volumes($self) {
    confess "Error: only clones temporary volumes can be checked."
        if !$self->id_base;
967
    my $vm_local = $self->_vm->new( host => 'localhost' );
968
969
    for my $vol ( $self->list_volumes_info) {
        next unless $vol->file && $vol->file =~ /\.(TMP|SWAP)\./;
970
        next if $vm_local->file_exists($vol->file);
Francesc Guasch's avatar
Francesc Guasch committed
971
        $vol->delete();
972
973
974
975
976
977
978
979
980

        my $base = Ravada::Domain->open($self->id_base);
        my @volumes = $base->list_files_base_target;
        my ($file_base) = grep { $_->[1] eq $vol->info->{target} } @volumes;
        if (!$file_base) {
            warn "Error: I can't find base volume for target ".$vol->info->{target}
                .Dumper(\@volumes);
        }
        my $vol_base = Ravada::Volume->new( file => $file_base->[0]
981
            , is_base => 1
982
            , vm => $vm_local
983
984
985
986
987
        );
        $vol_base->clone(file => $vol->file);
    }
}

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

Francesc Guasch's avatar
Francesc Guasch committed
990
991
992
993
994
995
996
997
998
999
1000
    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>;
For faster browsing, not all history is shown. View entire blame