Domain.pm 121 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;
15
use File::Rsync;
16
use Hash::Util qw(lock_hash unlock_hash);
17
18
19
use Image::Magick;
use JSON::XS;
use Moose::Role;
20
use NetAddr::IP;
21
use IPC::Run3 qw(run3);
22
use Time::Piece;
23

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

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

our $TIMEOUT_SHUTDOWN = 20;
our $CONNECTOR;

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

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

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

40
41
42
43
_init_connector();

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

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

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

requires 'pause';
requires 'resume';

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

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

requires 'disk_device';

requires 'disk_size';

requires 'spinoff_volumes';

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

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

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

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

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

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

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

178
before 'remove_base' => \&_pre_remove_base;
179
180
181
182
183
after 'remove_base' => \&_post_remove_base;

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

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

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

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

after '_select_domain_db' => \&_post_select_domain_db;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

262
}
263

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

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

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

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

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

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

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

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

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

Francesc Guasch's avatar
Francesc Guasch committed
301
    my $request;
302
    my $id_vm;
303
    if (scalar @_ %2 ) {
304
305
        my @args = @_;
        shift @args;
Francesc Guasch's avatar
Francesc Guasch committed
306
        my %args = @args;
307
308
        my $user = delete $args{user};
        my $remote_ip = delete $args{remote_ip};
Francesc Guasch's avatar
Francesc Guasch committed
309
        $request = delete $args{request} if exists $args{request};
310
311
        $id_vm = delete $args{id_vm};

312
313
        confess "ERROR: Unknown argument ".join("," , sort keys %args)
            ."\n\tknown: remote_ip, user"   if keys %args;
314
315
316
317
        _allow_manage_args(@_);
    } else {
        _allow_manage(@_);
    }
Francesc Guasch's avatar
Francesc Guasch committed
318
    #_check_used_memory(@_);
319

320
    return if $self->_search_already_started();
321
    # if it is a clone ( it is not a base )
322
    if ($self->id_base) {
Francesc Guasch's avatar
Francesc Guasch committed
323
#        $self->_set_last_vm(1)
324
        if ( !$self->is_local && ( !$self->_vm->enabled || !$self->_vm->ping) ) {
325
326
327
            my $vm_local = $self->_vm->new( host => 'localhost' );
            $self->_set_vm($vm_local, 1);
        }
328
329
330
331
332
333
334
335
336
337
338
339
340
341
        my $vm;
        if ($id_vm) {
            $vm = Ravada::VM->open($id_vm);
            if ( !$vm->is_alive ) {
                $vm->disconnect();
                $vm->connect;
            }
        };
        warn $@ if $@;
        if ($vm) {
            $self->_set_vm($vm);
        } else {
            $self->_balance_vm();
        }
342
        $self->rsync(request => $request)  if !$self->is_volatile && !$self->_vm->is_local();
343
344
345
    } elsif (!$self->is_local) {
        my $vm_local = $self->_vm->new( host => 'localhost' );
        $self->_set_vm($vm_local, 1);
346
    }
Francesc Guasch's avatar
Francesc Guasch committed
347
    $self->status('starting');
348
349
350
    $self->_check_free_vm_memory();
    #TODO: remove them and make it more general now we have nodes
    #$self->_check_cpu_usage($request);
351
352
353
354
355
356
357
358
359
360
}

sub _search_already_started($self) {
    my $sth = $$CONNECTOR->dbh->prepare(
        "SELECT id FROM vms where vm_type=?"
    );
    $sth->execute($self->_vm->type);
    my %started;
    while (my ($id) = $sth->fetchrow) {
        my $vm = Ravada::VM->open($id);
Francesc Guasch's avatar
Francesc Guasch committed
361
362
363
364
365
366
367
368
369
370
371
372
373
        next if !$vm->is_enabled;

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

375
376
377
378
        my $domain;
        eval { $domain = $vm->search_domain($self->name) };
        if ( $@ ) {
            warn $@;
Francesc Guasch's avatar
Francesc Guasch committed
379
            $vm->enabled(0) if !$vm->is_local;
380
381
            next;
        }
382
383
384
385
        next if !$domain;
        if ( $domain->is_active || $domain->is_hibernated ) {
            $self->_set_vm($vm,'force');
            $started{$vm->id}++;
386
387
388
389

            my $status = 'shutdown';
            $status = 'active'  if $domain->is_active;
            $domain->_data(status => $status);
390
        }
391
    }
392
393
394
395
396
397
    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
398
                ,timeout => $TIMEOUT_SHUTDOWN
399
400
401
            );
        }
    }
402
    return keys %started;
403
404
405
406
407
}

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

408
409
    my $base;
    $base = Ravada::Domain->open($self->id_base) if $self->id_base;
410

411
412
    my $vm_free = $self->_vm->balance_vm($base);
    return if !$vm_free;
413

414
415
    $self->migrate($vm_free) if $vm_free->id != $self->_vm->id;
    return $vm_free->id;
416
417
}

418
419
sub _update_description {
    my $self = shift;
fv3rdugo's avatar
fv3rdugo committed
420

421
422
423
424
    return if defined $self->description
        && defined $self->_data('description')
        && $self->description eq $self->_data('description');

425
426
    my $sth = $$CONNECTOR->dbh->prepare(
        "UPDATE domains SET description=? "
427
428
        ." WHERE id=? ");
    $sth->execute($self->description,$self->id);
429
    $sth->finish;
430
    $self->{_data}->{description} = $self->{description};
431
}
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457

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

}

458
459
460
sub _allow_remove($self, $user) {

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

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

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

467
    $self->_check_has_clones() if $self->is_known();
468
469
    if ( $self->is_known
        && $self->id_base
Francesc Guasch's avatar
Francesc Guasch committed
470
        && ($user->can_remove_clones() || $user->can_remove_clone_all())
471
    ) {
472
        my $base = $self->open(id => $self->id_base, id_vm => $self->_vm->id);
joelalju's avatar
joelalju committed
473
        return if ($user->can_remove_clone_all() || ($base->id_owner == $user->id));
474
    }
475
476
477

}

478
479
sub _allow_shutdown {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
480
    my %args;
481

Francesc Guasch's avatar
Francesc Guasch committed
482
483
    if (scalar @_ == 1 ) {
        $args{user} = shift;
484
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
485
        %args = @_;
486
    }
487
488
489
    my $user = $args{user} || confess "ERROR: Missing user arg";

    if ( $self->id_base() && $user->can_shutdown_clone()) {
490
491
        my $base = Ravada::Domain->open($self->id_base)
            or confess "ERROR: Base domain id: ".$self->id_base." not found";
492
        return if $base->id_owner == $user->id;
493
494
    } elsif($user->can_shutdown_all) {
        return;
495
    }
Francesc Guasch's avatar
Francesc Guasch committed
496
497
    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
498
            if !$user->can_shutdown($self->id);
499
500
}

501
502
503
sub _around_add_volume {
    my $orig = shift;
    my $self = shift;
504
505
    confess "ERROR in args ".Dumper(\@_)
        if scalar @_ % 2;
506
507
    my %args = @_;

508
    my $file = ($args{file} or $args{path});
509
    confess if $args{id_iso} && !$file;
Francesc Guasch's avatar
Francesc Guasch committed
510
    my $name = $args{name};
511
512
513
514
515
516
    $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
517
        $name .= "-".$args{target}."-".Ravada::Utils::random_name(4);
518
519
520
        $args{name} = $name;
    }

Francesc Guasch's avatar
Francesc Guasch committed
521
522
    $args{size} = delete $args{capacity} if exists $args{capacity} && !exists $args{size};
    my $size = $args{size};
523
524
    if ( $file ) {
        $self->_check_volume_added($file);
525
    }
Francesc Guasch's avatar
Francesc Guasch committed
526
527
528
529
    $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
530
531
532
533
534
535
536
537
    my $free = $self->_vm->free_disk();
    my $free_out = int($free / 1024 / 1024 / 1024 ) * 1024 *1024 *1024;

    die "Error creating volume, out of space $size . Disk free: "
            .Ravada::Utils::number_to_size($free_out)
            ."\n"
        if exists $args{size} && $args{size} >= $free;

538
539
540
541
542
543
544
    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
545
546
547
548
549
550
551
    my $ok = $self->$orig(%args);
    confess "Error adding ".Dumper(\%args) if !$ok;

    return $ok;
}

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

Francesc Guasch's avatar
Francesc Guasch committed
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
    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;

    confess "Volume $file already in domain id $id_domain";
}

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

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

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

Francesc Guasch's avatar
Francesc Guasch committed
575
576
577
578
579
580
581
582
    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
583
584
585
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
586

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

589
590
    my @volumes = $self->$orig($attribute => $value);

Francesc Guasch's avatar
Francesc Guasch committed
591
    return @volumes;
592
593
}

594
595
596
597
598
599
600
601
602
603
604
605
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;
    }
606
607
    $self->_pre_prepare_base($user, $request);

608
    my @base_img = $self->$orig($with_cd);
609
610
611
612
613
614
615
616
617

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

618
sub prepare_base($self, $with_cd) {
619
    my @base_img;
620
    for my $volume ($self->list_volumes_info()) {
Francesc Guasch's avatar
Francesc Guasch committed
621
        my $base_file = $volume->base_filename;
622
        next if !$base_file || $base_file =~ /\.iso$/;
Francesc Guasch's avatar
Francesc Guasch committed
623
624
625
        die "Error: file '$base_file' already exists" if $self->_vm->file_exists($base_file);
    }

626
627
628
    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;
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
        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) {}

648
sub _pre_prepare_base($self, $user, $request = undef ) {
649
650
651

    $self->_allowed($user);

652
653
654
655
656
657
658
    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());


659
660
    # 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
661
#    $self->_check_disk_modified(
662
    confess "ERROR: domain ".$self->name." is already a base" if $self->is_base();
663
664
665
    $self->_check_has_clones();

    $self->is_base(0);
666
    $self->_post_remove_base();
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
    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;
        }
    }
    if ($self->id_base ) {
        $self->spinoff_volumes();
    }
684
685
686
687
    if (!$self->is_local) {
        my $vm_local = Ravada::VM->open( type => $self->vm );
        $self->migrate($vm_local);
    }
Francesc Guasch's avatar
Francesc Guasch committed
688
689
690
691
692
693
694
695
    $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')) {;
696
        $self->_vm->_check_free_disk($volume->capacity * 2, $pool_base);
Francesc Guasch's avatar
Francesc Guasch committed
697
    }
698
699
700
701
702
703
704
705
706
};

sub _post_prepare_base {
    my $self = shift;

    my ($user) = @_;

    $self->is_base(1);

Francesc Guasch's avatar
Francesc Guasch committed
707
708
709
710
711
    if ($self->id_base && !$self->description()) {
        my $base = Ravada::Domain->open($self->id_base);
        $self->description($base->description)  if $base->description();
    }

712
    $self->_remove_id_base();
Francesc Guasch's avatar
Francesc Guasch committed
713
    $self->_set_base_vm_db($self->_vm->id,1);
714
    $self->autostart(0,$user);
715
716
};

717
718
719
720
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
721
        if $value && $self->is_base;
722
723
724
725
726
727
728
729
730
731
732

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

735
736
737
738
739
740
741
742
743
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;
}

744
sub _check_free_vm_memory {
745
746
    my $self = shift;

747
    return if !$self->_vm->min_free_memory;
Francesc Guasch's avatar
Francesc Guasch committed
748
    my $vm_free_mem = $self->_vm->free_memory;
749

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

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

Francesc Guasch's avatar
Francesc Guasch committed
755
756
    die $msg;
}
757

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

Francesc Guasch's avatar
Francesc Guasch committed
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
    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;
782
    }
Francesc Guasch's avatar
Francesc Guasch committed
783
    die "$msg\n";
784
785
786
787
788
789
790
}

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

    $gb =~ s/(\d+\.\d).*/$1/;
    return ($gb);
791
792
793

}

Francesc Guasch's avatar
Francesc Guasch committed
794
795
=pod

796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
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
820
821
=cut

822
823
824
825
826
827
828
829
830
831
832
833
834
835
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
836
    confess "User ".$user->name." [".$user->id."] not allowed to access ".$self->name
Francesc Guasch's avatar
Francesc Guasch committed
837
        ." owned by ".($id_owner or '<UNDEF>')
838
839
840
841
842
            if (defined $id_owner && $id_owner != $user->id );

    confess $err if $err;

}
Francesc Guasch's avatar
Francesc Guasch committed
843

Francesc Guasch's avatar
Francesc Guasch committed
844
sub _around_display_info($orig,$self,$user ) {
Francesc Guasch's avatar
Francesc Guasch committed
845
846
    $self->_allowed($user);
    my $display = $self->$orig($user);
847

Francesc Guasch's avatar
Francesc Guasch committed
848
    if (!$self->readonly) {
849
        $self->_set_display_ip($display);
Francesc Guasch's avatar
Francesc Guasch committed
850
851
        $self->_data(display => encode_json($display));
    }
Francesc Guasch's avatar
Francesc Guasch committed
852
853
    return $display;
}
Francesc Guasch's avatar
Francesc Guasch committed
854

855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
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
872
873
sub _around_get_info($orig, $self) {
    my $info = $self->$orig();
874
    if (ref($self) =~ /^Ravada::Domain/ && $self->is_known()) {
875
        $info->{ip} = $self->ip() if $self->is_active;
Francesc Guasch's avatar
Francesc Guasch committed
876
877
878
879
880
        $self->_data(info => encode_json($info));
    }
    return $info;
}

Francesc Guasch's avatar
Francesc Guasch committed
881
sub _around_set_memory($orig, $self, $value) {
Francesc Guasch's avatar
Francesc Guasch committed
882
883
    my $ret = $self->$orig($value);
    if ($self->is_known) {
Francesc Guasch's avatar
Francesc Guasch committed
884
885
886
        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
887
        $info->{memory} = $value;
Francesc Guasch's avatar
Francesc Guasch committed
888
889
890
891
892
893
894
895
896
897
898
899
        $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
900
901
902
903
904
        $self->_data(info => encode_json($info))
    }
    return $ret;
}

905
906
907
908
909
910
911
912
913
914
915
916
917
918
##################################################################################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
919
920
921
922
923
sub id($self) {
    return $self->{_id} if exists $self->{_id};
    my $id = $_[0]->_data('id');
    $self->{_id} = $id;
    return $id;
924
925
926
927
928
}


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

Francesc Guasch's avatar
Francesc Guasch committed
929
930
931
932
933
934
935
936
937
938
939
940
941
942
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 }
    );
}

943
sub _data($self, $field, $value=undef, $table='domains') {
944
945
946

    _init_connector();

947
948
949
950
951
952
953
    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
954
955
956
957
958
    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
959
            if $field !~ /^[a-z]+[a-z0-9_]*$/;
960

Francesc Guasch's avatar
Francesc Guasch committed
961
        my $sth = $$CONNECTOR->dbh->prepare(
962
            "UPDATE $table set $field=? WHERE $field_id=?"
Francesc Guasch's avatar
Francesc Guasch committed
963
964
965
        );
        $sth->execute($value, $self->id);
        $sth->finish;
966
        $self->{$data}->{$field} = $value;
967
        $self->_propagate_data($field,$value) if $PROPAGATE_FIELD{$field};
Francesc Guasch's avatar
Francesc Guasch committed
968
        $self->_execute_request($field,$value);
Francesc Guasch's avatar
Francesc Guasch committed
969
    }
970
971
    return $self->{$data}->{$field} if exists $self->{$data}->{$field};

Francesc Guasch's avatar
Francesc Guasch committed
972
973
974
975
976
977
978
979
980
981
982
    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
983

984
985
986
987
    $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
988
    confess "No field $field in $data ".Dumper(\@field_select)."\n".Dumper($self->{$data})
989
        if !exists $self->{$data}->{$field};
990

991
992
    return $self->{$data}->{$field};
}
993

994
sub _data_extra($self, $field, $value=undef) {
Francesc Guasch's avatar
Francesc Guasch committed
995
    $self->_insert_db_extra()   if !$self->is_known_extra();
996
    return $self->_data($field, $value, "domains_".lc($self->type));
997
998
}

Francesc Guasch's avatar
Francesc Guasch committed
999
=head2 open
1000

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