Domain.pm 132 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
our $RETRY_SET_TIME=10;
40

41
42
43
44
_init_connector();

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

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

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

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

requires 'disk_device';

requires 'disk_size';

#hardware info

requires 'get_info';
requires 'set_memory';
requires 'set_max_mem';
80

81
requires 'autostart';
82
requires 'hybernate';
83
requires 'hibernate';
84

85
86
#remote methods
requires 'migrate';
87

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

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

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

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

133
134
135
136
137
138
139
140
141
##################################################################################3
#


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

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

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

149
150
151
152
before 'remove' => \&_pre_remove_domain;
#\&_allow_remove;
 after 'remove' => \&_after_remove_domain;

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

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

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

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

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

170
171
172
before 'resume' => \&_allow_manage;
 after 'resume' => \&_post_resume;

173
before 'shutdown' => \&_pre_shutdown;
174
after 'shutdown' => \&_post_shutdown;
175

176
177
around 'shutdown_now' => \&_around_shutdown_now;
around 'force_shutdown' => \&_around_shutdown_now;
178

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

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

Francesc Guasch's avatar
Francesc Guasch committed
186
187
after 'dettach' => \&_post_dettach;

188
189
before 'clone' => \&_pre_clone;

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

after '_select_domain_db' => \&_post_select_domain_db;

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

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

Francesc Guasch's avatar
Francesc Guasch committed
201
around 'is_active' => \&_around_is_active;
Francesc Guasch's avatar
Francesc Guasch committed
202

203
around 'is_hibernated' => \&_around_is_hibernated;
204

205
around 'autostart' => \&_around_autostart;
Francesc Guasch's avatar
Francesc Guasch committed
206

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

215
216
around 'name' => \&_around_name;

217
##################################################
218
219
220
221
#

sub BUILD {
    my $self = shift;
222
223
    my $args = shift;

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

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

229
    $self->_init_connector();
Francesc Guasch's avatar
Francesc Guasch committed
230

231
    $self->is_known();
232
233
234
}

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

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

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
246
247
248
249
250
251
252
253
254
255
256
257
258
259
    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);
260
        $self->_update_id_vm();
Francesc Guasch's avatar
Francesc Guasch committed
261
    }
Francesc Guasch's avatar
Francesc Guasch committed
262
263
    return $vm->id;

264
}
265

Francesc Guasch's avatar
Francesc Guasch committed
266
267
sub _check_equal_storage_pools($self, $vm2) {
    my $vm1 = $self->_vm;
268
    my @sp;
269
    push @sp,($vm1->default_storage_pool_name)  if $vm1->default_storage_pool_name;
270
271
272
273
    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
274
275
276
277
278
279
280
281
282

    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]);
283
284
285
286
    }
    return 1;
}

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

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

297
sub _around_start($orig, $self, @arg) {
298

299
300
301
302
303
304
305
306
307
308
309
310
    $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};

311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    for (;;) {
        eval { $self->_start_checks(@arg) };
        if ($@ && $@ =~/base file not found/ && !$self->_vm->is_local) {
            $self->_request_set_base();
            next;
        }
        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;
        }
        eval { $self->$orig(%arg) };
331
332
333
334
        my $error = $@;
        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) {
335
336
            $self->_request_set_base();
            next;
337
        }
338
        die $@;
339
340
341
342
343
    }
    $self->_post_start(%arg);

}

344
345
346
347
348
349
350
351
352
353
354
355
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);
}

356
357
358
sub _start_preconditions{
    my ($self) = @_;

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

Francesc Guasch's avatar
Francesc Guasch committed
362
    my $request;
363
    my $id_vm;
364
    if (scalar @_ %2 ) {
365
366
        my @args = @_;
        shift @args;
Francesc Guasch's avatar
Francesc Guasch committed
367
        my %args = @args;
368
369
        my $user = delete $args{user};
        my $remote_ip = delete $args{remote_ip};
Francesc Guasch's avatar
Francesc Guasch committed
370
        $request = delete $args{request} if exists $args{request};
371
372
        $id_vm = delete $args{id_vm};

373
374
        confess "ERROR: Unknown argument ".join("," , sort keys %args)
            ."\n\tknown: remote_ip, user"   if keys %args;
375
376
377
378
        _allow_manage_args(@_);
    } else {
        _allow_manage(@_);
    }
Francesc Guasch's avatar
Francesc Guasch committed
379
    #_check_used_memory(@_);
380
381
    $self->status('starting');
}
382

383
sub _start_checks($self, @args) {
384
    return if $self->_search_already_started('fast');
385
386
387
    my $vm_local = $self->_vm->new( host => 'localhost' );
    my $vm = $vm_local;

388
389
390
    my ($id_vm, $request);
    if (!scalar(@args) % 2) {
        my %args = @args;
391
392

        # We may be asked to start the machine in a specific id_vmanager
393
394
395
        $id_vm = delete $args{id_vm};
        $request = delete $args{request} if exists $args{request};
    }
396
397
398
399
400
401
402
403
404
405
406
407
408
409
    # 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);
        if ( !$vm->is_enabled || !$vm->ping ) {
            $vm = $vm_local;
            $id_vm = undef;
        }
    }
    $self->_check_tmp_volumes();
410

411
    # if it is a clone ( it is not a base )
412
    if ($self->id_base) {
Francesc Guasch's avatar
Francesc Guasch committed
413
#        $self->_set_last_vm(1)
414
415
416
        if ( !$self->is_local
            && ( !$self->_vm->enabled || !base_in_vm($self->id_base,$self->_vm->id)
                || !$self->_vm->ping) ) {
417
418
            $self->_set_vm($vm_local, 1);
        }
419
420
421
422
        if ( !$vm->is_alive ) {
            $vm->disconnect();
            $vm->connect;
            $vm = $vm_local if !$vm->is_local && !$vm->is_alive;
423
        };
424
        if ($id_vm) {
425
426
427
428
            $self->_set_vm($vm);
        } else {
            $self->_balance_vm();
        }
429
        $self->rsync(request => $request)  if !$self->is_volatile && !$self->_vm->is_local();
430
431
    } elsif (!$self->is_local) {
        $self->_set_vm($vm_local, 1);
432
    }
433
434
435
    $self->_check_free_vm_memory();
    #TODO: remove them and make it more general now we have nodes
    #$self->_check_cpu_usage($request);
436
437
}

438
439
440
441
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);
442
443
444
445
    $sth->execute($self->_vm->type);
    my %started;
    while (my ($id) = $sth->fetchrow) {
        my $vm = Ravada::VM->open($id);
446
        next if !$vm->enabled;
Francesc Guasch's avatar
Francesc Guasch committed
447
448
449
450
451
452
453
454
455
456
457
458

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

460
461
462
463
        my $domain;
        eval { $domain = $vm->search_domain($self->name) };
        if ( $@ ) {
            warn $@;
Francesc Guasch's avatar
Francesc Guasch committed
464
            $vm->enabled(0) if !$vm->is_local;
465
466
            next;
        }
467
468
469
470
        next if !$domain;
        if ( $domain->is_active || $domain->is_hibernated ) {
            $self->_set_vm($vm,'force');
            $started{$vm->id}++;
471
472
473
474

            my $status = 'shutdown';
            $status = 'active'  if $domain->is_active;
            $domain->_data(status => $status);
475
        }
476
    }
477
478
479
480
481
482
    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
483
                ,timeout => $TIMEOUT_SHUTDOWN
484
485
486
            );
        }
    }
487
    return keys %started;
488
489
490
491
492
}

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

493
494
    my $base;
    $base = Ravada::Domain->open($self->id_base) if $self->id_base;
495

496
497
498
499
    my $vm_free;
    for (;;) {
        $vm_free = $self->_vm->balance_vm($base);
        return if !$vm_free;
500

501
502
503
504
505
506
507
508
509
510
511
512
513
514
        last if $vm_free->id == $self->_vm->id;
        eval { $self->migrate($vm_free) };
        last if !$@;
        if ($@ && $@ =~ /file not found/i) {
            $base->_set_base_vm_db($vm_free->id,0);
            Ravada::Request->set_base_vm(
                uid => Ravada::Utils::user_daemon->id
                ,id_domain => $base->id
                ,id_vm => $vm_free->id
            );
            next;
        }
        die $@;
    }
515
    return $vm_free->id;
516
517
}

518
519
sub _update_description {
    my $self = shift;
fv3rdugo's avatar
fv3rdugo committed
520

521
522
523
524
    return if defined $self->description
        && defined $self->_data('description')
        && $self->description eq $self->_data('description');

525
526
    my $sth = $$CONNECTOR->dbh->prepare(
        "UPDATE domains SET description=? "
527
528
        ." WHERE id=? ");
    $sth->execute($self->description,$self->id);
529
    $sth->finish;
530
    $self->{_data}->{description} = $self->{description};
531
}
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557

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

}

558
559
560
sub _allow_remove($self, $user) {

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

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

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

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

569
    $self->_check_has_clones() if $self->is_known();
570
571
    if ( $self->is_known
        && $self->id_base
Francesc Guasch's avatar
Francesc Guasch committed
572
        && ($user->can_remove_clones() || $user->can_remove_clone_all())
573
    ) {
574
        my $base = $self->open(id => $self->id_base, id_vm => $self->_vm->id);
joelalju's avatar
joelalju committed
575
        return if ($user->can_remove_clone_all() || ($base->id_owner == $user->id));
576
    }
577
578
579

}

580
581
sub _allow_shutdown {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
582
    my %args;
583

Francesc Guasch's avatar
Francesc Guasch committed
584
585
    if (scalar @_ == 1 ) {
        $args{user} = shift;
586
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
587
        %args = @_;
588
    }
589
590
591
    my $user = $args{user} || confess "ERROR: Missing user arg";

    if ( $self->id_base() && $user->can_shutdown_clone()) {
592
593
        my $base = Ravada::Domain->open($self->id_base)
            or confess "ERROR: Base domain id: ".$self->id_base." not found";
594
        return if $base->id_owner == $user->id;
595
596
    } elsif($user->can_shutdown_all) {
        return;
597
    }
Francesc Guasch's avatar
Francesc Guasch committed
598
599
    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
600
            if !$user->can_shutdown($self->id);
601
602
}

603
604
605
sub _around_add_volume {
    my $orig = shift;
    my $self = shift;
606
607
    confess "ERROR in args ".Dumper(\@_)
        if scalar @_ % 2;
608
609
    my %args = @_;

610
    my $file = ($args{file} or $args{path});
611
    confess if $args{id_iso} && !$file;
Francesc Guasch's avatar
Francesc Guasch committed
612
    my $name = $args{name};
613
614
615
616
617
618
    $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
619
        $name .= "-".$args{target}."-".Ravada::Utils::random_name(4);
620
621
622
        $args{name} = $name;
    }

Francesc Guasch's avatar
Francesc Guasch committed
623
624
    $args{size} = delete $args{capacity} if exists $args{capacity} && !exists $args{size};
    my $size = $args{size};
625
626
    if ( $file ) {
        $self->_check_volume_added($file);
627
    }
Francesc Guasch's avatar
Francesc Guasch committed
628
629
630
631
    $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
632
633
634
    my $free = $self->_vm->free_disk();
    my $free_out = int($free / 1024 / 1024 / 1024 ) * 1024 *1024 *1024;

Francesc Guasch's avatar
Francesc Guasch committed
635
    confess "Error creating volume, out of space $size . Disk free: "
Francesc Guasch's avatar
Francesc Guasch committed
636
637
638
639
            .Ravada::Utils::number_to_size($free_out)
            ."\n"
        if exists $args{size} && $args{size} >= $free;

640
641
642
643
644
645
646
    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
647
648
649
650
651
652
653
    my $ok = $self->$orig(%args);
    confess "Error adding ".Dumper(\%args) if !$ok;

    return $ok;
}

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

Francesc Guasch's avatar
Francesc Guasch committed
656
657
658
659
660
661
662
663
664
    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;

665
    confess "Volume $file already in domain id $id_domain, this is ".$self->id;
Francesc Guasch's avatar
Francesc Guasch committed
666
667
668
669
670
671
672
673
674
}

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

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

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

Francesc Guasch's avatar
Francesc Guasch committed
677
678
679
680
681
682
683
684
    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
685
686
687
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
688

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

691
692
    my @volumes = $self->$orig($attribute => $value);

Francesc Guasch's avatar
Francesc Guasch committed
693
    return @volumes;
694
695
}

696
697
698
699
700
701
702
703
704
705
706
707
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;
    }
708
709
    $self->_pre_prepare_base($user, $request);

Francesc Guasch's avatar
Francesc Guasch committed
710
711
712
713
    if (!$self->is_local) {
        my $vm_local = $self->_vm->new( host => 'localhost' );
        $self->_vm($vm_local);
    }
714
    my @base_img = $self->$orig($with_cd);
715
716
717
718
719
720
721
722
723

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

724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
=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

740
sub prepare_base($self, $with_cd) {
741
    my @base_img;
742
    for my $volume ($self->list_volumes_info()) {
Francesc Guasch's avatar
Francesc Guasch committed
743
        my $base_file = $volume->base_filename;
744
        next if !$base_file || $base_file =~ /\.iso$/;
745
746
        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
747
748
    }

749
750
751
    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;
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
        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) {}

771
sub _pre_prepare_base($self, $user, $request = undef ) {
772
773
774

    $self->_allowed($user);

775
776
777
778
779
780
781
    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());


782
783
    # 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
784
#    $self->_check_disk_modified(
785
    confess "ERROR: domain ".$self->name." is already a base" if $self->is_base();
786
787
788
    $self->_check_has_clones();

    $self->is_base(0);
789
    $self->_post_remove_base();
790
791
792
793
794
795
796
797
798
799
800
801
802
803
    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;
        }
    }
804
805
806
807
    if (!$self->is_local) {
        my $vm_local = Ravada::VM->open( type => $self->vm );
        $self->migrate($vm_local);
    }
Francesc Guasch's avatar
Francesc Guasch committed
808
809
810
    if ($self->id_base ) {
        $self->spinoff();
    }
Francesc Guasch's avatar
Francesc Guasch committed
811
812
813
814
815
816
817
818
    $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')) {;
819
        $self->_vm->_check_free_disk($volume->capacity * 2, $pool_base);
Francesc Guasch's avatar
Francesc Guasch committed
820
    }
821
822
823
824
825
826
827
828
829
};

sub _post_prepare_base {
    my $self = shift;

    my ($user) = @_;

    $self->is_base(1);

Francesc Guasch's avatar
Francesc Guasch committed
830
831
832
833
834
    if ($self->id_base && !$self->description()) {
        my $base = Ravada::Domain->open($self->id_base);
        $self->description($base->description)  if $base->description();
    }

835
    $self->_remove_id_base();
Francesc Guasch's avatar
Francesc Guasch committed
836
    $self->_set_base_vm_db($self->_vm->id,1);
837
    $self->autostart(0,$user);
838
839
};

Francesc Guasch's avatar
Francesc Guasch committed
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
=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;
    }
}


866
867
868
869
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
870
        if $value && $self->is_base;
871
872
873
874
875
876

    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;
877
878
879
880
881
882
883
884
885

    # 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) ) {
886
887
888
889
        $autostart = 1;
    }
    $self->_data(autostart => $autostart)   if defined $value;
    return $autostart;
890
}
891

892
893
894
895
896
897
898
899
900
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;
}

901
sub _check_free_vm_memory {
902
903
    my $self = shift;

904
    return if !$self->_vm->min_free_memory;
Francesc Guasch's avatar
Francesc Guasch committed
905
    my $vm_free_mem = $self->_vm->free_memory;
906

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

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

Francesc Guasch's avatar
Francesc Guasch committed
912
913
    die $msg;
}
914

915
916
917
sub _check_tmp_volumes($self) {
    confess "Error: only clones temporary volumes can be checked."
        if !$self->id_base;
918
    my $vm_local = $self->_vm->new( host => 'localhost' );
919
920
    for my $vol ( $self->list_volumes_info) {
        next unless $vol->file && $vol->file =~ /\.(TMP|SWAP)\./;
921
        next if $vm_local->file_exists($vol->file);
922
923
924
925
926
927
928
929
930

        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]
931
            , vm => $vm_local
932
933
934
935
936
        );
        $vol_base->clone(file => $vol->file);
    }
}

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

Francesc Guasch's avatar
Francesc Guasch committed
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
    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;
961
    }
Francesc Guasch's avatar
Francesc Guasch committed
962
    die "$msg\n";
963
964
965
966
967
968
969
}

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

    $gb =~ s/(\d+\.\d).*/$1/;
    return ($gb);
970
971
972

}

Francesc Guasch's avatar
Francesc Guasch committed
973
974
=pod

975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
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
999
1000
=cut

1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
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
1015
    confess "User ".$user->name." [".$user->id."] not allowed to access ".$self->name
Francesc Guasch's avatar
Francesc Guasch committed
1016
        ." owned by ".($id_owner or '<UNDEF>')
1017
1018
1019
1020
1021
            if (defined $id_owner && $id_owner != $user->id );

    confess $err if $err;

}
Francesc Guasch's avatar
Francesc Guasch committed
1022

Francesc Guasch's avatar
Francesc Guasch committed
1023
sub _around_display_info($orig,$self,$user ) {
Francesc Guasch's avatar
Francesc Guasch committed
1024
1025
    $self->_allowed($user);
    my $display = $self->$orig($user);
1026

Francesc Guasch's avatar
Francesc Guasch committed
1027
    if (!$self->readonly) {
1028
        $self->_set_display_ip($display);
1029
        $self->_data(display => encode_json($display)) if $self->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
1030
    }
Francesc Guasch's avatar
Francesc Guasch committed
1031
1032
    return $display;
}
Francesc Guasch's avatar
Francesc Guasch committed
1033

1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
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
1051
1052
sub _around_get_info($orig, $self) {
    my $info = $self->$orig();
1053
    if (ref($self) =~ /^Ravada::Domain/ && $self->is_known()) {
1054
        $info->{ip} = $self->ip() if $self->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
1055
1056
1057
1058
1059
        $self->_data(info => encode_json($info));
    }
    return $info;
}

Francesc Guasch's avatar
Francesc Guasch committed
1060
sub _around_set_memory($orig, $self, $value) {
Francesc Guasch's avatar
Francesc Guasch committed
1061
1062
    my $ret = $self->$orig($value);
    if ($self->is_known) {
Francesc Guasch's avatar
Francesc Guasch committed
1063
1064
1065
        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
1066
        $info->{memory} = $value;
Francesc Guasch's avatar
Francesc Guasch committed
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
        $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
1079
1080
1081
1082
1083
        $self->_data(info => encode_json($info))
    }
    return $ret;
}

1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
##################################################################################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
1098
1099
1100
1101
1102
sub id($self) {
    return $self->{_id} if exists $self->{_id};
    my $id = $_[0]->_data('id');
    $self->{_id} = $id;
    return $id;
1103
1104
1105
1106
1107
}


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

Francesc Guasch's avatar
Francesc Guasch committed
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
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(
        command => $exec
        ,args => { id_domain => $self->id , uid => Ravada::Utils::user_daemon->id }
    );
}

1122
sub _data($self, $field, $value=undef, $table='domains') {
1123
1124
1125

    _init_connector();

1126
1127
1128
1129
1130
1131
1132
    my $data = "_data";
    my $field_id = 'id';
    if ($table ne 'domains' ) {
        $data = "_data_$table";
        $field_id = 'id_domain';
    }

Francesc Guasch's avatar
Francesc Guasch committed
1133
1134
1135
1136
1137
    if (defined $value) {
        confess "Domain ".$self->name." is not in the DB"
            if !$self->is_known();

        confess "ERROR: Invalid field '$field'"
Francesc Guasch's avatar
Francesc Guasch committed
1138
            if $field !~ /^[a-z]+[a-z0-9_]*$/;
1139

Francesc Guasch's avatar
Francesc Guasch committed
1140
        my $sth = $$CONNECTOR->dbh->prepare(
1141
            "UPDATE $table set $field=? WHERE $field_id=?"
Francesc Guasch's avatar
Francesc Guasch committed
1142
1143
1144
        );
        $sth->execute($value, $self->id);
        $sth->finish;
1145
        $self->{$data}->{$field} = $value;
1146
        $self->_propagate_data($field,$value) if $PROPAGATE_FIELD{$field};
Francesc Guasch's avatar
Francesc Guasch committed
1147
        $self->_execute_request($field,$value);
Francesc Guasch's avatar
Francesc Guasch committed
1148
    }
1149
1150
    return $self->{$data}->{$field} if exists $self->{$data}->{$field};

Francesc Guasch's avatar
Francesc Guasch committed
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
    my @field_select;
    if ($table eq 'domains' ) {
        if (exists $self->{_data}->{id} ) {
            @field_select = ( id => $self->{_data}->{id});
        } else {
            confess "ERROR: Unknown domain" if ref($self) =~ /^Ravada::Front::Domain/;
            @field_select = ( name => $self->name );
        }
    } else {
        @field_select = ( id_domain => $self->id );
    }
Francesc Guasch's avatar
Francesc Guasch committed
1162

1163
1164
1165
1166
    $self->{$data} = $self->_select_domain_db( _table => $table, @field_select );

    confess "No DB info for domain @field_select in $table ".$self->name 
        if ! exists $self->{$data};
Francesc Guasch's avatar
Francesc Guasch committed
1167
    confess "No field $field in $data ".Dumper(\@field_select)."\n".Dumper($self->{$data})
1168
        if !exists $self->{$data}->{$field};
1169

1170
1171
    return $self->{$data}->{$field};
}
1172

1173
sub _data_extra($self, $field, $value=undef) {
Francesc Guasch's avatar
Francesc Guasch committed
1174
    $self->_insert_db_extra()   if !$self->is_known_extra();