Domain.pm 177 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);

Francesc Guasch's avatar
Francesc Guasch committed
27
use Ravada::Booking;
28
use Ravada::Domain::Driver;
29
use Ravada::Auth::SQL;
30
31
use Ravada::Utils;

32
33
our $TIMEOUT_SHUTDOWN = 120;
our $TIMEOUT_REBOOT = 120;
34
35
36
37
38
our $CONNECTOR;

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

39
our %PROPAGATE_FIELD = map { $_ => 1} qw( run_timeout shutdown_disconnected);
40

Francesc Guasch's avatar
Francesc Guasch committed
41
our $TIME_CACHE_NETSTAT = 60; # seconds to cache netstat data output
42
our $RETRY_SET_TIME=10;
43

Francesc Guasch's avatar
Francesc Guasch committed
44
45
our $DEBUG_RSYNC = 0;

46
47
48
49
_init_connector();

requires 'name';
requires 'remove';
Francesc Guasch's avatar
Francesc Guasch committed
50
requires 'display_info';
51
52

requires 'is_active';
53
requires 'is_hibernated';
54
requires 'is_paused';
55
56
requires 'is_removed';

57
58
59
60
61
requires 'start';
requires 'shutdown';
requires 'shutdown_now';
requires 'force_shutdown';
requires '_do_force_shutdown';
Roberto P. Rubio's avatar
Roberto P. Rubio committed
62
63
requires 'reboot';
requires 'reboot_now';
Roberto P. Rubio's avatar
Roberto P. Rubio committed
64
65
requires 'force_reboot';
requires '_do_force_reboot';
66
67
68
69
70

requires 'pause';
requires 'resume';

requires 'rename';
Francesc Guasch's avatar
Francesc Guasch committed
71
requires 'dettach';
72
requires 'set_time';
73
74
75

#storage
requires 'add_volume';
Francesc Guasch's avatar
Francesc Guasch committed
76
requires 'remove_volume';
77
requires 'list_volumes';
Francesc Guasch's avatar
Francesc Guasch committed
78
requires 'list_volumes_info';
79
80
81
82
83
84
85
86
87
88

requires 'disk_device';

requires 'disk_size';

#hardware info

requires 'get_info';
requires 'set_memory';
requires 'set_max_mem';
89

90
requires 'autostart';
91
requires 'hybernate';
92
requires 'hibernate';
93

94
95
#remote methods
requires 'migrate';
96

Francesc Guasch's avatar
Francesc Guasch committed
97
requires 'get_driver';
Francesc Guasch's avatar
Francesc Guasch committed
98
99
100
101
requires 'get_controller_by_name';
requires 'list_controllers';
requires 'set_controller';
requires 'remove_controller';
Francesc Guasch's avatar
Francesc Guasch committed
102
requires 'change_hardware';
Francesc Guasch's avatar
Francesc Guasch committed
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
);

Roberto P. Rubio's avatar
Roberto P. Rubio committed
117
118
119
120
121
122
has 'timeout_reboot' => (
    isa => 'Int'
    ,is => 'ro'
    ,default => $TIMEOUT_REBOOT
);

123
124
125
126
127
128
129
has 'readonly' => (
    isa => 'Int'
    ,is => 'ro'
    ,default => 0
);

has 'storage' => (
130
    is => 'ro'
131
132
133
134
135
    ,isa => 'Object'
    ,required => 0
);

has '_vm' => (
Francesc Guasch's avatar
Francesc Guasch committed
136
    is => 'rw',
137
    ,isa => 'Object'
138
    ,required => 0
139
140
);

141
142
143
144
145
146
147
has 'description' => (
    is => 'rw'
    ,isa => 'Str'
    ,required => 0
    ,trigger => \&_update_description
);

148
149
150
151
152
153
154
155
156
##################################################################################3
#


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

Francesc Guasch's avatar
Francesc Guasch committed
157
around 'display_info' => \&_around_display_info;
158

159
around 'add_volume' => \&_around_add_volume;
Francesc Guasch's avatar
Francesc Guasch committed
160
161
around 'remove_volume' => \&_around_remove_volume;
around 'list_volumes_info' => \&_around_list_volumes_info;
162

163
164
165
166
before 'remove' => \&_pre_remove_domain;
#\&_allow_remove;
 after 'remove' => \&_after_remove_domain;

167
168
169
around 'prepare_base' => \&_around_prepare_base;
#before 'prepare_base' => \&_pre_prepare_base;
# after 'prepare_base' => \&_post_prepare_base;
170

171
172
173
#before 'start' => \&_start_preconditions;
# after 'start' => \&_post_start;
around 'start' => \&_around_start;
174

Francesc Guasch's avatar
Francesc Guasch committed
175
before 'pause' => \&_allow_shutdown;
176
177
 after 'pause' => \&_post_pause;

Francesc Guasch's avatar
Francesc Guasch committed
178
before 'hybernate' => \&_allow_shutdown;
179
 after 'hybernate' => \&_post_hibernate;
180

Francesc Guasch's avatar
Francesc Guasch committed
181
before 'hibernate' => \&_allow_shutdown;
182
183
 after 'hibernate' => \&_post_hibernate;

184
185
186
before 'resume' => \&_allow_manage;
 after 'resume' => \&_post_resume;

187
before 'shutdown' => \&_pre_shutdown;
188
after 'shutdown' => \&_post_shutdown;
189

190
191
around 'shutdown_now' => \&_around_shutdown_now;
around 'force_shutdown' => \&_around_shutdown_now;
192

Roberto P. Rubio's avatar
Roberto P. Rubio committed
193
194
before 'reboot' => \&_allow_shutdown;
after 'reboot' => \&_post_reboot;
Roberto P. Rubio's avatar
Roberto P. Rubio committed
195
196

around 'reboot_now' => \&_around_reboot_now;
Roberto P. Rubio's avatar
Roberto P. Rubio committed
197
around 'force_reboot' => \&_around_reboot_now;
Roberto P. Rubio's avatar
Roberto P. Rubio committed
198

199
before 'remove_base' => \&_pre_remove_base;
200
after 'remove_base' => \&_post_remove_base;
Francesc Guasch's avatar
Francesc Guasch committed
201
after 'spinoff' => \&_post_spinoff;
202
203
204
205

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

Francesc Guasch's avatar
Francesc Guasch committed
206
207
after 'dettach' => \&_post_dettach;

208
209
before 'clone' => \&_pre_clone;

210
after 'screenshot' => \&_post_screenshot;
Francesc Guasch's avatar
Francesc Guasch committed
211
212
213

after '_select_domain_db' => \&_post_select_domain_db;

214
before 'migrate' => \&_pre_migrate;
Francesc Guasch's avatar
Francesc Guasch committed
215
after 'migrate' => \&_post_migrate;
216

Francesc Guasch's avatar
Francesc Guasch committed
217
around 'get_info' => \&_around_get_info;
Francesc Guasch's avatar
Francesc Guasch committed
218
219
around 'set_max_mem' => \&_around_set_max_mem;
around 'set_memory' => \&_around_set_memory;
Francesc Guasch's avatar
Francesc Guasch committed
220

Francesc Guasch's avatar
Francesc Guasch committed
221
around 'is_active' => \&_around_is_active;
Francesc Guasch's avatar
Francesc Guasch committed
222

223
around 'is_hibernated' => \&_around_is_hibernated;
224

225
around 'autostart' => \&_around_autostart;
Francesc Guasch's avatar
Francesc Guasch committed
226

Francesc Guasch's avatar
Francesc Guasch committed
227
228
around 'set_controller' => \&_around_add_hardware;
around 'remove_controller' => \&_around_remove_hardware;
229
around 'change_hardware' => \&_around_change_hardware;
Francesc Guasch's avatar
Francesc Guasch committed
230

231
232
around 'name' => \&_around_name;

233
##################################################
234
235
236
237
#

sub BUILD {
    my $self = shift;
238
239
    my $args = shift;

Francesc Guasch's avatar
Francesc Guasch committed
240
241
242
243
    my $name;
    $name = $args->{name}               if exists $args->{name};

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

245
    $self->_init_connector();
Francesc Guasch's avatar
Francesc Guasch committed
246

247
    $self->is_known();
248
249
250
}

sub _check_clean_shutdown($self) {
251
    return if !$self->is_known || $self->readonly || $self->is_volatile;
252
253

    if (( $self->_data('status') eq 'active' && !$self->is_active )
Francesc Guasch's avatar
Francesc Guasch committed
254
        || ($self->_data('status') eq 'shutdown' && !$self->_data('post_shutdown'))
255
        || $self->_active_iptables(id_domain => $self->id)) {
256
            $self->_post_shutdown();
257
    }
258
259

    if ($self->_data('status') eq 'hibernated' && !$self->_data('post_hibernated')) {
260
        $self->_post_hibernate();
261
    }
Francesc Guasch's avatar
Francesc Guasch committed
262
263
264
265
266
}

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
267
268
269
270
271
272
273
274
275
276
277
278
279
280
    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);
281
        $self->_update_id_vm();
Francesc Guasch's avatar
Francesc Guasch committed
282
    }
Francesc Guasch's avatar
Francesc Guasch committed
283
284
    return $vm->id;

285
}
286

Francesc Guasch's avatar
Francesc Guasch committed
287
sub _check_equal_storage_pools($self, $vm2) {
288
    return $self->_vm->_check_equal_storage_pools($vm2);
289
290
}

291
292
293
294
295
296
297
298
299
300
sub _vm_connect {
    my $self = shift;
    $self->_vm->connect();
}

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

301
sub _around_start($orig, $self, @arg) {
302

Francesc Guasch's avatar
Francesc Guasch committed
303
304
    $self->_post_hibernate() if $self->is_hibernated && !$self->_data('post_hibernated');

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

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

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

320
321
    for (;;) {
        eval { $self->_start_checks(@arg) };
322
        my $error = $@;
323
324
325
326
327
328
329
330
        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
331
                $self->migrate($vm_local, $request);
332
333
                next;
            }
334
        }
335
        die $error if $error;
336
337
338
        if (!defined $listen_ip) {
            my $display_ip;
            if ($remote_ip) {
Francesc Guasch's avatar
Francesc Guasch committed
339
340
341
342
343
344
345
                if ( Ravada::setting(undef,"/backend/display_password") ) {
                    # We'll see if we set it from the network, defaults to 0 meanwhile
                    my $set_password = 0;
                    my $network = Ravada::Network->new(address => $remote_ip);
                    $set_password = 1 if $network->requires_password();
                    $arg{set_password} = $set_password;
                }
Francesc Guasch's avatar
Francesc Guasch committed
346
                $display_ip = $self->_listen_ip($remote_ip);
347
348
349
350
351
            } else {
                $display_ip = $self->_listen_ip();
            }
            $arg{listen_ip} = $display_ip;
        }
352
        $$CONNECTOR->disconnect;
353
        eval { $self->$orig(%arg) };
354
        $error = $@;
355
356
        last if !$error;
        warn "WARNING: $error ".$self->_vm->name." ".$self->_vm->enabled if $error;
357

Francesc Guasch's avatar
Francesc Guasch committed
358
359
        ;# pool has asynchronous jobs running.
        next if $error && ref($error) && $error->code == 1
360
361
        && $error !~ /internal error.*unexpected address/
        && $error !~ /process exited while connecting to monitor/;
362

363
        if ($error && $self->id_base && !$self->is_local && $self->_vm->enabled) {
364
365
            $self->_request_set_base();
            next;
366
        }
367
        die $error;
368
369
370
371
372
    }
    $self->_post_start(%arg);

}

Francesc Guasch's avatar
Francesc Guasch committed
373
sub _request_set_base($self, $id_vm=$self->_vm->id) {
374
375
376
377
378
    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
Francesc Guasch's avatar
Francesc Guasch committed
379
        ,id_vm => $id_vm
380
381
382
383
384
    );
    my $vm_local = $self->_vm->new( host => 'localhost' );
    $self->_set_vm($vm_local, 1);
}

385
386
387
sub _start_preconditions{
    my ($self) = @_;

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

Francesc Guasch's avatar
Francesc Guasch committed
391
    my $request;
392
    my $id_vm;
Francesc Guasch's avatar
Francesc Guasch committed
393
    my $user;
394
    if (scalar @_ %2 ) {
395
396
        my @args = @_;
        shift @args;
Francesc Guasch's avatar
Francesc Guasch committed
397
        my %args = @args;
Francesc Guasch's avatar
Francesc Guasch committed
398
        $user = delete $args{user};
399
        my $remote_ip = delete $args{remote_ip};
Francesc Guasch's avatar
Francesc Guasch committed
400
        $request = delete $args{request} if exists $args{request};
401
402
        $id_vm = delete $args{id_vm};

403
404
        confess "ERROR: Unknown argument ".join("," , sort keys %args)
            ."\n\tknown: remote_ip, user"   if keys %args;
405
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
406
407
408
409
410
411
412
        ($user) = $_[1];
    }
    $self->_allow_manage($user);
    if ( Ravada->setting('/backend/bookings') && !$self->allowed_booking( $user ) ) {
        my @bookings = Ravada::Booking::bookings(date => DateTime->now()->ymd
            ,time => DateTime->now()->hms);
        confess "Error: resource booked ".Dumper(\@bookings);
413
    }
Francesc Guasch's avatar
Francesc Guasch committed
414
    #_check_used_memory(@_);
415
416
    $self->status('starting');
}
417

Francesc Guasch's avatar
Francesc Guasch committed
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
=head2 allowed_booking

Returns true if an user is allowed in a booking for this virtual machine
or its base. Returns false otherwise.

   $machine->allowed_booking($user);

=cut


sub allowed_booking($self, $user) {
    my $id_base = $self->id;
    if (!$self->is_base) {
        $id_base = $self->_data('id_base') or return 1;
    }
    return Ravada::Booking::user_allowed($user, $id_base);
}

436
sub _start_checks($self, @args) {
437
    return if $self->_search_already_started('fast');
438
439
440
    my $vm_local = $self->_vm->new( host => 'localhost' );
    my $vm = $vm_local;

441
    my ($id_vm, $request);
Francesc Guasch's avatar
Francesc Guasch committed
442
    if (!(scalar(@args) % 2)) {
443
        my %args = @args;
444
445

        # We may be asked to start the machine in a specific id_vmanager
446
447
448
        $id_vm = delete $args{id_vm};
        $request = delete $args{request} if exists $args{request};
    }
449
450
451
452
453
454
455
456
    # 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);
457
        if ( !$vm->enabled || !$vm->ping ) {
458
459
460
461
            $vm = $vm_local;
            $id_vm = undef;
        }
    }
462

463
    # if it is a clone ( it is not a base )
464
    if ($self->id_base) {
465
        $self->_check_tmp_volumes();
Francesc Guasch's avatar
Francesc Guasch committed
466
#        $self->_set_last_vm(1)
467
468
469
        if ( !$self->is_local
            && ( !$self->_vm->enabled || !base_in_vm($self->id_base,$self->_vm->id)
                || !$self->_vm->ping) ) {
470
471
            $self->_set_vm($vm_local, 1);
        }
472
473
474
475
        if ( !$vm->is_alive ) {
            $vm->disconnect();
            $vm->connect;
            $vm = $vm_local if !$vm->is_local && !$vm->is_alive;
476
        };
477
        if ($id_vm) {
478
479
            $self->_set_vm($vm);
        } else {
Francesc Guasch's avatar
Francesc Guasch committed
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
            $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);
495
        }
496
    }
497
498
499
    $self->_check_free_vm_memory();
    #TODO: remove them and make it more general now we have nodes
    #$self->_check_cpu_usage($request);
500
501
}

502
sub _search_already_started($self, $fast = 0) {
503
    my $sql = "SELECT id FROM vms where vm_type=? AND enabled=1";
504
505
    $sql .= " AND is_active=1" if $fast;
    my $sth = $$CONNECTOR->dbh->prepare($sql);
506
507
508
509
    $sth->execute($self->_vm->type);
    my %started;
    while (my ($id) = $sth->fetchrow) {
        my $vm = Ravada::VM->open($id);
510
        next if !$vm->enabled;
Francesc Guasch's avatar
Francesc Guasch committed
511
512
513
514
515
516
517
518
519
520
521
522

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

524
525
526
527
        my $domain;
        eval { $domain = $vm->search_domain($self->name) };
        if ( $@ ) {
            warn $@;
Francesc Guasch's avatar
Francesc Guasch committed
528
            $vm->enabled(0) if !$vm->is_local;
529
530
            next;
        }
531
        next if !$domain;
532
        $vm->_add_instance_db($domain->id);
533
534
535
        if ( $domain->is_active || $domain->is_hibernated ) {
            $self->_set_vm($vm,'force');
            $started{$vm->id}++;
536
537
538
539

            my $status = 'shutdown';
            $status = 'active'  if $domain->is_active;
            $domain->_data(status => $status);
540
        }
541
    }
542
543
544
545
546
547
    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
548
                ,timeout => $TIMEOUT_SHUTDOWN
549
550
551
            );
        }
    }
552
    return keys %started;
553
554
}

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

558
559
    my $base;
    $base = Ravada::Domain->open($self->id_base) if $self->id_base;
560

561
562
563
564
    my $vm_free;
    for (;;) {
        $vm_free = $self->_vm->balance_vm($base);
        return if !$vm_free;
565

566
        last if $vm_free->id == $self->_vm->id;
Francesc Guasch's avatar
Francesc Guasch committed
567
        eval { $self->migrate($vm_free, $request) };
568
569
        last if !$@;
        if ($@ && $@ =~ /file not found/i) {
570
            $base->_set_base_vm_db($vm_free->id,0) unless $vm_free->is_local;
571
572
573
574
575
576
577
578
579
            Ravada::Request->set_base_vm(
                uid => Ravada::Utils::user_daemon->id
                ,id_domain => $base->id
                ,id_vm => $vm_free->id
            );
            next;
        }
        die $@;
    }
580
    return $vm_free->id;
581
582
}

583
584
sub _update_description {
    my $self = shift;
fv3rdugo's avatar
fv3rdugo committed
585

586
587
588
589
    return if defined $self->description
        && defined $self->_data('description')
        && $self->description eq $self->_data('description');

590
591
    my $sth = $$CONNECTOR->dbh->prepare(
        "UPDATE domains SET description=? "
592
593
        ." WHERE id=? ");
    $sth->execute($self->description,$self->id);
594
    $sth->finish;
595
    $self->{_data}->{description} = $self->{description};
596
}
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622

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

}

623
624
625
sub _allow_remove($self, $user) {

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

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

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

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

634
    $self->_check_has_clones() if $self->is_known();
635
636
    if ( $self->is_known
        && $self->id_base
Francesc Guasch's avatar
Francesc Guasch committed
637
        && ($user->can_remove_clones() || $user->can_remove_clone_all())
638
    ) {
639
        my $base = $self->open(id => $self->id_base, id_vm => $self->_vm->id);
joelalju's avatar
joelalju committed
640
        return if ($user->can_remove_clone_all() || ($base->id_owner == $user->id));
641
    }
642
643
644

}

645
646
sub _allow_shutdown {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
647
    my %args;
648

Francesc Guasch's avatar
Francesc Guasch committed
649
650
    if (scalar @_ == 1 ) {
        $args{user} = shift;
651
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
652
        %args = @_;
653
    }
654
655
656
    my $user = $args{user} || confess "ERROR: Missing user arg";

    if ( $self->id_base() && $user->can_shutdown_clone()) {
657
658
        my $base = Ravada::Domain->open($self->id_base)
            or confess "ERROR: Base domain id: ".$self->id_base." not found";
659
        return if $base->id_owner == $user->id;
660
661
    } elsif($user->can_shutdown_all) {
        return;
662
    }
Francesc Guasch's avatar
Francesc Guasch committed
663
664
    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
665
            if !$user->can_shutdown($self->id);
666
667
}

668
669
670
sub _around_add_volume {
    my $orig = shift;
    my $self = shift;
671
672
    confess "ERROR in args ".Dumper(\@_)
        if scalar @_ % 2;
673
674
    my %args = @_;

675
    my $file = ($args{file} or $args{path});
676
    confess if $args{id_iso} && !$file;
Francesc Guasch's avatar
Francesc Guasch committed
677
    my $name = $args{name};
678
679
680
681
682
683
    $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
684
        $name .= "-".$args{target}."-".Ravada::Utils::random_name(4);
685
686
687
        $args{name} = $name;
    }

Francesc Guasch's avatar
Francesc Guasch committed
688
689
    $args{size} = delete $args{capacity} if exists $args{capacity} && !exists $args{size};
    my $size = $args{size};
690
691
    if ( $file ) {
        $self->_check_volume_added($file);
692
    }
Francesc Guasch's avatar
Francesc Guasch committed
693
694
695
696
    $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
697
698
699
    my $free = $self->_vm->free_disk();
    my $free_out = int($free / 1024 / 1024 / 1024 ) * 1024 *1024 *1024;

Francesc Guasch's avatar
Francesc Guasch committed
700
    confess "Error creating volume, out of space $size . Disk free: "
Francesc Guasch's avatar
Francesc Guasch committed
701
702
            .Ravada::Utils::number_to_size($free_out)
            ."\n"
Francesc Guasch's avatar
Francesc Guasch committed
703
        if exists $args{size} && $args{size} && $args{size} >= $free;
Francesc Guasch's avatar
Francesc Guasch committed
704

705
706
707
708
    if ($name) {
        confess "Error: volume $name already exists"
            if grep {$_->info->{name} eq $name} $self->list_volumes_info;
    }
Francesc Guasch's avatar
Francesc Guasch committed
709
    confess "Error: target $args{target} already exists in domain ".$self->name
710
711
            if grep {$_->info->{target} eq $args{target} } $self->list_volumes_info;

Francesc Guasch's avatar
Francesc Guasch committed
712
713
714
715
716
717
718
    my $ok = $self->$orig(%args);
    confess "Error adding ".Dumper(\%args) if !$ok;

    return $ok;
}

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

Francesc Guasch's avatar
Francesc Guasch committed
721
    my $sth = $$CONNECTOR->dbh->prepare("SELECT id,id_domain FROM volumes "
Francesc Guasch's avatar
Francesc Guasch committed
722
        ." WHERE file=? or name=?"
Francesc Guasch's avatar
Francesc Guasch committed
723
    );
Francesc Guasch's avatar
Francesc Guasch committed
724
    $sth->execute($file,$file);
Francesc Guasch's avatar
Francesc Guasch committed
725
726
727
728
729
    my ($id, $id_domain) = $sth->fetchrow();
    $sth->finish;

    return if !$id;

730
    confess "Volume $file already in domain id $id_domain, this is ".$self->id;
Francesc Guasch's avatar
Francesc Guasch committed
731
732
733
734
735
736
737
738
739
}

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

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

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

Francesc Guasch's avatar
Francesc Guasch committed
742
743
744
745
746
747
748
749
    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
750
751
752
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
753

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

756
757
    my @volumes = $self->$orig($attribute => $value);

Francesc Guasch's avatar
Francesc Guasch committed
758
    return @volumes;
759
760
}

761
762
763
764
765
766
767
768
769
770
771
772
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;
    }
773
774
    $self->_pre_prepare_base($user, $request);

Francesc Guasch's avatar
Francesc Guasch committed
775
776
777
778
    if (!$self->is_local) {
        my $vm_local = $self->_vm->new( host => 'localhost' );
        $self->_vm($vm_local);
    }
779
    $self->pre_prepare_base();
780
    my @base_img = $self->$orig($with_cd);
781
782
783
784
785
786
787
788
789

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

790
791
792
793
794
795
796
797
798
=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

799
800
sub pre_prepare_base($self) {}

801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
=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

817
sub prepare_base($self, $with_cd) {
818
    my @base_img;
819
    for my $volume ($self->list_volumes_info()) {
820
        next if !$volume->file;
Francesc Guasch's avatar
Francesc Guasch committed
821
        my $base_file = $volume->base_filename;
822
        next if !$base_file || $base_file =~ /\.iso$/;
823
824
        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
825
826
    }

827
828
    for my $volume ($self->list_volumes_info()) {
        next if !$volume->info->{target} && $volume->info->{device} eq 'cdrom';
Francesc Guasch's avatar
Francesc Guasch committed
829
        next if $volume->info->{device} eq 'cdrom' && (!$with_cd || !$volume->file);
830
831
832
        confess "Undefined info->target ".Dumper($volume)
            if !$volume->info->{target};

833
        next if !defined $volume->file || !length($volume->file);
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
        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) {}

850
sub _pre_prepare_base($self, $user, $request = undef ) {
851
852
853

    $self->_allowed($user);

854
855
856
857
858
859
860
    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());


861
    # TODO: if disk is not base and disks have not been modified, do not generate them
robertperez-upc's avatar
robertperez-upc committed
862
    # again, just re-attach them
Francesc Guasch's avatar
Francesc Guasch committed
863
#    $self->_check_disk_modified(
864
865
866
    die "Error: domain ".$self->name." is volatile and it can't be prepared as a base.\n"
    if $self->is_volatile();

867
    confess "ERROR: domain ".$self->name." is already a base" if $self->is_base();
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
    $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;
        }
    }
Francesc Guasch's avatar
Francesc Guasch committed
885
    #    $self->_post_remove_base();
886
887
    if (!$self->is_local) {
        my $vm_local = Ravada::VM->open( type => $self->vm );
Francesc Guasch's avatar
Francesc Guasch committed
888
        $self->migrate($vm_local, $request);
889
    }
Francesc Guasch's avatar
Francesc Guasch committed
890
891
892
893
894
895
896
    $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();

Francesc Guasch's avatar
Francesc Guasch committed
897
898
899
900
    for my $volume ($self->list_volumes(device => 'disk')) {;
        next if !$volume;
        die "Error: volume $volume is missing.\n" if !$self->_vm->file_exists($volume);
    }
Francesc Guasch's avatar
Francesc Guasch committed
901
    for my $volume ($self->list_volumes_info(device => 'disk')) {;
902
903
        next if !$volume->file;
        die "Error: volume ".$volume->file." is missing.\n" if !$self->_vm->file_exists($volume->file);
904
        $self->_vm->_check_free_disk($volume->capacity * 2, $pool_base);
Francesc Guasch's avatar
Francesc Guasch committed
905
    }
906
907
908
909
910
911
912
913
914
};

sub _post_prepare_base {
    my $self = shift;

    my ($user) = @_;

    $self->is_base(1);

Francesc Guasch's avatar
Francesc Guasch committed
915
916
917
918
919
    if ($self->id_base && !$self->description()) {
        my $base = Ravada::Domain->open($self->id_base);
        $self->description($base->description)  if $base->description();
    }

Francesc Guasch's avatar
Francesc Guasch committed
920
    $self->_set_base_vm_db($self->_vm->id,1);
921
    $self->autostart(0,$user);
922
923
};

Francesc Guasch's avatar
Francesc Guasch committed
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
=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;
    }
947
    $self->_set_volumes_backing_store() if $self->type eq 'KVM';
Francesc Guasch's avatar
Francesc Guasch committed
948
949
950
}


951
952
953
954
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
955
        if $value && $self->is_base;
956
957
958
959
960
961

    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;
962
963
964
965
966
967
968
969
970

    # 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) ) {
971
972
973
974
        $autostart = 1;
    }
    $self->_data(autostart => $autostart)   if defined $value;
    return $autostart;
975
}
976

977
978
979
980
981
sub _check_has_clones {
    my $self = shift;
    return if !$self->is_known();

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

986
sub _check_free_vm_memory {
987
988
    my $self = shift;

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

991
992
993
994
995
996
    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');
997

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

For faster browsing, not all history is shown. View entire blame