Void.pm 20 KB
Newer Older
Francesc Guasch's avatar
Francesc Guasch committed
1
2
3
4
5
package Ravada::Domain::Void;

use warnings;
use strict;

6
use Carp qw(carp cluck croak);
Francesc Guasch's avatar
Francesc Guasch committed
7
use Data::Dumper;
Francesc Guasch's avatar
Francesc Guasch committed
8
use Fcntl qw(:flock SEEK_END);
9
use File::Copy;
10
use File::Path qw(make_path);
11
use File::Rsync;
12
use Hash::Util qw(lock_keys);
Francesc Guasch's avatar
Francesc Guasch committed
13
14
use IPC::Run3 qw(run3);
use Moose;
Francesc Guasch's avatar
Francesc Guasch committed
15
use YAML qw(Load Dump  LoadFile DumpFile);
16
17
use Image::Magick;
use MIME::Base64;
Francesc Guasch's avatar
Francesc Guasch committed
18

19
20
use Ravada::Volume;

21
22
no warnings "experimental::signatures";
use feature qw(signatures);
Francesc Guasch's avatar
Francesc Guasch committed
23

Francesc Guasch's avatar
Francesc Guasch committed
24
extends 'Ravada::Front::Domain::Void';
Francesc Guasch's avatar
Francesc Guasch committed
25
26
with 'Ravada::Domain';

27
has 'domain' => (
28
    is => 'rw'
29
30
31
32
    ,isa => 'Str'
    ,required => 1
);

Francesc Guasch's avatar
Francesc Guasch committed
33
34
our %CHANGE_HARDWARE_SUB = (
    disk => \&_change_hardware_disk
35
36
    ,vcpus => \&_change_hardware_vcpus
    ,memory => \&_change_hardware_memory
Francesc Guasch's avatar
Francesc Guasch committed
37
38
);

fv3rdugo's avatar
fv3rdugo committed
39
40
our $CONVERT = `which convert`;
chomp $CONVERT;
41
#######################################3
Francesc Guasch's avatar
Francesc Guasch committed
42

43
sub name {
Francesc Guasch's avatar
Francesc Guasch committed
44
45
    my $self = shift;
    return $self->domain;
46
47
};

Francesc Guasch's avatar
Francesc Guasch committed
48
sub display_info {
49
50
    my $self = shift;

51
52
53
54
55
56
57
    my $display_data = $self->_value('display');
    if (!keys %$display_data) {
        $display_data = $self->_set_display();
    }
    return $display_data;
}

58
59
sub _set_display($self, $listen_ip=$self->_vm->listen_ip) {
    $listen_ip=$self->_vm->listen_ip if !$listen_ip;
60
    #    my $ip = ($self->_vm->nat_ip or $self->_vm->ip());
61
62
    my $display="void://$listen_ip:5990/";
    my $display_data = { display => $display , type => 'void', ip => $listen_ip, port => 5990 };
63
64
    $self->_store( display => $display_data );
    return $display_data;
65
66
}

67
68
69
70
sub _set_spice_ip($self, $password=undef, $listen_ip=$self->_vm->listen_ip) {
    return $self->_set_display($listen_ip);
}

71
72
sub is_active {
    my $self = shift;
73
74
75
76
77
78
79
80
81
    my $ret = 0;
    eval {
        $ret = $self->_value('is_active') ;
        $ret = 0 if !defined $ret;
    };
    return $ret if !$@;
    return 0 if $@ =~ /Error connecting|can't connect/;
    warn $@;
    die $@;
82
}
Francesc Guasch's avatar
Francesc Guasch committed
83

84
85
sub pause {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
86
    $self->_store(is_paused => 1);
87
}
Francesc Guasch's avatar
Francesc Guasch committed
88
89
90
91
92
93

sub resume {
    my $self = shift;
    return $self->_store(is_paused => 0 );
}

94
95
sub remove {
    my $self = shift;
96

Francesc Guasch's avatar
Francesc Guasch committed
97
    $self->remove_disks();
Francesc Guasch's avatar
Francesc Guasch committed
98
99

    my $config_file = $self->_config_file;
Francesc Guasch's avatar
Francesc Guasch committed
100
101
102
103
104
105
106
    if ($self->_vm->file_exists($config_file)) {
        my ($out, $err) = $self->_vm->run_command("/bin/rm",$config_file);
        warn $err if $err;
    }
    if ($self->_vm->file_exists($config_file.".lock")) {
        $self->_vm->run_command("/bin/rm",$config_file.".lock");
    }
107
108
}

109
sub can_hibernate { return 1; }
Francesc Guasch's avatar
Francesc Guasch committed
110
sub can_hybernate { return 1; }
111

112
113
114
115
sub is_hibernated {
    my $self = shift;
    return $self->_value('is_hibernated');
}
116

Francesc Guasch's avatar
Francesc Guasch committed
117
118
119
120
121
122
sub is_paused {
    my $self = shift;

    return $self->_value('is_paused');
}

Francesc Guasch's avatar
Francesc Guasch committed
123
124
125
126
127
128
129
130
131
132
133
134
135
sub _check_value_disk($self, $value)  {
    return if !exists $value->{device};

    my %target;
    my %file;

    confess "Not hash ".ref($value)."\n".Dumper($value) if ref($value) ne 'HASH';

    for my $device (@{$value->{device}}) {
        confess "Duplicated target ".Dumper($value)
            if $target{$device->{target}}++;

        confess "Duplicated file" .Dumper($value)
Francesc Guasch's avatar
Francesc Guasch committed
136
            if exists $device->{file} && $file{$device->{file}}++;
Francesc Guasch's avatar
Francesc Guasch committed
137
138
139
    }
}

140
141
142
sub _store {
    my $self = shift;

143
144
    return $self->_store_remote(@_) if !$self->_vm->is_local;

145
146
    my ($var, $value) = @_;

Francesc Guasch's avatar
Francesc Guasch committed
147
148
    $self->_check_value_disk($value) if $var eq 'hardware';

149
150
151
152
    my $file_lock = $self->_config_file().".lock";
    open my $lock,">>",$file_lock or die "Can't open $file_lock";
    _lock($lock);

Francesc Guasch's avatar
Francesc Guasch committed
153
154
155
    my $data = $self->_load();
    $data->{$var} = $value;

Francesc Guasch's avatar
Francesc Guasch committed
156
    make_path($self->_config_dir()) if !-e $self->_config_dir;
Francesc Guasch's avatar
Francesc Guasch committed
157
158
    eval { DumpFile($self->_config_file(), $data) };
    chomp $@;
159
    _unlock($lock);
Francesc Guasch's avatar
Francesc Guasch committed
160
161
162
163
164
165
    confess $@ if $@;

}

sub _load($self) {
    return $self->_load_remote()    if !$self->is_local();
166
    my $data = {};
167

168
    my $disk = $self->_config_file();
Francesc Guasch's avatar
Francesc Guasch committed
169
170
171
    eval {
        $data = LoadFile($disk)   if -e $disk;
    };
Francesc Guasch's avatar
Francesc Guasch committed
172
    confess "Error in $disk: $@" if $@;
173

Francesc Guasch's avatar
Francesc Guasch committed
174
175
    return $data;
}
176

177

Francesc Guasch's avatar
Francesc Guasch committed
178
179
sub _load_remote($self) {
    my ($disk) = $self->_config_file();
180

181
    my ($lines, $err) = $self->_vm->run_command("cat $disk");
182

183
    return Load($lines);
184
}
185

186
sub _store_remote($self, $var, $value) {
187
    my ($disk) = $self->_config_file();
188

189
190
    my $data = $self->_load_remote();
    $data->{$var} = $value;
191

Francesc Guasch's avatar
Francesc Guasch committed
192
    open my $lock,">>","$disk.lock" or die "I can't open lock: $disk.lock: $!";
193
    _lock($lock);
Francesc Guasch's avatar
Francesc Guasch committed
194
    $self->_vm->run_command("mkdir","-p ".$self->_config_dir);
195
    $self->_vm->write_file($disk, Dump($data));
Francesc Guasch's avatar
Francesc Guasch committed
196

Francesc Guasch's avatar
Francesc Guasch committed
197
    _unlock($lock);
Francesc Guasch's avatar
Francesc Guasch committed
198
    unlink("$disk.lock");
Francesc Guasch's avatar
Francesc Guasch committed
199
    return $self->_value($var);
200
201
}

Francesc Guasch's avatar
Francesc Guasch committed
202
sub _value($self,$var){
203

Francesc Guasch's avatar
Francesc Guasch committed
204
    my $data = $self->_load();
205
206
207
208
    return $data->{$var};

}

209
sub _lock($fh) {
Francesc Guasch's avatar
Francesc Guasch committed
210
211
212
    flock($fh, LOCK_EX) or die "Cannot lock - $!\n";
}

213
sub _unlock($fh) {
Francesc Guasch's avatar
Francesc Guasch committed
214
215
216
    flock($fh, LOCK_UN) or die "Cannot unlock - $!\n";
}

217
218
219
220
221
sub shutdown {
    my $self = shift;
    $self->_store(is_active => 0);
}

222
223
224
225
sub force_shutdown {
    return shutdown_now(@_);
}

Francesc Guasch's avatar
Francesc Guasch committed
226
227
228
229
230
sub _do_force_shutdown {
    my $self = shift;
    return $self->_store(is_active => 0);
}

231
232
sub shutdown_now {
    my $self = shift;
233
234
    my $user = shift;
    return $self->shutdown(user => $user);
235
}
236

Roberto P. Rubio's avatar
Roberto P. Rubio committed
237
238
239
240
241
sub reboot {
    my $self = shift;
    $self->_store(is_active => 0);
}

Roberto P. Rubio's avatar
Roberto P. Rubio committed
242
243
244
245
246
247
248
249
250
sub force_reboot {
    return reboot_now(@_);
}

sub _do_force_reboot {
    my $self = shift;
    return $self->_store(is_active => 0);
}

Roberto P. Rubio's avatar
Roberto P. Rubio committed
251
252
253
254
255
256
sub reboot_now {
    my $self = shift;
    my $user = shift;
    return $self->reboot(user => $user);
}

257
258
259
sub start($self, @args) {
    my %args;
    %args = @args if scalar(@args) % 2 == 0;
260
    my $listen_ip = delete $args{listen_ip};
261
    my $remote_ip = delete $args{remote_ip};
262
    my $set_password = delete $args{set_password}; # unused
263
264
265
266
267
268
    my $user = delete $args{user};
    delete $args{'id_vm'};
    confess "Error: unknown args ".Dumper(\%args) if keys %args;

    $listen_ip = $self->_vm->listen_ip($remote_ip) if !$listen_ip;

269
    $self->_store(is_active => 1);
270
    $self->_set_display( $listen_ip );
271
272
}

Francesc Guasch's avatar
Francesc Guasch committed
273
sub list_disks {
Francesc Guasch's avatar
Francesc Guasch committed
274
275
    my @disks;
    for my $disk ( list_volumes_info(@_)) {
276
        push @disks,( $disk->file) if $disk->type eq 'file';
Francesc Guasch's avatar
Francesc Guasch committed
277
278
    }
    return @disks;
Francesc Guasch's avatar
Francesc Guasch committed
279
280
281
}

sub _vol_remove {
282
283
    my $self = shift;
    my $file = shift;
284
285
286
287
    if ($self->is_local) {
        unlink $file or die "$! $file"
            if -e $file;
    } else {
Francesc Guasch's avatar
Francesc Guasch committed
288
        return if !$self->_vm->file_exists($file);
289
290
291
        my ($out, $err) = $self->_vm->run_command('ls',$file,'&&','rm',$file);
        warn $err if $err;
    }
Francesc Guasch's avatar
Francesc Guasch committed
292
293
294
295
}

sub remove_disks {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
296
297
298
    my @files = $self->list_volumes_info;
    for my $vol (@files) {
        my $file = $vol->{file};
299
        my $device = $vol->info->{device};
Francesc Guasch's avatar
Francesc Guasch committed
300
        next if $device eq 'cdrom';
301
        next if $file =~ /\.iso$/;
Francesc Guasch's avatar
Francesc Guasch committed
302
303
304
305
        $self->_vol_remove($file);
    }

}
Francesc Guasch's avatar
Francesc Guasch committed
306

307
308
309
310
311
sub remove_disk {
    my $self = shift;
    return $self->_vol_remove(@_);
}

312
313
314
315
=head2 add_volume

Adds a new volume to the domain

Francesc Guasch's avatar
Francesc Guasch committed
316
    $domain->add_volume(capacity => $capacity);
317
318
319
320

=cut

sub add_volume {
321
    my $self = shift;
322
    confess "Wrong arguments " if scalar@_ % 1;
Francesc Guasch's avatar
Francesc Guasch committed
323

324
325
    my %args = @_;

Francesc Guasch's avatar
Francesc Guasch committed
326
    my $device = ( delete $args{device} or 'disk' );
327
    my $type = ( delete $args{type} or '');
328
329
330
331
332
333
334
335
336
    my $format = delete $args{format};

    if (!$format) {
        if ( $args{file}) {
            ($format) = $args{file} =~ /\.(\w+)$/;
        } else {
            $format = 'void';
        }
    }
Francesc Guasch's avatar
Francesc Guasch committed
337

338
339
340
341
    $type = 'swap' if $args{swap};
    $type = '' if $type eq 'sys';
    $type = uc($type)."."   if $type;

342
    my $suffix = $format;
343

Francesc Guasch's avatar
Francesc Guasch committed
344
345
    if ( !$args{file} ) {
        my $vol_name = ($args{name} or Ravada::Utils::random_name(4) );
Francesc Guasch's avatar
Francesc Guasch committed
346
        $args{file} = $self->_config_dir."/$vol_name";
347
        $args{file} .= ".$type$suffix" if $args{file} !~ /\.\w+$/;
Francesc Guasch's avatar
Francesc Guasch committed
348
349
350
    }

    ($args{name}) = $args{file} =~ m{.*/(.*)};
Francesc Guasch's avatar
Francesc Guasch committed
351
352
353

    confess "Volume path must be absolute , it is '$args{file}'"
        if $args{file} !~ m{^/};
354

Francesc Guasch's avatar
Francesc Guasch committed
355
356
357
358
    $args{capacity} = delete $args{size} if exists $args{size} && ! exists $args{capacity};
    $args{capacity} = 1024 if !exists $args{capacity};

    my %valid_arg = map { $_ => 1 } ( qw( name capacity file vm type swap target allocation
Francesc Guasch's avatar
Francesc Guasch committed
359
        driver boot
Francesc Guasch's avatar
Francesc Guasch committed
360
    ));
361
362
363
364
365
366

    for my $arg_name (keys %args) {
        confess "Unknown arg $arg_name"
            if !$valid_arg{$arg_name};
    }

367
368
369
    $args{type} = 'file' if !$args{type};
    delete $args{vm}   if defined $args{vm};

Francesc Guasch's avatar
Francesc Guasch committed
370
    my $data = $self->_load();
371
    $args{target} = $self->_new_target() if !$args{target};
Francesc Guasch's avatar
Francesc Guasch committed
372
373
374
    $args{driver} = 'foo' if !exists $args{driver};

    my $hardware = $data->{hardware};
Francesc Guasch's avatar
Francesc Guasch committed
375
    my $device_list = $hardware->{device};
Francesc Guasch's avatar
Francesc Guasch committed
376
    my $file = delete $args{file};
377
    my $data_new = {
Francesc Guasch's avatar
Francesc Guasch committed
378
379
380
381
382
        name => $args{name}
        ,file => $file
        ,type => $args{type}
        ,target => $args{target}
        ,driver => $args{driver}
Francesc Guasch's avatar
Francesc Guasch committed
383
        ,device => $device
Francesc Guasch's avatar
Francesc Guasch committed
384
    };
385
386
    $data_new->{boot} = $args{boot} if $args{boot};
    push @$device_list, $data_new;
Francesc Guasch's avatar
Francesc Guasch committed
387
    $hardware->{device} = $device_list;
Francesc Guasch's avatar
Francesc Guasch committed
388
389
390
    $self->_store(hardware => $hardware);

    delete @args{'name', 'target', 'driver'};
391
    $self->_create_volume($file, $format, \%args) if ! -e $file;
392

Francesc Guasch's avatar
Francesc Guasch committed
393
394
    return $file;
}
395

396
sub _create_volume($self, $file, $format, $data=undef) {
397
398
    if ($format =~ /iso|raw|void/) {
        $data->{format} = $format;
399
400
401
402
403
404
405
406
407
408
        $self->_vm->write_file($file, Dump($data)),
    } elsif ($format eq 'qcow2') {
        my @cmd = ('qemu-img','create','-f','qcow2', $file, $data->{capacity});
        my ($out, $err) = $self->_vm->run_command(@cmd);
        confess $err if $err;
    } else {
        confess "Error: unknown format '$format'";
    }
}

Francesc Guasch's avatar
Francesc Guasch committed
409
410
sub remove_volume($self, $file) {
    confess "Missing file" if ! defined $file || !length($file);
411

Francesc Guasch's avatar
Francesc Guasch committed
412
    $self->_vol_remove($file);
413
414
415
}

sub _remove_controller_disk($self,$file) {
Francesc Guasch's avatar
Francesc Guasch committed
416
    return if ! $self->_vm->file_exists($self->_config_file);
Francesc Guasch's avatar
Francesc Guasch committed
417
418
    my $data = $self->_load();
    my $hardware = $data->{hardware};
419

Francesc Guasch's avatar
Francesc Guasch committed
420
421
422
423
424
425
426
    my @devices_new;
    for my $info (@{$hardware->{device}}) {
        next if $info->{file} eq $file;
        push @devices_new,($info);
    }
    $hardware->{device} = \@devices_new;
    $self->_store(hardware => $hardware);
427
428
}

429
430
431
432
sub _new_target_dev { return _new_target(@_) }

sub _new_target($self) {
    my $data = $self->_load();
433
434
    return 'vda'    if !$data or !keys %$data;
    my %targets;
Francesc Guasch's avatar
Francesc Guasch committed
435
    for my $dev ( @{$data->{hardware}->{device}}) {
436
        confess "Missing device ".Dumper($data) if !$dev;
437

Francesc Guasch's avatar
Francesc Guasch committed
438
        my $target = $dev->{target};
439
440
441
        confess "Missing target ".Dumper($data) if !$target || !length($target);

        $targets{$target}++
442
443
444
445
446
    }
    return 'vda'    if !keys %targets;

    my @targets = sort keys %targets;
    my ($prefix,$a) = $targets[-1] =~ /(.*)(.)/;
447
448
    confess "ERROR: Missing prefix ".Dumper($data)."\n"
        .Dumper(\%targets) if !$prefix;
449
450
451
    return $prefix.chr(ord($a)+1);
}

452
453
454
455
456
457
458
459
460
461
462
sub create_swap_disk {
    my $self = shift;
    my $path = shift;

    return if -e $path;

    open my $out,'>>',$path or die "$! $path";
    close $out;

}

463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
sub _rename_path {
    my $self = shift;
    my $path = shift;

    my $new_name = $self->name;

    my $cnt = 0;
    my ($dir,$ext) = $path =~ m{(.*)/.*?\.(.*)};
    for (;;) {
        my $new_path = "$dir/$new_name.$ext";
        return $new_path if ! -e $new_path;

        $new_name = $self->name."-$cnt";
    }
}

sub disk_device {
    return list_volumes(@_);
481
482
}

Francesc Guasch's avatar
Francesc Guasch committed
483
484
485
486
487
sub list_volumes($self, @args) {
    my @vol = $self->list_volumes_info(@args);
    my @vol2;
    for (@vol) {
        push @vol2,($_->{file});
488
    }
Francesc Guasch's avatar
Francesc Guasch committed
489
    return @vol2;
490
}
491

Francesc Guasch's avatar
Francesc Guasch committed
492
sub list_volumes_info($self, $attribute=undef, $value=undef) {
Francesc Guasch's avatar
Francesc Guasch committed
493
    my $data = $self->_load();
494

Francesc Guasch's avatar
Francesc Guasch committed
495
    return () if !exists $data->{hardware}->{device};
496
    my @vol;
Francesc Guasch's avatar
Francesc Guasch committed
497
    my $n_order = 0;
Francesc Guasch's avatar
Francesc Guasch committed
498
499
500
501
    for my $dev (@{$data->{hardware}->{device}}) {
        next if exists $dev->{type}
                && $dev->{type} eq 'base';

Francesc Guasch's avatar
Francesc Guasch committed
502
503
504
505
506
        if (exists $dev->{file} ) {
            confess "Error loading $dev->{file} ".$@ if $@;
            next if defined $attribute
                && (!exists $dev->{$attribute} || $dev->{$attribute} ne $value);
        }
507
        $dev->{n_order} = $n_order++;
508
        $dev->{driver_type} = 'void';
509
510
511
512
513
514
        my $vol = Ravada::Volume->new(
            file => $dev->{file}
            ,info => $dev
            ,domain => $self
        );
        push @vol,($vol);
515
516
517
518
519
    }
    return @vol;

}

520
521
sub screenshot {
    my $self = shift;
522
    my $DPI = 300; # 600;
523
524
525
526
527
    my $image = Image::Magick->new(density => $DPI,width=>250, height=>188);
    $image->Set(size=>'250x188');
    $image->ReadImage('canvas:#'.int(rand(10)).int(rand(10)).int(rand(10)));
    my @blobs = $image->ImageToBlob(magick => 'png');
    $self->_data(screenshot => encode_base64($blobs[0]));
528
529
530
531
}

sub _file_screenshot {
    my $self = shift;
532
    return $self->_config_dir."/".$self->name.".png";
533
534
}

fv3rdugo's avatar
fv3rdugo committed
535
sub can_screenshot { return $CONVERT; }
Francesc Guasch's avatar
Francesc Guasch committed
536

537
538
539
sub get_info {
    my $self = shift;
    my $info = $self->_value('info');
Francesc Guasch's avatar
Francesc Guasch committed
540
541
542
    if (!$info->{memory}) {
        $info = $self->_set_default_info();
    }
543
544
545
546
    lock_keys(%$info);
    return $info;
}

547
sub _set_default_info($self, $listen_ip=undef) {
548
549
550
551
552
553
    my $info = {
            max_mem => 512*1024
            ,memory => 512*1024,
            ,cpu_time => 1
            ,n_virt_cpu => 1
            ,state => 'UNKNOWN'
554
            ,ip =>'1.1.1.'.int(rand(254)+1)
555
            ,time => time
556
557
    };
    $self->_store(info => $info);
558
    $self->_set_display($listen_ip);
Francesc Guasch's avatar
Francesc Guasch committed
559
560
    my %controllers = $self->list_controllers;
    for my $name ( sort keys %controllers) {
Francesc Guasch's avatar
Francesc Guasch committed
561
        next if $name eq 'disk';
Francesc Guasch's avatar
Francesc Guasch committed
562
563
        $self->set_controller($name,2);
    }
Francesc Guasch's avatar
Francesc Guasch committed
564
    return $info;
565
566
}

567
568
569
570
sub set_time($self) {
    $self->_set_info(time => time );
}

571
572
573
574
575
576
577
578
579
580
581
sub set_max_memory {
    my $self = shift;
    my $value = shift;

    $self->_set_info(max_mem => $value);

}

sub set_memory {
    my $self = shift;
    my $value = shift;
Roberto P. Rubio's avatar
Roberto P. Rubio committed
582

583
584
585
    $self->_set_info(memory => $value );
}

586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602


sub set_driver {
    my $self = shift;
    my $name = shift;
    my $value = shift or confess "Missing value for driver $name";

    my $drivers = $self->_value('drivers');
    $drivers->{$name}= $value;
    $self->_store(drivers => $drivers);
}

sub _set_default_drivers {
    my $self = shift;
    $self->_store( drivers => { video => 'value=void'});
}

603
604
605
606
607
608
609
610
611
612
613
614
615
sub set_max_mem {
    $_[0]->_set_info(max_mem => $_[1]);
}

sub _set_info {
    my $self = shift;
    my ($field, $value) = @_;
    my $info = $self->get_info();
    confess "Unknown field $field" if !exists $info->{$field};

    $info->{$field} = $value;
    $self->_store(info => $info);
}
616
617
618
619
620
621
622
623

=head2 rename

    $domain->rename("new_name");

=cut

sub rename {
624
625
626
627
    my $self = shift;
    my %args = @_;
    my $new_name = $args{name};

628
    my $file_yml = $self->_config_file();
629

630
    my $file_yml_new = $self->_config_dir."/$new_name.yml";
631
632
    copy($file_yml, $file_yml_new) or die "$! $file_yml -> $file_yml_new";
    unlink($file_yml);
633

634
    $self->domain($new_name);
635
636
}

637
638
639
640
641
642
sub disk_size {
    my $self = shift;
    my ($disk) = $self->list_volumes();
    return -s $disk;
}

643
644
sub ip {
    my $self = shift;
645
646
    my $info = $self->_value('info');
    return $info->{ip};
647
}
648

649
650
651
sub clean_disk($self, $file) {
    open my $out,'>',$file or die "$! $file";
    close $out;
652
653
}

Francesc Guasch's avatar
Francesc Guasch committed
654
655
sub hybernate {
    my $self = shift;
656
    $self->_store(is_hibernated => 1);
Francesc Guasch's avatar
Francesc Guasch committed
657
    $self->_store(is_active => 0);
658
659
}

Francesc Guasch's avatar
Francesc Guasch committed
660
661
sub hibernate($self, $user) {
    $self->hybernate( $user );
662
}
663
664

sub type { 'Void' }
665

666
sub migrate($self, $node, $request=undef) {
667
    $self->_set_display($node->ip);
Francesc Guasch's avatar
Francesc Guasch committed
668
669
670
671
672
673
674
675
676
677
    my $config_remote;
    $config_remote = $self->_load();
    my $device = $config_remote->{hardware}->{device}
        or confess "Error: no device hardware in ".Dumper($config_remote);
    my @device_remote;
    for my $item (@$device) {
        push @device_remote,($item) if $item->{device} ne 'cdrom';
    }
    $config_remote->{hardware}->{device} = \@device_remote;
    $node->write_file($self->_config_file, Dump($config_remote));
678
    $self->rsync($node);
679

Francesc Guasch's avatar
Francesc Guasch committed
680
681
}

682
683
sub is_removed {
    my $self = shift;
Francesc Guasch's avatar
Francesc Guasch committed
684
685
686
687
688
689
690
691
692
693

    return !-e $self->_config_file()    if $self->is_local();

    my ($out, $err) = $self->_vm->run_command("/usr/bin/test",
         " -e ".$self->_config_file." && echo 1" );
    chomp $out;
    warn $self->name." ".$self->_vm->name." ".$err if $err;

    return 0 if $out;
    return 1;
694
}
695

696
697
698
sub autostart { return _internal_autostart(@_) }

sub _internal_autostart {
699
700
701
702
703
704
705
706
    my $self = shift;
    my $value = shift;

    if (defined $value) {
        $self->_store(autostart => $value);
    }
    return $self->_value('autostart');
}
Francesc Guasch's avatar
Francesc Guasch committed
707

Francesc Guasch's avatar
Francesc Guasch committed
708
sub set_controller($self, $name, $number=undef, $data=undef) {
Francesc Guasch's avatar
Francesc Guasch committed
709
    my $hardware = $self->_value('hardware');
Francesc Guasch's avatar
Francesc Guasch committed
710
711
712

    return $self->_set_controller_disk($data) if $name eq 'disk';

Francesc Guasch's avatar
Francesc Guasch committed
713
714
    my $list = ( $hardware->{$name} or [] );

Francesc Guasch's avatar
Francesc Guasch committed
715
716
    $number = $#$list if !defined $number;

Francesc Guasch's avatar
Francesc Guasch committed
717
718
719
720
721
722
723
724
725
726
727
728
    if ($number > $#$list) {
        for ( $#$list+1 .. $number-1 ) {
            push @$list,("foo ".($_+1));
        }
    } else {
        $#$list = $number-1;
    }

    $hardware->{$name} = $list;
    $self->_store(hardware => $hardware );
}

Francesc Guasch's avatar
Francesc Guasch committed
729
730
731
732
733
734
735
736
737
sub _set_controller_disk($self, $data) {
    return $self->add_volume(%$data);
}

sub _remove_disk {
    my ($self, $index) = @_;
    confess "Index is '$index' not number" if !defined $index || $index !~ /^\d+$/;
    my @volumes = $self->list_volumes();
    $self->remove_volume($volumes[$index]);
738
    $self->_remove_controller_disk($volumes[$index]);
Francesc Guasch's avatar
Francesc Guasch committed
739
740
}

Francesc Guasch's avatar
Francesc Guasch committed
741
742
sub remove_controller {
    my ($self, $name, $index) = @_;
Francesc Guasch's avatar
Francesc Guasch committed
743
744
745

    return $self->_remove_disk($index) if $name eq 'disk';

Francesc Guasch's avatar
Francesc Guasch committed
746
747
748
749
    my $hardware = $self->_value('hardware');
    my $list = ( $hardware->{$name} or [] );

    my @list2 ;
Francesc Guasch's avatar
Francesc Guasch committed
750
751
752
753
754
    for my $count ( 0 .. $#$list ) {
        if ( $count == $index ) {
            next;
        }
        push @list2, ( $list->[$count]);
Francesc Guasch's avatar
Francesc Guasch committed
755
756
757
758
759
    }
    $hardware->{$name} = \@list2;
    $self->_store(hardware => $hardware );
}

Francesc Guasch's avatar
Francesc Guasch committed
760
761
762
763
764
765
766
sub _change_driver_disk($self, $index, $driver) {
    my $hardware = $self->_value('hardware');
    $hardware->{device}->[$index]->{driver} = $driver;

    $self->_store(hardware => $hardware);
}

Francesc Guasch's avatar
Francesc Guasch committed
767
768
769
770
771
772
773
774
775
776
777
sub _change_disk_data($self, $index, $field, $value) {
    my $hardware = $self->_value('hardware');
    if (defined $value && length $value ) {
        $hardware->{device}->[$index]->{$field} = $value;
    } else {
        delete $hardware->{device}->[$index]->{$field};
    }

    $self->_store(hardware => $hardware);
}

Francesc Guasch's avatar
Francesc Guasch committed
778
sub _change_hardware_disk($self, $index, $data_new) {
Francesc Guasch's avatar
Francesc Guasch committed
779
    my @volumes = $self->list_volumes_info();
Francesc Guasch's avatar
Francesc Guasch committed
780
781
782
783

    my $driver = delete $data_new->{driver};
    return $self->_change_driver_disk($index, $driver) if $driver;

Francesc Guasch's avatar
Francesc Guasch committed
784
785
786
787
788
789
    die "Error: volume $index not found, only ".scalar(@volumes)." found."
        if $index >= scalar(@volumes);

    my $file = $volumes[$index]->{file};
    my $new_file = $data_new->{file};
    return $self->_change_disk_data($index, file => $new_file) if defined $new_file;
Francesc Guasch's avatar
Francesc Guasch committed
790

Francesc Guasch's avatar
Francesc Guasch committed
791
    return if !$file;
Francesc Guasch's avatar
Francesc Guasch committed
792
793
    my $data;
    if ($self->is_local) {
Francesc Guasch's avatar
Francesc Guasch committed
794
795
        eval { $data = LoadFile($file) };
        confess "Error reading file $file : $@" if $@;
Francesc Guasch's avatar
Francesc Guasch committed
796
797
798
799
800
801
802
803
804
805
806
    } else {
        my ($lines, $err) = $self->_vm->run_command("cat $file");
        $data = Load($lines);
    }

    for (keys %$data_new) {
        $data->{$_} = $data_new->{$_};
    }
    $self->_vm->write_file($file, Dump($data));
}

807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
sub _change_hardware_vcpus($self, $index, $data) {
    my $n = delete $data->{n_virt_cpu};
    confess "Error: unknown args ".Dumper($data) if keys %$data;

    my $info = $self->_value('info');
    $info->{n_virt_cpu} = $n;
    $self->_store(info => $info);
}

sub _change_hardware_memory($self, $index, $data) {
    my $memory = delete $data->{memory};
    my $max_mem = delete $data->{max_mem};
    confess "Error: unknown args ".Dumper($data) if keys %$data;

    my $info = $self->_value('info');
    $info->{memory} = $memory       if defined $memory;
    $info->{max_mem} = $max_mem     if defined $max_mem;

    $self->_store(info => $info);
}


Francesc Guasch's avatar
Francesc Guasch committed
829
830
831
832
833
834
835
sub change_hardware($self, $hardware, $index, $data) {
    my $sub = $CHANGE_HARDWARE_SUB{$hardware};
    return $sub->($self, $index, $data) if $sub;

    my $hardware_def = $self->_value('hardware');

    my $devices = $hardware_def->{$hardware};
836
    confess "Error: $hardware not found ".Dumper($hardware_def) if !$devices;
Francesc Guasch's avatar
Francesc Guasch committed
837
838
839
840
841
842
843
844
845
846

    die "Error: Missing hardware $hardware\[$index], only ".scalar(@$devices)." found"
        if $index > scalar(@$devices);

    for (keys %$data) {
        $hardware_def->{$hardware}->[$index]->{$_} = $data->{$_};
    }
    $self->_store(hardware => $hardware_def );
}

847
848
849
sub dettach($self,$user) {
    # no need to do anything to dettach mock volumes
}
Francesc Guasch's avatar
Francesc Guasch committed
850
1;